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
|
--- lam.core --- core procedures
local m = {}
local type = require "type"
local isa, null = type.isa, type.null
local math = math
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
------- numbers
["number?"] = function (r) return isa(r[1], "number") end,
["="] =
function (r)
local function go (a, b)
if a ~= b then return false, 1 end
return b
end
return fold(go, r[1], r[2]) and true
end,
["<"] =
function (r)
local function go (a, b)
if a >= b then return false, 1 end
return b
end
return fold(go, r[1], r[2]) and true
end,
[">"] =
function (r)
local function go (a, b)
if a <= b then return false, 1 end
return b
end
return fold(go, r[1], r[2]) and 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)
if r == null then error("Wrong arity") end
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
|
