about summary refs log tree commit diff stats
path: root/base.lua
diff options
context:
space:
mode:
Diffstat (limited to 'base.lua')
-rw-r--r--base.lua257
1 files changed, 0 insertions, 257 deletions
diff --git a/base.lua b/base.lua deleted file mode 100644 index b6e3a30..0000000 --- a/base.lua +++ /dev/null
@@ -1,257 +0,0 @@
1--- lam.base --- base environment
2
3local base = {}
4local type = require "type"
5local isNull, isa, totable = type.isNull, type.isa, type.totable
6local math = math
7
8base.env = {
9 -- Equivalence
10 ["eqv?"] =
11 function (r)
12 local a, b = r.car, r.cdr.car
13 if a == b then
14 return true
15 else
16 return false
17 end
18 end,
19 -- ["eq?"] = function (r) end, -- how would this be different to eqv?
20 -- Numbers
21 ["number?"] = function (r) return isa(r.car, "Number") end,
22 -- ["complex?"] = function (r) end,
23 -- ["real?"] = function (r) end,
24 -- ["rational?"] = function (r) end,
25 -- ["integer?"] = function (r) end,
26 -- ["exact?"] = function (r) end,
27 -- ["inexact?"] = function (r) end,
28 -- ["exact-integer?"] = function (r) end,
29 -- ["finite?"] = function (r) end,
30 -- ["infinite?"] = function (r) end,
31 ["="] =
32 function (r)
33 local n, r = r.car, r.cdr
34 while r.cdr do
35 if n ~= r.car then return false end
36 r = r.cdr
37 end
38 return true
39 end,
40 ["<"] =
41 function (r)
42 local n, r = r.car, r.cdr
43 while r.cdr do
44 if n >= r.car then return false end
45 r = r.cdr
46 end
47 return true
48 end,
49 [">"] =
50 function (r)
51 local n, r = r.car, r.cdr
52 while r.cdr do
53 if n <= r.car then return false end
54 r = r.cdr
55 end
56 return true
57 end,
58 ["<="] =
59 function (r)
60 local n, r = r.car, r.cdr
61 while r.cdr do
62 if n > r.car then return false end
63 r = r.cdr
64 end
65 return true
66 end,
67 [">="] =
68 function (r)
69 local n, r = r.car, r.cdr
70 while r.cdr do
71 if n < r.car then return false end
72 r = r.cdr
73 end
74 return true
75 end,
76 -- Math
77 ["+"] =
78 function (r)
79 local r, a = r, 0
80 while r.cdr do
81 r, a = r.cdr, a + r.car
82 end
83 return a
84 end,
85 ["-"] =
86 function (r)
87 if isNull(r) then return -1 end
88 if isNull(r.cdr) then return (- r.car) end
89 local r, a = r.cdr, r.car
90 while r.cdr do
91 r, a = r.cdr, a - r.car
92 end
93 return a
94 end,
95 ["*"] =
96 function (r)
97 local r, a = r, 1
98 while r.cdr do
99 if r.cdr == 0 then return 0 end
100 r, a = r.cdr, a * r.car
101 end
102 return a
103 end,
104 ["/"] =
105 function (r)
106 if isNull(r) then error("Wrong arity") end
107 if isNull(r.cdr) then return (1 / r.car) end
108 local r, a = r.cdr, r.car
109 while r.cdr do
110 r, a = r.cdr, a / r.car
111 end
112 return a
113 end,
114 quotient =
115 function (r)
116 end,
117 remainder =
118 function (r)
119 end,
120 modulo =
121 function (r)
122 end,
123 -- numerator = function (r) end,
124 -- denominator = function (r) end,
125 abs = function (r) return math.abs(r.car) end,
126 floor = -- largest integer <= x
127 function (r) return math.floor(r.car) end,
128 ceiling = -- smallest integer >= x
129 function (r) return math.ceil(r.car) end,
130 truncate = -- smallest |integer| <= |x|
131 function (r)
132 local i, _ = math.modf(r.car)
133 return i
134 end,
135 round = -- closest integer to x (ties go even)
136 function (r)
137 local i, f = math.modf(r.car)
138 if f == 0.5 then
139 if i % 2 == 0 then
140 return i
141 else
142 return i+1
143 end
144 else
145 return i -- is this right?
146 end
147 end,
148 -- Trig
149 exp = function (r) return math.exp(r.car) end,
150 log = function (r) return math.log(r.car) end,
151 pi = math.pi, -- extension
152 sin = function (r) return math.sin(r.car) end,
153 cos = function (r) return math.cos(r.car) end,
154 tan = function (r) return math.tan(r.car) end,
155 asin = function (r) return math.asin(r.car) end,
156 acos = function (r) return math.acos(r.car) end,
157 atan = -- the two-argument variant of atan computes
158 -- (angle (make-rectangular x y)), even in implementations that
159 -- don't support general complex numbers [ed. note: whatever
160 -- that means] --- atan2 ???
161 function (r) return math.atan(r.car) end,
162 sqrt = function (r) return math.sqrt(r.car) end,
163 expt = function (r) return r.car ^ r.cdr.car end,
164 -- ["make-rectangular"] = function (r) end,
165 -- ["make-polar"] = function (r) end,
166 -- ["real-part"] = function (r) end,
167 -- ["imag-part"] = function (r) end,
168 -- ["magnitude"] = function (r) end,
169 -- ["angle"] = function (r) end,
170 -- ["exact->inexact"] = function (r) end,
171 -- ["inexact->exact"] = function (r) end,
172 ["number->string"] =
173 function (r)
174 -- this will be somewhat complicated
175 end,
176 ["string->number"] =
177 function (r)
178 local n = r.car
179 if not isNull(r.cdr) then
180 local radix = r.cdr.car
181 end
182 -- This is technically an extension to r5rs
183 return tonumber(n, radix)
184 end,
185 -- Pairs
186 ["pair?"] = function (r) end,
187 cons = function (r) return type.Cons(r.car, r.cdr.car) end,
188 car = function (r) return r.car.car end,
189 cdr = function (r) return r.car.cdr end,
190 ["set-car!"] = function (r) r.car.car = r.cdr.car end,
191 ["set-cdr!"] = function (r) r.car.cdr = r.cdr.car end,
192 -- cxr
193 ["null?"] = function (r) return isNull(r.car) end,
194 ["list?"] = function (r) return type.isList(r.car) end,
195 list = function (r) return r end, -- r is already a list
196 -- Symbols
197 ["symbol?"] = function (r) return isa(r.car, "Symbol") end,
198 ["symbol->string"] = function (r) return type.String(r.car) end,
199 ["string->symbol"] = function (r) return type.Symbol(r.car.value) end,
200 -- Characters
201 ["char?"] = function (r) end,
202 ["char=?"] = function (r) end,
203 ["char<?"] = function (r) end,
204 ["char>?"] = function (r) end,
205 ["char<=?"] = function (r) end,
206 ["char>=?"] = function (r) end,
207 ["char->integer"] = function (r) end,
208 ["integer->char"] = function (r) end,
209 -- Strings
210 ["string?"] = function (r) end,
211 ["make-string"] = function (r) end,
212 ["string-length"] = function (r) end,
213 ["string-ref"] = function (r) end,
214 -- ["string-set!"] = function (r) end, -- not sure if i'll implement
215 -- Vectors
216 ["vector?"] = function (r) end,
217 ["make-vector"] = function (r) end,
218 ["vector-length"] = function (r) end,
219 ["vector-ref"] = function (r) end,
220 ["vector-set!"] = function (r) end,
221 -- Control
222 ["procedure?"] = function (r) end,
223 apply = function (r) end,
224 ["call-with-current-continuation"] = function (r) end,
225 values = function (r) end,
226 ["call-with-values"] = function (r) end,
227 ["dynamic-wind"] = function (r) end,
228 -- Eval
229 eval = function (r) end,
230 ["scheme-report-environment"] = function (r) end,
231 ["null-environment"] = function (r) end,
232 -- Ports
233 ["input-port?"] = function (r) end,
234 ["output-port?"] = function (r) end,
235 ["current-input-port"] = function (r) end,
236 ["current-output-port"] = function (r) end,
237 ["open-input-file"] = function (r) end,
238 ["open-output-file"] = function (r) end,
239 ["close-input-port"] = function (r) end,
240 ["close-output-port"] = function (r) end,
241 -- Input
242 read = function (r) end,
243 ["read-char"] = function (r) end,
244 ["peek-char"] = function (r) end,
245 ["eof-object?"] = function (r) end,
246 ["char-ready?"] = function (r) end,
247 -- Output
248 write = function (r) end,
249 display = function (r) end,
250 newline = function (r) end,
251 ["write-char"] = function (r) end,
252 -- System
253 load = function (r) end,
254}
255
256---
257return base
© 2022 C. Duckworth. generated by cgit. comments, issues, and patches welcome at < git at acdw dot net >.