about summary refs log tree commit diff stats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile20
-rw-r--r--eval.lua126
-rw-r--r--eval2.lua39
-rw-r--r--global.lua162
-rw-r--r--list.lua48
-rw-r--r--port.lua20
-rw-r--r--pp.lua26
-rw-r--r--read.lua297
-rw-r--r--repl.lua42
-rw-r--r--test.lua28
-rw-r--r--type.lua137
-rw-r--r--types.lua112
-rw-r--r--util.lua33
13 files changed, 405 insertions, 685 deletions
diff --git a/Makefile b/Makefile index ff07d99..54c4f2c 100644 --- a/Makefile +++ b/Makefile
@@ -7,12 +7,14 @@ repl:
7.PHONY: test 7.PHONY: test
8test: 8test:
9 $(LUA) -i \ 9 $(LUA) -i \
10 -e 'eval=require"eval"'\ 10 -e 'pp = require "pp"' \
11 -e 'global=require"global"'\ 11 -e 'eval = require "eval"' \
12 -e 'pp=require"pp"'\ 12 -e 'read = require "read"' \
13 -e 'read=require"read"'\ 13 -e 'type = require "type"' \
14 -e 'util=require"util"'\ 14 -e 'utf8 = require "utf8"' \
15 -e 'repl=require"repl"'\ 15 -e 'util = require "util"' \
16 -e 'types=require"types"'\ 16 -e 'test = require "test"'
17 -e 'utf8=require"utf8"'\ 17
18 -e 'util=require"util"' 18.PHONY: check
19check:
20 luacheck *.lua
diff --git a/eval.lua b/eval.lua index 806148d..6179842 100644 --- a/eval.lua +++ b/eval.lua
@@ -2,21 +2,20 @@
2 2
3local eval = {} 3local eval = {}
4local read = require "read" 4local read = require "read"
5local type = require "type"
5local util = require "util" 6local util = require "util"
6local pp = require "pp" 7local unpack = table.unpack or unpack
7local global = require "global"
8local types = require "types"
9table.unpack = table.unpack or unpack
10 8
11--- Environments and Parameters 9function eval.Env (inner, outer)
12-- these aren't in types.lua to avoid a circular dependency 10 local mt = {
13 11 __type = "Environment",
14local function Env(inner, outer) 12 __index = outer,
15 return setmetatable(inner, { __type = "Environment", __index = outer, }) 13 }
14 return setmetatable(inner, mt)
16end 15end
17 16
18local function Proc(params, body, env) 17function eval.Proc (params, body, env)
19 local p = { 18 local v = {
20 params = params, 19 params = params,
21 body = body, 20 body = body,
22 env = env, 21 env = env,
@@ -24,62 +23,77 @@ local function Proc(params, body, env)
24 local mt = { 23 local mt = {
25 __type = "Procedure", 24 __type = "Procedure",
26 __call = 25 __call =
27 function (self, ...) 26 function (self, args)
28 local inner = {} 27 local inner = {}
29 for _, p in ipairs(self.params) do 28 local p, a = self.params, args
30 for _, a in ipairs({...}) do 29 while p.cdr and a.cdr do
31 inner[p] = a 30 inner[p.car] = a.car
32 end 31 p, a = p.cdr, a.cdr
33 end 32 end
34 return eval(self.body, Env(inner, self.env)) 33 -- pp.pp(self.body)
34 return eval.eval(
35 self.body,
36 eval.Env(inner, self.env))
35 end, 37 end,
36 } 38 }
37 return setmetatable(p, mt) 39 return setmetatable(v, mt)
38end 40end
39 41
40function eval.eval (x, e) 42local global = {
41 e = e or global 43 begin =
42 if types.lamtype(x) == "Symbol" then 44 function (args)
43 return e[x] 45 local a = args
44 elseif types.luatype(x) ~= "table" then 46 while not type.isNull(a.cdr) do
47 a = a.cdr
48 end
49 return a.car
50 end,
51 ["+"] =
52 function (args)
53 local acc = 0
54 local car, cdr = args.car, args.cdr
55 while cdr do
56 acc = acc + car
57 car, cdr = cdr.car, cdr.cdr
58 end
59 return acc
60 end,
61 ["-"] =
62 function (args)
63 return args.car - args.cdr.car
64 end,
65}
66
67function eval.eval (x, env)
68 env = env or global
69 if type.isa(x, "Symbol") then
70 return env[x]
71 elseif not type.isList(x) then
45 return x 72 return x
46 else 73 else
47 local op = util.car(x) 74 local op, args = x.car, x.cdr
48 local args = util.cdr(x) 75 if op == "quote" then
49 if op == types.Symbol("quote") then 76 return args
50 return args[1] 77 elseif op == "define" then
51 elseif op == types.Symbol("define") then 78 env[args.car] = eval.eval(args.cdr.car, env)
52 local sym, exp = table.unpack(args) 79 return nil
53 e[sym] = eval(exp, e) 80 elseif op == "lambda" then
54 --[[ 81 return eval.Proc(
55 elseif op == "set!" then 82 args.car,
56 local sym, exp = table.unpack(args) 83 type.Cons("begin", args.cdr),
57 e[sym] = eval(exp, e) --]] 84 env)
58 elseif op == types.Symbol("lambda") then 85 else -- procedure
59 local params = util.car(args) 86 local proc = eval.eval(op, env)
60 local body = util.cdr(args) 87 local params = {}
61 table.insert(body, 1, "begin") 88 local a = args
62 return Proc(params, 89 while a.cdr do
63 body, 90 table.insert(params, eval.eval(a.car, env))
64 e) 91 a = a.cdr
65 else -- procedure call
66 local proc = eval(op, e)
67 local vals = {}
68 for k, v in pairs(args) do
69 vals[k] = eval(v, e)
70 end 92 end
71 return proc(table.unpack(vals)) 93 return proc(type.List(params))
72 end 94 end
73 end 95 end
74end 96end
75 97
76--- 98---
77return setmetatable(eval, { __call = 99return eval
78 function(_, x, e)
79 local success, result =
80 pcall(eval.eval, x, e)
81 if success then return result
82 else return ("ERROR: " .. result)
83 end
84 end
85})
diff --git a/eval2.lua b/eval2.lua deleted file mode 100644 index 02444b8..0000000 --- a/eval2.lua +++ /dev/null
@@ -1,39 +0,0 @@
1--- lam.eval
2
3local eval = {}
4local read = require "read"
5local util = require "util"
6local types = require "types"
7table.unpack = table.unpack or unpack
8
9local Environment =
10 function (inner, outer)
11 -- an Environment is really just a lua table between symbols and
12 -- values. They can be nested for uh, closure reasons or
13 -- something. TODO: figure out how this intersects with
14 -- Namespaces or Symboltables or whatever.
15 local mt = {
16 __type = "Environment",
17 __index = outer,
18 }
19 return setmetatable(inner, mt)
20 end
21
22local Procedure =
23 function (params, body, env)
24 local proc = {
25 params = params,
26 body = body,
27 env = env,
28 }
29 local mt = {
30 __type = "Procedure",
31 __call =
32 function (self, ...)
33 end,
34 }
35 return setmetatable(proc, mt)
36 end
37
38---
39return eval
diff --git a/global.lua b/global.lua deleted file mode 100644 index 1dea773..0000000 --- a/global.lua +++ /dev/null
@@ -1,162 +0,0 @@
1--- lam.environment
2
3local util = require "util"
4local types = require "types"
5table.unpack = table.unpack or unpack
6
7local global = {
8 -- constants ---- TODO this should be at the reader level
9 ["#t"] = true,
10 ["#f"] = false,
11}
12
13--- Types ---
14
15global.luatype = type
16global.type = types.lamtype
17
18global["number?"] = function (x) types.isa(x, "Number") end
19global["string?"] = function (x) types.isa(x, "String") end
20global["symbol?"] = function (x) types.isa(x, "Symbol") end
21global["pair?"] = function (x) types.isa(x, "Pair") end
22global["is-a?"] = function (x, t) types.isa(x, t) end
23
24--- Basic functions ---
25
26global.car = function (pair) return pair[1] end
27global.cdr = function (pair) return pair[2] end
28
29-- global.list = types.List
30
31global["list?"] =
32 function (x)
33 -- TODO : detect circular lists
34 if type(x) == "table" then
35 if #x == 0 then return true end
36 if type(x[2]) ~= "table" then return false end
37 end
38 return global["list?"](x[2])
39 end
40
41global["null?"] = function (x) return type(x) == "table" and #x == 0 end
42
43--- Higher-order functions ---
44--[[
45global.apply = function(fn, ...)
46 local args = {...}
47 local last = args[#args]
48 assert(types.luatype(last) == "table", "Bad apply")
49 table.remove(args)
50 for _, v in ipairs(last) do
51 table.insert(args, v)
52 end
53 return fn(table.unpack(args))
54end
55
56global.map = function(fn, list)
57 return util.map(fn, list)
58end
59--]]
60--- Math ---
61-- NOTE: we do not have the full numeric tower yet!
62
63for name, func in pairs(math) do
64 global[name] = func
65end
66
67global.fold =
68 function (fn, lis)
69 local out = {}
70
71 return types.List(out)
72 end
73
74global["+"] = function (lis)
75 return
76 return util.reduce({...}, 0, function (a, b) return a + b end)
77end
78
79global["-"] = function (...)
80 local args = {...}
81 if #args == 0 then
82 error("Too few arguments: need at least 1")
83 elseif #args == 1 then
84 return (-args[1])
85 else
86 local result = args[1]
87 for v = 2, #args do
88 result = result - args[v]
89 end
90 return result
91 end
92end
93
94global["*"] = function (...)
95 local result = 1
96 for _, v in ipairs({...}) do
97 if v == 0 then return 0 end
98 result = result * v
99 end
100 return result
101end
102
103global["/"] = function (...)
104 local args = {...}
105 if #args == 0 then
106 error("Too few arguments: need at least 1")
107 elseif #args == 1 then
108 if args[1] == 0 then error("Division by zero") end
109 return (1/args[1])
110 else
111 local result = args[1]
112 for v = 2, #args do
113 if args[v] == 0 then error("Division by zero") end
114 result = result / args[v]
115 end
116 return result
117 end
118end
119
120--[[
121global["="] =
122 function (...)
123 for _, v in ipairs({...}) do
124 if not a == b then return false end
125 end
126 return true
127 end
128
129global["<"] =
130 function (...)
131 for _, v in ipairs({...}) do
132 if not a < b then return false end
133 end
134 return true
135 end
136
137global["<="] =
138 function (...)
139 for _, v in ipairs({...}) do
140 if not a <= b then return false end
141 end
142 return true
143end
144
145global[">"] =
146 function (...)
147 for _, v in ipairs({...}) do
148 if not a > b then return false end
149 end
150 return true
151end
152
153global[">="] =
154 function (...)
155 for _, v in ipairs({...}) do
156 if not a >= b then return false end
157 end
158 return true
159end
160--]]
161---
162return global
diff --git a/list.lua b/list.lua deleted file mode 100644 index 1153c26..0000000 --- a/list.lua +++ /dev/null
@@ -1,48 +0,0 @@
1--- lam.list
2
3local list = {}
4local util = require "util"
5local types = require "types"
6table.unpack = table.unpack or unpack
7
8list.Null = setmetatable({}, {
9 __type = "Null",
10 __tostring = function(self) return "()" end,
11})
12
13list.isNull =
14 function (x)
15 return x == list.Null
16 end
17
18list.List =
19 function (tbl)
20 local function tolist (base, items)
21 if #items == 0 then return base end
22 return tolist (
23 types.Cons(table.remove(items), base),
24 items
25 )
26 end
27 return tolist(list.Null, tbl)
28 end
29
30list.isList =
31 function (x)
32 if list.isNull(x) then
33 return true
34 elseif types.isa(x, "Pair") then
35 return list.isList(x[2])
36 else
37 return false
38 end
39 end
40
41list.fold1 =
42 function (fn, seed, lis)
43 if list.isNull(lis) then return seed end
44 return list.fold1(fn, fn(seed, lis[1]), lis[2])
45 end
46
47---
48return list
diff --git a/port.lua b/port.lua deleted file mode 100644 index c5763df..0000000 --- a/port.lua +++ /dev/null
@@ -1,20 +0,0 @@
1--- lam.port
2
3local port = {}
4table.unpack = table.unpack or unpack
5
6function port.Input (file)
7 return {
8 file = file,
9 line = "",
10 }
11end
12
13port.tokenizer = "%s*(,@|[('`,)]|)"
14
15function port.Input:tokens () -- iterator
16
17end
18
19---
20return port
diff --git a/pp.lua b/pp.lua index 9c1a6d0..4d9d9af 100644 --- a/pp.lua +++ b/pp.lua
@@ -1,21 +1,8 @@
1--- lam.pp 1--- lam.pp
2 2
3local pp = {} 3local pp = {}
4table.unpack = table.unpack or unpack 4local type = require "type"
5 5local unpack = table.unpack or unpack
6pp.luadump =
7 function (x)
8 end
9
10pp.luapp = function (x) print(pp.luadump(x)) end
11
12pp.lamdump =
13 function (x)
14 end
15
16pp.lampp = function (x) print(pp.lamdump(x)) end
17
18-- The following should be at some point replaced by the preceding
19 6
20function pp.dump (x, lvl) 7function pp.dump (x, lvl)
21 lvl = lvl or 0 8 lvl = lvl or 0
@@ -23,7 +10,7 @@ function pp.dump (x, lvl)
23 local output = "" 10 local output = ""
24 --[[if getmetatable(x) and getmetatable(x).__tostring then 11 --[[if getmetatable(x) and getmetatable(x).__tostring then
25 output = output .. tostring(x) 12 output = output .. tostring(x)
26 else]]if type(x) == "table" then 13 else]]if type.luatype(x) == "table" then
27 local subo = "" 14 local subo = ""
28 for k,v in pairs(x) do 15 for k,v in pairs(x) do
29 if v == x then 16 if v == x then
@@ -46,8 +33,5 @@ function pp.pp (x)
46 print(pp.dump(x)) 33 print(pp.dump(x))
47end 34end
48 35
49return setmetatable(pp, { __call = 36---
50 function(_, x) 37return pp
51 return pp.pp(x)
52 end,
53})
diff --git a/read.lua b/read.lua index 00a2d2a..bba4ffa 100644 --- a/read.lua +++ b/read.lua
@@ -1,173 +1,182 @@
1--- lam.read 1--- lam.read
2 2
3local read = {} 3local read = {}
4local type = require "type"
4local utf8 = require "utf8" 5local utf8 = require "utf8"
5local types = require "types" 6local util = require "util"
6table.unpack = table.unpack or unpack 7local unpack = table.unpack or unpack
7
8local string_to_table =
9 function(str)
10 local tbl = {}
11 for p, c in utf8.codes(str) do
12 table.insert(tbl, c)
13 end
14 return tbl
15 end
16 8
17local consume_whitespace = 9function program_characters (program)
18 function (chars) 10 local chars = {}
19 local s = {"\\"} -- accumulator for if there's no \n 11 for pos, code in utf8.codes(program) do
20 while chars[1]:match("[ \t]") do 12 table.insert(chars, code)
21 table.insert(s, util.pop(chars))
22 end
23 if chars[1] ~= "\n" then
24 table.insert(s, chars[1])
25 return table.concat(s), chars
26 end
27 while chars[1]:match("%s") do
28 util.pop(chars)
29 end
30 return chars[1], chars
31 end 13 end
14 return chars
15end
32 16
33local consume_hexvalue = 17local function consume_string_whitespace (chars)
34 function (chars) 18 -- \<intraline ws>*<line ending> <intraline ws>* : nothing
35 local u8ch = {} 19 local s = {"\\"}
36 repeat 20 while chars[1]:match("[ \t]") do
37 local c = util.pop(chars) 21 table.insert(s, util.pop(chars))
38 table.insert(u8ch,c)
39 until c == ";"
40 table.remove(u8ch) -- remove semicolon
41 return
42 utf8.char(tonumber(table.concat(u8ch), 16)),
43 chars
44 end 22 end
23 if chars[1] ~= "\n" then
24 table.insert(s, chars[1])
25 return table.concat(s), chars
26 end
27 while chars[1]:match("%s") do
28 util.pop(chars)
29 end
30 return chars[1], chars
31end
45 32
46local string_bslash = { -- backslash characters 33local function consume_string_hexvalue (chars)
47 a = "\a",
48 b = "\b",
49 t = "\t",
50 n = "\n",
51 r = "\r",
52 ["\""] = "\"",
53 ["\\"] = "\\",
54 ["|"] = "|",
55 -- \<intraline ws>*<line ending> <intraline ws>* : nothing
56 [" "] = consume_whitespace,
57 ["\t"] = consuem_whitespace,
58 ["\n"] = consume_whitespace,
59 -- \x<hex scalar value>; : specified character 34 -- \x<hex scalar value>; : specified character
60 x = consume_hexvalue, 35 local u8ch = {}
61} 36 repeat
37 local c = util.pop(chars)
38 table.insert(u8ch, c)
39 until c == ";"
40 table.remove(u8ch) -- remove semicolon
41 return utf8.char(tonumber(table.concat(u8ch), 16)), chars
42end
62 43
63local consume_string = 44local function consume_string (chars)
64 function(chars) 45 local str = {}
65 local str = {} 46 local backslash = {
66 repeat 47 a = "\a",
67 local c = util.pop(chars) 48 b = "\b",
68 if c == "\\" then 49 t = "\t",
69 c = chars[1] 50 n = "\n",
70 if string_bslash[c] then 51 r = "\r",
71 if type(string_bslash[c]) == "function" 52 ["\""] = "\"",
72 then 53 ["\\"] = "\\",
73 c, chars = 54 ["|"] = "|",
74 string_bslash[c](chars) 55 [" "] = consume_string_whitespace,
75 table.insert(str, c) 56 ["\t"] = consume_string_whitespace,
76 else 57 ["\n"] = consume_string_whitespace,
77 table.insert( 58 x = consume_string_hexvalue,
78 str, 59 }
79 string_bslash[c]) 60 util.pop(chars) -- throw initial " away
80 end 61 repeat
62 local c = util.pop(chars)
63 if c == [[\]] then
64 c = chars[1]
65 if backlash[c] then
66 if type(backslash[c]) == "function" then
67 c, chars = backslash[c](chars)
68 table.insert(str, c)
81 else 69 else
82 table.insert(str, "\\"..c) 70 table.insert(str, backlash[c])
83 end 71 end
84 util.pop(chars)
85 elseif c == "\"" then
86 break
87 else 72 else
88 table.insert(str, c) 73 table.insert(str, "\\"..c)
89 end 74 end
90 until #chars == 0 75 util.pop(chars)
91 return table.concat(str), chars 76 elseif c == [["]] then
77 break
78 else
79 table.insert(str, c)
80 end
81 until #chars == 0
82 return table.concat(str), "string", chars
83end
84
85local function consume_token (chars)
86 local tok = {}
87 while chars[1]:match("[^%s()\"#'`,@;]") do
88 table.insert(tok, util.pop(chars))
92 end 89 end
90 return table.concat(tok), chars
91end
93 92
94read.tokenize = 93local consume_symbol = consume_token
95 function (program) 94
96 if not program or program == "" then return nil end 95local function consume_number (chars)
97 local tokens = {} 96 local digits, chars = consume_token(chars)
98 local token = "" 97 local num = tonumber(digits)
99 local token_type = nil 98 if num == nil then error("Bad number: " .. num) end
100 99 return num, chars
101 local push_token = 100end
102 function (type, tok) 101
103 type = type or token_type 102local function consume_whitespace (chars)
104 token = tok or token 103 while chars[1]:match("%s") do util.pop(chars) end
105 if token:len() > 0 then 104 return chars
106 table.insert(tokens, { 105end
107 type = type, 106
108 value = token, }) 107local function consume_comment (chars)
109 token = "" 108 local comment = {}
110 token_type = nil 109 repeat
111 end 110 table.insert(comment, util.pop(chars))
112 end 111 until #chars == 0 or chars[1]:match("\n")
112 return table.concat(comment), "comment", chars
113end
114
115--- API
113 116
114 local chars = string_to_table(program) 117read.readtable = {
115 while #chars > 0 do 118 ["("] = function(chars) return util.pop(chars), "begin_list", chars end,
116 local c = util.pop(chars) 119 [")"] = function(chars) return util.pop(chars), "end_list", chars end,
117 if c == "(" then 120 ["\""] = consume_string,
118 push_token() 121 [";"] = consume_comment,
119 push_token("begin_list", "(") 122 -- ["#"] =
120 elseif c == ")" then 123 -- ["'"] =
121 push_token() 124 -- ["`"] =
122 push_token("end_list", ")") 125 -- [","] =
123 elseif c:match("%s") then -- whitespace 126}
124 push_token() 127
125 elseif c == "\"" then -- string 128function read.scan (chars)
126 str, chars = consume_string(chars) 129 local chars = chars
127 push_token("string", str) 130 return function()
128 elseif c:match("%d") then -- numbers 131 if #chars == 0 then return nil end
129 token = token .. c 132 local token, toktype = "", nil
130 token_type = token_type or "number" 133 while true do
134 if read.readtable[chars[1]] then
135 token, toktype, chars =
136 read.readtable[chars[1]](chars)
137 return token, toktype
138 elseif chars[1]:match("%s") then
139 chars = consume_whitespace(chars)
140 elseif chars[1]:match("%d") then
141 token, chars = consume_number(chars)
142 return token, "number"
131 else 143 else
132 token = token .. c 144 token, chars = consume_symbol(chars)
133 token_type = token_type or "symbol" 145 return token, "symbol"
134 end 146 end
135 end 147 end
136 push_token()
137 return tokens
138 end 148 end
149end
139 150
140read.tokentable = { 151function read.tokenize (program)
141 string = function (tok) return types.String(tok.value) end, 152 if not program or #program == 0 then return nil end
142 number = function (tok) return types.Number(tok.value) end, 153 local tokens = {}
143 symbol = function (tok) return types.Symbol(tok.value) end, 154 for token, toktype in read.scan(program_characters(program)) do
144} 155 table.insert(tokens, {type = toktype, value = token})
156 end
157 return tokens
158end
145 159
146read.parse = 160function read.parse (tokens)
147 function (tokens) 161 if not next(tokens) then return nil end
148 assert(next(tokens), "Unexpected EOF") 162 local token = util.pop(tokens)
149 tok = util.pop(tokens) 163 if token.value == "(" then
150 if tok.value == "(" then 164 local L = {}
151 local L = {} 165 while tokens[1].value ~= ")" do
152 while tokens[1].value ~= ")" do 166 table.insert(L, read.parse(tokens))
153 table.insert(L, read.parse(tokens))
154 end
155 util.pop(tokens) -- remove ")"
156 return types.List(table.unpack(L))
157 elseif tok.value == ")" then
158 error("Unexpected ')'")
159 elseif read.tokentable[tok.type] then
160 return read.tokentable[tok.type](tok)
161 else
162 error("Bad token: '" .. tok.value .. "'")
163 end 167 end
168 util.pop(tokens) -- remove the final ")"
169 return type.List(L)
170 elseif token.value == ")" then
171 error("Unexpected ')'")
172 else
173 return token.value
164 end 174 end
175end
165 176
166read.read = function (program) return read.parse(read.tokenize(program)) end 177function read.read (program)
178 return read.parse(read.tokenize(program))
179end
167 180
168--- 181---
169return setmetatable(read, { __call = 182return read
170 function(_, program)
171 return read.read(program)
172 end,
173})
diff --git a/repl.lua b/repl.lua deleted file mode 100644 index a89fd2c..0000000 --- a/repl.lua +++ /dev/null
@@ -1,42 +0,0 @@
1--- lam.repl
2
3local repl = {}
4local eval = require "eval"
5local read = require "read"
6local util = require "util"
7table.unpack = table.unpack or unpack
8
9function schemestr(x)
10 if type(x) == "table" then
11 local ts = "(" .. schemestr(util.pop(x))
12 for i,v in ipairs(x) do
13 ts = string.format("%s %s", ts, schemestr(v))
14 end
15 ts = ts .. ")"
16 return ts
17 elseif x == true then
18 return "#t"
19 elseif x == false then
20 return "#f"
21 else
22 return tostring(x)
23 end
24end
25
26function repl.repl (prompt)
27 prompt = prompt or "lam> "
28 repeat
29 io.write(prompt)
30 io.output():flush()
31 input = io.read()
32 if input == ",q" or input == ",quit" then
33 break
34 else
35 val = eval(read(input))
36 if val then print(schemestr(val)) end
37 end
38 until false
39end
40
41---
42return repl
diff --git a/test.lua b/test.lua new file mode 100644 index 0000000..ce8c034 --- /dev/null +++ b/test.lua
@@ -0,0 +1,28 @@
1--- lam.test
2-- testing helpers
3
4local test = {}
5local eval = require("eval").eval
6local read = require("read").read
7
8function test.lambda ()
9 local ls = {
10 [ [[((lambda (x) (+ x x)) 3)]] ] = 6,
11 [ [[((lambda () 100))]] ] = 100,
12 [ [[((lambda (x) 1 2 3) 4)]] ] = 3,
13 [ [[((lambda () 1 2 3))]] ] = 3,
14 [ [[((lambda (x) x (+ x x) (+ x x x)) 9)]] ] = 27,
15 }
16 for l, target in pairs(ls) do
17 io.write(string.format("%s == %s\n\t", l, target))
18 local value = eval(read(l))
19 if value == target then
20 print "ok"
21 else
22 print(string.format("not ok : %s", value))
23 end
24 end
25end
26
27---
28return test
diff --git a/type.lua b/type.lua new file mode 100644 index 0000000..945f4d1 --- /dev/null +++ b/type.lua
@@ -0,0 +1,137 @@
1--- lam.type
2-- lisp types
3
4local t = {}
5local util = require "util"
6local unpack = table.unpack or unpack
7
8--- Determining types
9
10t.luatype = type
11
12function t.lamtype (x)
13 if t.luatype(x) == "number" then
14 return "Number"
15 elseif t.luatype(x) == "string" then
16 return "Symbol"
17 elseif getmetatable(x) and getmetatable(x).__type then
18 return getmetatable(x).__type
19 else
20 return t.luatype(x)
21 end
22end
23
24-- isa is really only useful on basic types (i.e., not Lists)
25function t.isa (x, type)
26 return t.lamtype(x) == type
27end
28
29--- Creating types
30
31-- Symbols and Numbers are strings and numbers, respectively. At some point
32-- I'll want to implement a full numeric tower and symbol tables or namespaces
33-- or whatever, but today is not that day
34t.Symbol = tostring
35t.Number = tonumber
36
37-- Strings are (lightly) wrapped
38function t.String (str)
39 local v = {
40 value = str,
41 escape =
42 function (self)
43 return self.gsub("[\\\"]", "\\%1")
44 end,
45 }
46 local mt = {
47 __type = "String",
48 __tostring =
49 function (self)
50 return string.format("\"%s\"", self:escape())
51 end,
52 }
53 return setmetatable(v, mt)
54end
55
56function t.totable (cons)
57 local out = {}
58 local car, cdr = cons.car, cons.cdr
59 while cdr do
60 table.insert(out, tostring(car))
61 if t.luatype(cdr) == "table" then
62 car = cdr.car
63 cdr = cdr.cdr
64 else
65 table.insert(out, cdr)
66 break
67 end
68 end
69 return out
70end
71
72-- Conses are Lisp's fundamental collection type
73function t.Cons (a, b)
74 local v = { a, b, }
75 local mt = {
76 __type = "Cons",
77 __index =
78 function (self, key)
79 if key == "car" then
80 return self[1]
81 elseif key == "cdr" then
82 return self[2]
83 end
84 end,
85 __tostring =
86 function (self)
87 local out = {}
88 local car, cdr = self.car, self.cdr
89 while cdr do
90 table.insert(out, tostring(car))
91 if t.luatype(cdr) == "table" then
92 car = cdr.car
93 cdr = cdr.cdr
94 else
95 table.insert(out, ".")
96 table.insert(out, cdr)
97 break
98 end
99 end
100 return "("..table.concat(out, " ")..")"
101 end,
102 }
103 return setmetatable(v, mt)
104end
105
106-- Null is the one value that is both an atom and a list
107t.Null = setmetatable({}, {
108 __type = "Null",
109 __tostring = function (self) return "()" end,
110})
111
112function t.isNull (x)
113 return x == t.Null
114end
115
116-- Lists are chained Conses ending in Null
117function t.List (items)
118 local function tolist (base, items)
119 if #items == 0 then return base end
120 return tolist(t.Cons(table.remove(items), base), items)
121 end
122 return tolist(t.Null, items)
123end
124
125function t.isList (x)
126 -- TODO: this does not detect circular lists yet
127 if t.isNull(x) then
128 return true
129 elseif t.isa(x, "Cons") then
130 return t.isList(x.cdr)
131 else
132 return false
133 end
134end
135
136---
137return t
diff --git a/types.lua b/types.lua deleted file mode 100644 index e4813b2..0000000 --- a/types.lua +++ /dev/null
@@ -1,112 +0,0 @@
1--- lam.types
2
3local types = {}
4local util = require "util"
5table.unpack = table.unpack or unpack
6
7--- Converting between types
8
9types.globalns = {} -- namespace
10
11types.Symbol =
12 function (name, ns, aliases)
13 ns = ns or types.globalns
14 aliases = aliases or {}
15 if ns[name] then return ns[name] end
16 local sym = { name = name, aliases = aliases }
17 ns[name] = sym
18 for _,a in ipairs(aliases) do
19 ns[a] = sym
20 end
21 local mt = {
22 __type = "Symbol",
23 __tostring = function (self) return self.name end,
24 }
25 return setmetatable(sym, mt)
26 end
27
28types.Number = tonumber
29
30types.String =
31 function (str)
32 local s = {
33 value = str,
34 escape =
35 function(self)
36 return self:gsub("\"", "\\\"")
37 end,
38 }
39 local mt = {
40 __type = "String",
41 __tostring =
42 function (self)
43 return string.format(
44 "\"%s\"",
45 self:escape())
46 end,
47 }
48 return setmetatable(s, mt)
49 end
50
51types.Cons =
52 function (a, b)
53 assert(a ~= nil and b ~= nil,
54 "Need two non-nil arguments in a pair")
55 local s = { a, b }
56 local mt = {
57 __type = "Pair",
58 __tostring =
59 function (p)
60 local out = {}
61 local car, cdr = p[1], p[2]
62 while cdr do
63 table.insert(out, tostring(car))
64 if type(cdr) == "table" then
65 car = cdr[1]
66 cdr = cdr[2]
67 else
68 table.insert(out, ".")
69 table.insert(out, cdr)
70 break
71 end
72 end
73 return "("..table.concat(out, " ")..")"
74 end
75
76 }
77 return setmetatable(s, mt)
78 end
79
80types.List =
81 function (tbl)
82 local function tolist(base, items)
83 if #items == 0 then return base end
84 return tolist(
85 types.Cons(table.remove(items), base),
86 items)
87 end
88 return tolist({}, tbl)
89 end
90
91--- Determining types
92
93types.lamtype =
94 function (x)
95 if type(x) == "number" then
96 return "Number"
97 elseif getmetatable(x) and getmetatable(x).__type then
98 return getmetatable(x).__type
99 else
100 return type(x)
101 end
102 end
103
104--- Type predicates
105
106types.isa =
107 function (x, t)
108 return types.lamtype(x) == t
109 end
110
111---
112return types
diff --git a/util.lua b/util.lua index 1059edf..938848c 100644 --- a/util.lua +++ b/util.lua
@@ -1,42 +1,11 @@
1--- lam.util 1--- lam.util
2 2
3local util = {} 3local util = {}
4table.unpack = table.unpack or unpack 4local unpack = table.unpack or unpack
5
6function util.table (x)
7 if type(x) == "table" then
8 return x
9 else
10 return { x }
11 end
12end
13 5
14function util.pop (tbl) 6function util.pop (tbl)
15 return table.remove(tbl, 1) 7 return table.remove(tbl, 1)
16end 8end
17 9
18function util.car (tbl)
19 return tbl[1]
20end
21
22function util.cdr (tbl)
23 local t = {}
24 for i = 2, #tbl do t[i-1] = tbl[i] end
25 return t
26end
27
28function util.reduce (tbl, seed, fn)
29 if #tbl == 0 then return seed end
30 return util.reduce(tbl, fn(seed, util.pop(tbl)), fn)
31end
32
33function util.map (fn, tbl)
34 local out = {}
35 for k, v in pairs(tbl) do
36 out[k] = fn(v)
37 end
38 return out
39end
40
41--- 10---
42return util 11return util
© 2022 C. Duckworth. generated by cgit. comments, issues, and patches welcome at < git at acdw dot net >.