Move port.lua to type.lua

Ports are types

5 files changed, 176 insertions, 182 deletions

@@ -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"' \
@@ -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
 
 --------
@@ -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 "#<eof>" 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("#<port %s>", self.name)
-                        end,
-        }
-        return setmetatable(t, mt)
-end
-
----[[ OUTPUT PORTS ]]---
--- TODO
-
---------
-return m
@@ -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
 
@@ -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("#<environment>"),
-        }
-        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("#<port %s>", 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 "#<eof>" 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 "#<environment>" 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("#<procedure %s>",
+                                        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