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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
--- lam.environment
local util = require "util"
local types = require "types"
table.unpack = table.unpack or unpack
local global = {
-- constants ---- TODO this should be at the reader level
["#t"] = true,
["#f"] = false,
}
--- Types ---
global.luatype = type
global.type = types.lamtype
global["number?"] = function (x) types.isa(x, "Number") end
global["string?"] = function (x) types.isa(x, "String") end
global["symbol?"] = function (x) types.isa(x, "Symbol") end
global["pair?"] = function (x) types.isa(x, "Pair") end
global["is-a?"] = function (x, t) types.isa(x, t) end
--- Basic functions ---
global.car = function (pair) return pair[1] end
global.cdr = function (pair) return pair[2] end
-- global.list = types.List
global["list?"] =
function (x)
-- TODO : detect circular lists
if type(x) == "table" then
if #x == 0 then return true end
if type(x[2]) ~= "table" then return false end
end
return global["list?"](x[2])
end
global["null?"] = function (x) return type(x) == "table" and #x == 0 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.fold =
function (fn, lis)
local out = {}
return types.List(out)
end
global["+"] = function (lis)
return
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
|
