about summary refs log tree commit diff stats
path: root/type.lua
diff options
context:
space:
mode:
authorCase Duckworth2024-04-13 18:01:12 -0500
committerCase Duckworth2024-04-13 18:01:27 -0500
commit81be7fec584156d80020bcdab896a64d758baa87 (patch)
treed0ef58ddbc23c054fa61a8b51f020856138f0bce /type.lua
parentAdd values and string-append (diff)
downloadlam-81be7fec584156d80020bcdab896a64d758baa87.tar.gz
lam-81be7fec584156d80020bcdab896a64d758baa87.zip
Move port.lua to type.lua
Ports are types
Diffstat (limited to 'type.lua')
-rw-r--r--type.lua244
1 files changed, 172 insertions, 72 deletions
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 >.