diff options
-rw-r--r-- | base.lua | 230 |
1 files changed, 229 insertions, 1 deletions
diff --git a/base.lua b/base.lua index 6dc71e4..b6e3a30 100644 --- a/base.lua +++ b/base.lua | |||
@@ -2,9 +2,78 @@ | |||
2 | 2 | ||
3 | local base = {} | 3 | local base = {} |
4 | local type = require "type" | 4 | local type = require "type" |
5 | local isNull = type.isNull | 5 | local isNull, isa, totable = type.isNull, type.isa, type.totable |
6 | local math = math | ||
6 | 7 | ||
7 | base.env = { | 8 | base.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 | ||
8 | ["+"] = | 77 | ["+"] = |
9 | function (r) | 78 | function (r) |
10 | local r, a = r, 0 | 79 | local r, a = r, 0 |
@@ -23,6 +92,165 @@ base.env = { | |||
23 | end | 92 | end |
24 | return a | 93 | return a |
25 | end, | 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, | ||
26 | } | 254 | } |
27 | 255 | ||
28 | --- | 256 | --- |