1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
--- lam.core --- core procedures
local m = {}
local type = require "type"
local isa, null = type.isa, type.null
local math = math
local util = require "util"
local assert_arity = util.assert_arity
local function fold (kons, knil, r)
if r == null then
return knil
else
local step, early_return = kons(r[1], knil)
if early_return then return step end
return fold(kons, step, r[2])
end
end
m.env = { -- all functions here take R, which is the list of arguments
------- equivalence
["eqv?"] =
function (r)
assert_arity(r, 2, 2)
return r[1] == r[2][1]
end,
["eq?"] =
function (r)
assert_arity(r, 2, 2)
-- from how i understand the Scheme spec, it's okay to
-- make `eqv?' and `eq?' the same.
return r[1] == r[2][1]
end,
-- equal? can be done in-library
------- i/o
display =
function (r)
assert_arity(r, 1, 1)
io.write(tostring(r[1]))
end,
newline =
function (r)
assert_arity(r, 0, 0)
io.write("\n")
end,
------- numbers
-- todo: assert all of these are numbers
["number?"] =
function (r)
assert_arity(r, 1, 1)
return isa(r[1], "number")
end,
["="] =
function (r)
if r[1] == nil then return true end
if r[2] == nil then return true end
while r[2] ~= null do
if r[1] ~= r[2][1] then return false end
r = r[2]
end
return true
end,
["<"] =
function (r)
if r[1] == nil then return true end
if r[2] == nil then return true end
while r[2] ~= null do
if r[1] >= r[2][1] then return false end
r = r[2]
end
return true
end,
[">"] =
function (r)
if r[1] == nil then return true end
if r[2] == nil then return true end
while r[2] ~= null do
if r[1] <= r[2][1] then return false end
r = r[2]
end
return true
end,
["<="] = function (r) return not m.env[">"](r) end,
[">="] = function (r) return not m.env["<"](r) end,
------- math
["+"] =
function (r)
return fold(function (a, b) return a + b end, 0, r)
end,
["-"] =
function (r)
if r == null then return -1 end
if r[2] == null then return (- r[1]) end
return fold(function (a, b)
return a - b
end, r[1], r[2])
end,
["*"] =
function (r)
local function go (a, b)
if a == 0 or b == 0 then
return 0, 1
end
return a * b
end
return fold(go, 1, r)
end,
["/"] =
function (r)
assert_arity(r, 1)
if r[2] == null then return (1 / r[1]) end
return fold(function (a, b) return a / b end,
r[1], r[2])
end,
}
--------
return m
|
