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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
--- lam.environment
local util = require "util"
local types = require("types")
if not table.unpack then table.unpack = unpack end
local global = {
-- constants
["#t"] = true,
["#f"] = false,
}
--- Types ---
for name, func in pairs(types) do
if name == "lamtype" then
global.type = func
else
global[name] = func
end
end
--- Basic functions ---
global.begin = function(...)
local xs = {...}
return xs[#xs]
end
global.car = util.car
global.cdr = util.cdr
global.list = function(...) return {...} end
--- Higher-order functions ---
global.apply = function(fn, ...)
local args = {...}
local last = args[#args]
assert(types.luatype(last) == "table", "Bad apply")
table.remove(args)
for _, v in ipairs(last) do
table.insert(args, v)
end
return fn(table.unpack(args))
end
global.map = function(fn, list)
return util.map(fn, list)
end
--- Math ---
-- NOTE: we do not have the full numeric tower yet!
for name, func in pairs(math) do
global[name] = func
end
global["+"] = function (...)
return util.reduce({...}, 0, function (a, b) return a + b end)
end
global["-"] = function (...)
local args = {...}
if #args == 0 then
error("Too few arguments: need at least 1")
elseif #args == 1 then
return (-args[1])
else
local result = args[1]
for v = 2, #args do
result = result - args[v]
end
return result
end
end
global["*"] = function (...)
local result = 1
for _, v in ipairs({...}) do
if v == 0 then return 0 end
result = result * v
end
return result
end
global["/"] = function (...)
local args = {...}
if #args == 0 then
error("Too few arguments: need at least 1")
elseif #args == 1 then
if args[1] == 0 then error("Division by zero") end
return (1/args[1])
else
local result = args[1]
for v = 2, #args do
if args[v] == 0 then error("Division by zero") end
result = result / args[v]
end
return result
end
end
global["="] = function (...)
for _, v in ipairs({...}) do
if not a == b then return false end
end
return true
end
global["<"] = function (...)
for _, v in ipairs({...}) do
if not a < b then return false end
end
return true
end
global["<="] = function (...)
for _, v in ipairs({...}) do
if not a <= b then return false end
end
return true
end
global[">"] = function (...)
for _, v in ipairs({...}) do
if not a > b then return false end
end
return true
end
global[">="] = function (...)
for _, v in ipairs({...}) do
if not a >= b then return false end
end
return true
end
---
return global
|