about summary refs log tree commit diff stats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile1
-rw-r--r--load.lua7
-rw-r--r--port.lua103
-rw-r--r--read.lua3
-rw-r--r--type.lua244
5 files changed, 176 insertions, 182 deletions
diff --git a/Makefile b/Makefile index 23d342f..66c1ff8 100644 --- a/Makefile +++ b/Makefile
@@ -3,7 +3,6 @@ LUA ?= rlwrap luajit \
3 -e 'dump = require "dump"' \ 3 -e 'dump = require "dump"' \
4 -e 'eval = require "eval"' \ 4 -e 'eval = require "eval"' \
5 -e 'load = require "load"' \ 5 -e 'load = require "load"' \
6 -e 'port = require "port"' \
7 -e 'read = require "read"' \ 6 -e 'read = require "read"' \
8 -e 'repl = require "repl"' \ 7 -e 'repl = require "repl"' \
9 -e 'type = require "type"' \ 8 -e 'type = require "type"' \
diff --git a/load.lua b/load.lua index f798712..7f14207 100644 --- a/load.lua +++ b/load.lua
@@ -3,7 +3,6 @@
3local m = {} 3local m = {}
4local core = require("core") 4local core = require("core")
5local eval = require("eval") 5local eval = require("eval")
6local port = require("port")
7local read = require("read") 6local read = require("read")
8local type = require("type") 7local type = require("type")
9 8
@@ -23,7 +22,7 @@ end
23 22
24function m.load (filename, interactive) 23function m.load (filename, interactive)
25 -- interactive = { out = file/handle, prompt = string, } 24 -- interactive = { out = file/handle, prompt = string, }
26 local inport = port.input_port(filename) 25 local inport = type.input_port(filename)
27 if interactive then 26 if interactive then
28 io.output(interactive.out) 27 io.output(interactive.out)
29 io.output():setvbuf("line") 28 io.output():setvbuf("line")
@@ -39,7 +38,7 @@ function m.load (filename, interactive)
39 local read_ok, form = xpcall( 38 local read_ok, form = xpcall(
40 function () return read.read(inport) end, 39 function () return read.read(inport) end,
41 handle_error) 40 handle_error)
42 if form == port.eof then break end 41 if form == type.eof then break end
43 if not read_ok then 42 if not read_ok then
44 io.stderr:write("error (read): ", form, "\n") 43 io.stderr:write("error (read): ", form, "\n")
45 -- when interactive, errors should not be fatal, but 44 -- when interactive, errors should not be fatal, but
@@ -61,7 +60,7 @@ function m.load (filename, interactive)
61 if interactive then schemeprint(value) end 60 if interactive then schemeprint(value) end
62 end 61 end
63 end 62 end
64 until value == port.eof -- loop 63 until value == type.eof -- loop
65end 64end
66 65
67-------- 66--------
diff --git a/port.lua b/port.lua deleted file mode 100644 index 812f05e..0000000 --- a/port.lua +++ /dev/null
@@ -1,103 +0,0 @@
1--- lam.port --- port objects
2-- because the implementation for ports is fairly involved, they're in their own
3-- file outside of `type'.
4
5local m = {}
6local util = require("util")
7local error = util.error
8local tochars = util.tochars
9
10-- The EOF object is what the reader emits when it hits an end-of-file or use up
11-- a port.
12m.eof = setmetatable({}, {
13 __type = "eof",
14 __tostring = function () return "#<eof>" end,
15})
16
17---[[ INPUT PORTS ]]---
18
19-- return the next token from PORT, given READTABLE
20local function input_port_next_token (port, readtable)
21 repeat
22 if #port.buffer == 0 then
23 if port.file then
24 local ln = port.file:read()
25 if ln == nil then
26 return m.eof
27 end
28 port.buffer = tochars(ln)
29 else
30 return m.eof
31 end
32 end
33
34 local token, token_type
35 local c = port.buffer[1]
36 if readtable.chars[c] then
37 token, token_type, port.buffer =
38 readtable.chars[c](port.buffer)
39 else
40 for re, fn in pairs(readtable.regex) do
41 if c:match(re) then
42 token, token_type, port.buffer =
43 fn(port.buffer)
44 break
45 end
46 end
47 if token == nil then
48 token, token_type, port.buffer =
49 readtable.default(port.buffer)
50 end
51 end
52
53 port.buffer = port.buffer or {}
54 if token then
55 return token, token_type
56 end
57 until nil
58end
59
60function m.input_port (source, source_type)
61 -- SOURCE is the name of the file/string to read or nil; nil means
62 -- standard input. SOURCE_TYPE is one of "file", "string"; "file" is
63 -- the default.
64 local f, b
65 source_type = source_type or "file"
66 if source then
67 if source_type == "file" then
68 f = io.open(source, "r")
69 elseif source_type == "string" then
70 b = tochars(source)
71 else
72 error("input-port: bad type", source_type)
73 end
74 else
75 f = io.input() -- ignore SOURCE_TYPE
76 end
77 local t = {
78 file = f,
79 name = f and source or "[string]",
80 type = source_type,
81 buffer = b or {},
82 flush = function (self) self.buffer = {} end,
83 next = input_port_next_token, -- port:next(readtable)
84 close =
85 function (self)
86 if self.file then self.file:close() end
87 end,
88 }
89 local mt = {
90 __type = "input-port",
91 __tostring =
92 function (self)
93 return string.format("#<port %s>", self.name)
94 end,
95 }
96 return setmetatable(t, mt)
97end
98
99---[[ OUTPUT PORTS ]]---
100-- TODO
101
102--------
103return m
diff --git a/read.lua b/read.lua index c9058e4..666f509 100644 --- a/read.lua +++ b/read.lua
@@ -2,8 +2,7 @@
2 2
3local m = {} 3local m = {}
4local type = require("type") 4local type = require("type")
5local port = require("port") 5local eof, input_port = type.eof, type.input_port
6local eof, input_port = port.eof, port.input_port
7local util = require("util") 6local util = require("util")
8local constantly, error, pop = util.constantly, util.error, util.pop 7local constantly, error, pop = util.constantly, util.error, util.pop
9 8
diff --git a/type.lua b/type.lua index 6dbf313..79f42a6 100644 --- a/type.lua +++ b/type.lua
@@ -53,92 +53,97 @@ function m.character (x)
53 return setmetatable(t, mt) 53 return setmetatable(t, mt)
54end 54end
55 55
56---[[ PROCEEDURES AND ENVIRONMENTS ]]--- 56---[[ INPUT PORTS ]]---
57 57
58function m.environment (inner, outer) 58local function tochars (str)
59 local mt = { 59 local cs = {}
60 __type = "environment", 60 for _, code in utf8_codes(str) do
61 __index = outer, 61 table.insert(cs, code)
62 __newindex = 62 end
63 function (self, key, val) 63 return cs
64 if rawget(self, key) then 64end
65 rawset(self, key, val) 65
66 else 66-- return the next token from PORT, given READTABLE
67 getmetatable(self).__index[key] = val 67local function input_port_next_token (port, readtable)
68 repeat
69 if #port.buffer == 0 then
70 if port.file then
71 local ln = port.file:read()
72 if ln == nil then
73 return m.eof
68 end 74 end
69 end, 75 port.buffer = tochars(ln)
70 __tostring = constantly("#<environment>"), 76 else
71 } 77 return m.eof
72 return setmetatable(inner, mt) 78 end
79 end
80
81 local token, token_type
82 local c = port.buffer[1]
83 if readtable.chars[c] then
84 token, token_type, port.buffer =
85 readtable.chars[c](port.buffer)
86 else
87 for re, fn in pairs(readtable.regex) do
88 if c:match(re) then
89 token, token_type, port.buffer =
90 fn(port.buffer)
91 break
92 end
93 end
94 if token == nil then
95 token, token_type, port.buffer =
96 readtable.default(port.buffer)
97 end
98 end
99
100 port.buffer = port.buffer or {}
101 if token then
102 return token, token_type
103 end
104 until nil
73end 105end
74 106
75function m.procedure (params, body, env, eval) 107function m.input_port (source, source_type)
108 -- SOURCE is the name of the file/string to read or nil; nil means
109 -- standard input. SOURCE_TYPE is one of "file", "string"; "file" is
110 -- the default.
111 local f, b
112 source_type = source_type or "file"
113 if source then
114 if source_type == "file" then
115 f = io.open(source, "r")
116 elseif source_type == "string" then
117 b = tochars(source)
118 else
119 error("input-port: bad type", source_type)
120 end
121 else
122 f = io.input() -- ignore SOURCE_TYPE
123 end
76 local t = { 124 local t = {
77 params = params, 125 file = f,
78 body = body, 126 name = f and source or "[string]",
79 env = env, 127 type = source_type,
80 eval = eval, 128 buffer = b or {},
129 flush = function (self) self.buffer = {} end,
130 next = input_port_next_token, -- port:next(readtable)
131 close =
132 function (self)
133 if self.file then self.file:close() end
134 end,
81 } 135 }
82 local mt = { 136 local mt = {
83 __type = "procedure", 137 __type = "input-port",
84 __tostring = 138 __tostring =
85 function (self) 139 function (self)
86 return string.format("(lambda %s %s)", 140 return string.format("#<port %s>", self.name)
87 params,
88 tostring(body):sub(2, -2))
89 end,
90 __call =
91 function (self, r)
92 local rlen = #r
93 local function doargs (p, r, e)
94 -- base case
95 if m.nullp(p) and m.nullp(r) then
96 return e
97 end
98 -- (lambda x ..) or (lambda (x . y) ..)
99 if type.isp(p, "symbol") then
100 e[p] = r
101 return e
102 end
103 if p[1] == nil then
104 error("too many arguments",
105 rlen, #self.params)
106 end
107 if r[1] == nil then
108 error("too few arguments",
109 rlen, #self.params)
110 end
111 -- bind car(p) to car(r)
112 e[p[1]] = r[1]
113 -- recurse
114 return doargs(p[2], r[2], e)
115 end
116 -- create new, expanded environment
117 e = doargs(self.params, r,
118 m.environment({}, self.env))
119 local b = self.body
120 -- evaluate body forms
121 while not m.nullp(b[2]) do
122 self.eval(b[1], e)
123 b = b[2]
124 end
125 -- return last body form
126 return self.eval(b[1], e)
127 end, 141 end,
128 } 142 }
129 return setmetatable(t, mt) 143 return setmetatable(t, mt)
130end 144end
131 145
132function m.assert_arity (r, min, max) 146---[[ NULL(S) ]]---
133 local rmin = min or 0
134 local rmax = max or 1/0 -- infinity
135 local rlen = #r
136 if rlen < rmin or rlen > rmax then
137 error("wrong arity", rlen, m.cons(rmin, rmax))
138 end
139end
140
141---[[ NULL ]]---
142-- The empty list () is the only object that is both an atom and a list. It 147-- The empty list () is the only object that is both an atom and a list. It
143-- forms the ultimate tail of every "proper" list. The important thing is that 148-- forms the ultimate tail of every "proper" list. The important thing is that
144-- it's its own object. 149-- it's its own object.
@@ -152,6 +157,17 @@ function m.nullp (x)
152 return x == m.null 157 return x == m.null
153end 158end
154 159
160-- The EOF object is what the reader emits when it hits an end-of-file or use up
161-- a port.
162m.eof = setmetatable({}, {
163 __type = "eof",
164 __tostring = function () return "#<eof>" end,
165})
166
167function m.eofp (x)
168 return x == m.eof
169end
170
155---[[ COLLECTION TYPES ]]--- 171---[[ COLLECTION TYPES ]]---
156 172
157-- cons are lisp's fundamental collection type: they link two things together in 173-- cons are lisp's fundamental collection type: they link two things together in
@@ -231,6 +247,90 @@ function m.string (x)
231 return setmetatable(t, mt) 247 return setmetatable(t, mt)
232end 248end
233 249
250---[[ PROCEEDURES AND ENVIRONMENTS ]]---
251
252function m.environment (inner, outer)
253 local mt = {
254 __type = "environment",
255 __index = outer,
256 __newindex =
257 function (self, key, val)
258 if rawget(self, key) then
259 rawset(self, key, val)
260 else
261 getmetatable(self).__index[key] = val
262 end
263 end,
264 __tostring = function (_) return "#<environment>" end,
265 }
266 return setmetatable(inner, mt)
267end
268
269function m.procedure (params, body, env, eval)
270 local t = {
271 params = params,
272 body = body,
273 env = env,
274 eval = eval,
275 }
276 local mt = {
277 __type = "procedure",
278 __tostring =
279 function (self)
280 return string.format("#<procedure %s>",
281 self.params)
282 end,
283 __call =
284 function (self, r)
285 local rlen = #r
286 local function doargs (p, r, e)
287 -- base case
288 if m.nullp(p) and m.nullp(r) then
289 return e
290 end
291 -- (lambda x ..) or (lambda (x . y) ..)
292 if type.isp(p, "symbol") then
293 e[p] = r
294 return e
295 end
296 if p[1] == nil then
297 error("too many arguments",
298 rlen, #self.params)
299 end
300 if r[1] == nil then
301 error("too few arguments",
302 rlen, #self.params)
303 end
304 -- bind car(p) to car(r)
305 e[p[1]] = r[1]
306 -- recurse
307 return doargs(p[2], r[2], e)
308 end
309 -- create new, expanded environment
310 e = doargs(self.params, r,
311 m.environment({}, self.env))
312 local b = self.body
313 -- evaluate body forms
314 while not m.nullp(b[2]) do
315 self.eval(b[1], e)
316 b = b[2]
317 end
318 -- return last body form
319 return self.eval(b[1], e)
320 end,
321 }
322 return setmetatable(t, mt)
323end
324
325function m.assert_arity (r, min, max)
326 local rmin = min or 0
327 local rmax = max or 1/0 -- infinity
328 local rlen = #r
329 if rlen < rmin or rlen > rmax then
330 error("wrong arity", rlen, m.cons(rmin, rmax))
331 end
332end
333
234---[[ TYPE DETECTION AND PREDICATES ]]--- 334---[[ TYPE DETECTION AND PREDICATES ]]---
235 335
236-- to avoid name clashes, `type` is saved in type.luatype 336-- to avoid name clashes, `type` is saved in type.luatype
© 2022 C. Duckworth. generated by cgit. comments, issues, and patches welcome at < git at acdw dot net >.