about summary refs log tree commit diff stats
path: root/read.lua
blob: 4fb9b707b32302615b585e1cd6ca56a160655b21 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
--- lam.read

local m = {}
local t = require "type"
local utf8 = require "utf8"
local pop = require("util").pop

-- TODO:
-- - string reading
-- - # syntax
-- - comments
-- - probably more

function m.inport (source, kind)
	-- KIND can be one of "file", "string"; defaults to "file"
	-- SOURCE is the name of the file or the string to read, or nil; if nil,
	-- read from standard input.
	local f, l
	local k = kind or "file"
	if source then
		if kind == "file" then
			f = io.open(source, "r")
		elseif kind == "string" then
			l = m.tochars(source)
		end
	else
		-- KIND is ignored here
		f = io.input()
	end
	local t = {
		file = f,
		line = l or {},
		next_token =
			function (self)
				local tok, toktype
				while true do
					if #self.line == 0 and self.file then
						self.line = m.tochars(
							self.file:read("*l"))
					end
					if not self.line or #self.line == 0 then
						return nil
					end
					tok, toktype, self.line =
						m.scan(self.line)()
					if tok ~= nil then
						return tok, toktype
					end
				end
			end,
	}
	if t.file then t.close = function (self) self.file:close() end; end
	local mt = {
		__type = "port",
		__tostring =
			function (self)
				return string.format("#<port %s>",
					self.file or "(string)")
			end,
	}
	return setmetatable(t, mt)
end

function m.tochars (s)
	local chars = {}
	for _, code in utf8.codes(s) do
		table.insert(chars, code)
	end
	return chars
end

--- Consumers
-- These take a table of characters (cs) and return:
-- a token, its type, and the rest of the characters

local token_separator = "[^%s#()\"'`,@;]"

local function consume_token (cs)
	local token = {}
	while #cs > 0 and cs[1]:match(token_separator) do
		table.insert(token, pop(cs))
	end
	return table.concat(token), "symbol", cs
end

local function consume_whitespace (cs)
	while #cs > 0 and cs[1]:match("%s") do pop(cs) end
	return nil, nil, cs
end

local function consume_comment (cs)
	local comment = {}
	repeat table.insert(comment, pop(cs))
	until #cs == 0 or cs[1]:match("\n")
	return table.concat(comment), "comment", cs
end

local function idf (x)
	return function () return x end
end

local function numf (base)
	return function (token)
		local n = tonumber(token:sub(3), base)
		assert(n, "Can't read number: " .. token)
		return n
	end
end

local literals = {
	literal = {
		["#t"] = idf(true),
		["#true"] = idf(true),
		["#f"] = idf(false),
		["#false"] = idf(false),
		["#\\space"] = idf(t.character(" ")),
		["#\\tab"] = idf(t.character("\t")),
		["#\\newline"] = idf(t.character("\n")),
	},
	match = {
		["^#b"] = numf(2),
		["^#o"] = numf(8),
		["^#d"] = numf(10),
		["^#x"] = numf(16),
		["^#\\"] = function (tok) return t.character(tok:sub(3)) end,
	}
}

local function consume_literal (cs)
	-- whitespace and parantheses character literals.
	-- reverse the match test b/c it's already a complement
	if cs[2] == "\\" and not cs[3]:match(token_separator) then
		return type.character(cs[3])
	end
	pop(cs) -- discard '#'
	local token, value, cs = consume_token(cs) -- todo: vectors #(...)
	token = "#" .. token -- put '#' back

	if literals.literal[token] then
		value = literals.literal[token]()
	else
		for re, fn in pairs(literals.match) do
			if token:match(re) then
				value = fn(token)
			end
		end
	end
	-- TODO : if `nil' is to be a value in lam i'm going to have to figure
	-- out some kind of 'lam nil' and 'lua nil' or something..
	assert(value~=nil, "Can't read literal: " .. token)

	return value, "literal", cs
end

--- Reading from a port

m.readtable = {
	["("] = function (cs) return pop(cs), "open", cs end,
	[")"] = function (cs) return pop(cs), "close", cs end,
	["'"] = function (cs) return pop(cs), "quote", cs end,
	["`"] = function (cs) return pop(cs), "quote", cs end,
	[","] = -- unquote
		function (cs)
			pop(cs) -- remove ','
			if cs[1] == "@" then
				pop(cs) -- remove '@'
				return ",@", "quote", cs
			else
				return ",", "quote", cs
			end
		end,
	[";"] = consume_comment,
	["#"] = consume_literal,
}

--- TODO: Figure out how to read #f and #n properly

-- Return an iterator over a character table, so you can do:
-- for token, chars in scan(cs) do ... end
function m.scan (cs)
	local cs = cs
	return function ()
		if not next(cs) then return nil end
		local token, toktype
		while true do
			if m.readtable[cs[1]] then
				token, toktype, cs = m.readtable[cs[1]](cs)
				return token, toktype, cs
			elseif cs[1]:match("%s") then
				return consume_whitespace(cs)
			elseif cs[1]:match("[%d.+-]") then
				-- numbers, +, -, ., ...
				local token, _, cs = consume_token(cs)
				if token:match("[-+]") or token == "..." then
					return token, "symbol", cs
				elseif token == "." then
					return token, "dot", cs
				else
					local n = tonumber(token)
					assert (n ~= nil, "Bad number: "..n)
					return n, "number", cs
				end
			else
				return consume_token(cs)
			end
		end
	end
end

function m.readchar (port)
	if #port.line > 0 then
		local ch = pop(port.line)
		return ch
	else
		return port.file and port.file.read(1)
	end
end

m.readmacros = {
	quote =
		function (tok, toktype, port)
			local qs = {
				["'"] = "quote",
				["`"] = "quasiquote",
				[","] = "unquote",
				[",@"] = "unquote-splicing",
			}
			if not qs[tok] then
				error(string.format("Bad quote: '%s'\n", tok))
			end
			local Q = {qs[tok]}
			table.insert(Q, m.read(port))
			return t.list(Q)
		end,
	comment = idf(nil),
}

function m.read (port)
	local function read_ahead (tok, toktype)
		if tok == nil then error("Unexpected EOF") end
		if toktype == "open" then
			local L = {}
			while true do
				local tok, toktype = port:next_token()
				if toktype == "close" then
					return t.list(L)
				elseif toktype == "dot" then
					local fin = m.read(port)
					port:next_token() -- throw away ')'
					return t.list(L, fin)
				else
					table.insert(L,
						read_ahead(tok, toktype))
				end
			end
		elseif toktype == "close" then
			error("Unexpected ')'")
		elseif m.readmacros[toktype] then
			return m.readmacros[toktype](tok, toktype, port)
		else return tok
		end
	end
	-- body of read
	local tok1, toktype1 = port:next_token()
	if tok1 == nil then return nil
	else return read_ahead(tok1, toktype1)
	end
end

function m.read_string (str)
	return m.read(m.inport(str, "string"))
end

---
return m