From 81be7fec584156d80020bcdab896a64d758baa87 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sat, 13 Apr 2024 18:01:12 -0500 Subject: Move port.lua to type.lua Ports are types --- Makefile | 1 - load.lua | 7 +- port.lua | 103 --------------------------- read.lua | 3 +- type.lua | 244 ++++++++++++++++++++++++++++++++++++++++++++------------------- 5 files changed, 176 insertions(+), 182 deletions(-) delete mode 100644 port.lua diff --git a/Makefile b/Makefile index 23d342f..66c1ff8 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,6 @@ LUA ?= rlwrap luajit \ -e 'dump = require "dump"' \ -e 'eval = require "eval"' \ -e 'load = require "load"' \ - -e 'port = require "port"' \ -e 'read = require "read"' \ -e 'repl = require "repl"' \ -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 @@ local m = {} local core = require("core") local eval = require("eval") -local port = require("port") local read = require("read") local type = require("type") @@ -23,7 +22,7 @@ end function m.load (filename, interactive) -- interactive = { out = file/handle, prompt = string, } - local inport = port.input_port(filename) + local inport = type.input_port(filename) if interactive then io.output(interactive.out) io.output():setvbuf("line") @@ -39,7 +38,7 @@ function m.load (filename, interactive) local read_ok, form = xpcall( function () return read.read(inport) end, handle_error) - if form == port.eof then break end + if form == type.eof then break end if not read_ok then io.stderr:write("error (read): ", form, "\n") -- when interactive, errors should not be fatal, but @@ -61,7 +60,7 @@ function m.load (filename, interactive) if interactive then schemeprint(value) end end end - until value == port.eof -- loop + until value == type.eof -- loop end -------- diff --git a/port.lua b/port.lua deleted file mode 100644 index 812f05e..0000000 --- a/port.lua +++ /dev/null @@ -1,103 +0,0 @@ ---- lam.port --- port objects --- because the implementation for ports is fairly involved, they're in their own --- file outside of `type'. - -local m = {} -local util = require("util") -local error = util.error -local tochars = util.tochars - --- The EOF object is what the reader emits when it hits an end-of-file or use up --- a port. -m.eof = setmetatable({}, { - __type = "eof", - __tostring = function () return "#" end, -}) - ----[[ INPUT PORTS ]]--- - --- return the next token from PORT, given READTABLE -local function input_port_next_token (port, readtable) - repeat - if #port.buffer == 0 then - if port.file then - local ln = port.file:read() - if ln == nil then - return m.eof - end - port.buffer = tochars(ln) - else - return m.eof - end - end - - local token, token_type - local c = port.buffer[1] - if readtable.chars[c] then - token, token_type, port.buffer = - readtable.chars[c](port.buffer) - else - for re, fn in pairs(readtable.regex) do - if c:match(re) then - token, token_type, port.buffer = - fn(port.buffer) - break - end - end - if token == nil then - token, token_type, port.buffer = - readtable.default(port.buffer) - end - end - - port.buffer = port.buffer or {} - if token then - return token, token_type - end - until nil -end - -function m.input_port (source, source_type) - -- SOURCE is the name of the file/string to read or nil; nil means - -- standard input. SOURCE_TYPE is one of "file", "string"; "file" is - -- the default. - local f, b - source_type = source_type or "file" - if source then - if source_type == "file" then - f = io.open(source, "r") - elseif source_type == "string" then - b = tochars(source) - else - error("input-port: bad type", source_type) - end - else - f = io.input() -- ignore SOURCE_TYPE - end - local t = { - file = f, - name = f and source or "[string]", - type = source_type, - buffer = b or {}, - flush = function (self) self.buffer = {} end, - next = input_port_next_token, -- port:next(readtable) - close = - function (self) - if self.file then self.file:close() end - end, - } - local mt = { - __type = "input-port", - __tostring = - function (self) - return string.format("#", self.name) - end, - } - return setmetatable(t, mt) -end - ----[[ OUTPUT PORTS ]]--- --- TODO - --------- -return m diff --git a/read.lua b/read.lua index c9058e4..666f509 100644 --- a/read.lua +++ b/read.lua @@ -2,8 +2,7 @@ local m = {} local type = require("type") -local port = require("port") -local eof, input_port = port.eof, port.input_port +local eof, input_port = type.eof, type.input_port local util = require("util") local constantly, error, pop = util.constantly, util.error, util.pop 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) return setmetatable(t, mt) end ----[[ PROCEEDURES AND ENVIRONMENTS ]]--- +---[[ INPUT PORTS ]]--- -function m.environment (inner, outer) - local mt = { - __type = "environment", - __index = outer, - __newindex = - function (self, key, val) - if rawget(self, key) then - rawset(self, key, val) - else - getmetatable(self).__index[key] = val +local function tochars (str) + local cs = {} + for _, code in utf8_codes(str) do + table.insert(cs, code) + end + return cs +end + +-- return the next token from PORT, given READTABLE +local function input_port_next_token (port, readtable) + repeat + if #port.buffer == 0 then + if port.file then + local ln = port.file:read() + if ln == nil then + return m.eof end - end, - __tostring = constantly("#"), - } - return setmetatable(inner, mt) + port.buffer = tochars(ln) + else + return m.eof + end + end + + local token, token_type + local c = port.buffer[1] + if readtable.chars[c] then + token, token_type, port.buffer = + readtable.chars[c](port.buffer) + else + for re, fn in pairs(readtable.regex) do + if c:match(re) then + token, token_type, port.buffer = + fn(port.buffer) + break + end + end + if token == nil then + token, token_type, port.buffer = + readtable.default(port.buffer) + end + end + + port.buffer = port.buffer or {} + if token then + return token, token_type + end + until nil end -function m.procedure (params, body, env, eval) +function m.input_port (source, source_type) + -- SOURCE is the name of the file/string to read or nil; nil means + -- standard input. SOURCE_TYPE is one of "file", "string"; "file" is + -- the default. + local f, b + source_type = source_type or "file" + if source then + if source_type == "file" then + f = io.open(source, "r") + elseif source_type == "string" then + b = tochars(source) + else + error("input-port: bad type", source_type) + end + else + f = io.input() -- ignore SOURCE_TYPE + end local t = { - params = params, - body = body, - env = env, - eval = eval, + file = f, + name = f and source or "[string]", + type = source_type, + buffer = b or {}, + flush = function (self) self.buffer = {} end, + next = input_port_next_token, -- port:next(readtable) + close = + function (self) + if self.file then self.file:close() end + end, } local mt = { - __type = "procedure", + __type = "input-port", __tostring = function (self) - return string.format("(lambda %s %s)", - params, - tostring(body):sub(2, -2)) - end, - __call = - function (self, r) - local rlen = #r - local function doargs (p, r, e) - -- base case - if m.nullp(p) and m.nullp(r) then - return e - end - -- (lambda x ..) or (lambda (x . y) ..) - if type.isp(p, "symbol") then - e[p] = r - return e - end - if p[1] == nil then - error("too many arguments", - rlen, #self.params) - end - if r[1] == nil then - error("too few arguments", - rlen, #self.params) - end - -- bind car(p) to car(r) - e[p[1]] = r[1] - -- recurse - return doargs(p[2], r[2], e) - end - -- create new, expanded environment - e = doargs(self.params, r, - m.environment({}, self.env)) - local b = self.body - -- evaluate body forms - while not m.nullp(b[2]) do - self.eval(b[1], e) - b = b[2] - end - -- return last body form - return self.eval(b[1], e) + return string.format("#", self.name) end, } return setmetatable(t, mt) end -function m.assert_arity (r, min, max) - local rmin = min or 0 - local rmax = max or 1/0 -- infinity - local rlen = #r - if rlen < rmin or rlen > rmax then - error("wrong arity", rlen, m.cons(rmin, rmax)) - end -end - ----[[ NULL ]]--- +---[[ NULL(S) ]]--- -- The empty list () is the only object that is both an atom and a list. It -- forms the ultimate tail of every "proper" list. The important thing is that -- it's its own object. @@ -152,6 +157,17 @@ function m.nullp (x) return x == m.null end +-- The EOF object is what the reader emits when it hits an end-of-file or use up +-- a port. +m.eof = setmetatable({}, { + __type = "eof", + __tostring = function () return "#" end, +}) + +function m.eofp (x) + return x == m.eof +end + ---[[ COLLECTION TYPES ]]--- -- cons are lisp's fundamental collection type: they link two things together in @@ -231,6 +247,90 @@ function m.string (x) return setmetatable(t, mt) end +---[[ PROCEEDURES AND ENVIRONMENTS ]]--- + +function m.environment (inner, outer) + local mt = { + __type = "environment", + __index = outer, + __newindex = + function (self, key, val) + if rawget(self, key) then + rawset(self, key, val) + else + getmetatable(self).__index[key] = val + end + end, + __tostring = function (_) return "#" end, + } + return setmetatable(inner, mt) +end + +function m.procedure (params, body, env, eval) + local t = { + params = params, + body = body, + env = env, + eval = eval, + } + local mt = { + __type = "procedure", + __tostring = + function (self) + return string.format("#", + self.params) + end, + __call = + function (self, r) + local rlen = #r + local function doargs (p, r, e) + -- base case + if m.nullp(p) and m.nullp(r) then + return e + end + -- (lambda x ..) or (lambda (x . y) ..) + if type.isp(p, "symbol") then + e[p] = r + return e + end + if p[1] == nil then + error("too many arguments", + rlen, #self.params) + end + if r[1] == nil then + error("too few arguments", + rlen, #self.params) + end + -- bind car(p) to car(r) + e[p[1]] = r[1] + -- recurse + return doargs(p[2], r[2], e) + end + -- create new, expanded environment + e = doargs(self.params, r, + m.environment({}, self.env)) + local b = self.body + -- evaluate body forms + while not m.nullp(b[2]) do + self.eval(b[1], e) + b = b[2] + end + -- return last body form + return self.eval(b[1], e) + end, + } + return setmetatable(t, mt) +end + +function m.assert_arity (r, min, max) + local rmin = min or 0 + local rmax = max or 1/0 -- infinity + local rlen = #r + if rlen < rmin or rlen > rmax then + error("wrong arity", rlen, m.cons(rmin, rmax)) + end +end + ---[[ TYPE DETECTION AND PREDICATES ]]--- -- to avoid name clashes, `type` is saved in type.luatype -- cgit 1.4.1-21-gabe81