Add QUOTE, QUASIQUOTE, UNQUOTE reading and generalize

1 files changed, 48 insertions, 25 deletions

@@ -4,6 +4,7 @@ local read = {}
 local type = require "type"
 local utf8 = require "utf8"
 local util = require "util"
+local pop = util.pop
 local unpack = table.unpack or unpack
 
 function program_characters (program)
@@ -18,14 +19,14 @@ local function consume_string_whitespace (chars)
         -- \<intraline ws>*<line ending> <intraline ws>* : nothing
         local s = {"\\"}
         while chars[1]:match("[ \t]") do
-                table.insert(s, util.pop(chars))
+                table.insert(s, pop(chars))
         end
         if chars[1] ~= "\n" then
                 table.insert(s, chars[1])
                 return table.concat(s), chars
         end
         while chars[1]:match("%s") do
-                util.pop(chars)
+                pop(chars)
         end
         return chars[1], chars
 end
@@ -34,7 +35,7 @@ local function consume_string_hexvalue (chars)
         -- \x<hex scalar value>; : specified character
         local u8ch = {}
         repeat
-                local c = util.pop(chars)
+                local c = pop(chars)
                 table.insert(u8ch, c)
         until c == ";"
         table.remove(u8ch) -- remove semicolon
@@ -57,9 +58,9 @@ local function consume_string (chars)
                 ["\n"] = consume_string_whitespace,
                 x = consume_string_hexvalue,
         }
-        util.pop(chars) -- throw initial " away
+        pop(chars) -- throw initial " away
         repeat
-                local c = util.pop(chars)
+                local c = pop(chars)
                 if c == [[\]] then
                         c = chars[1]
                         if backlash[c] then
@@ -72,7 +73,7 @@ local function consume_string (chars)
                         else
                                 table.insert(str, "\\"..c)
                         end
-                        util.pop(chars)
+                        pop(chars)
                 elseif c == [["]] then
                         break
                 else
@@ -84,8 +85,8 @@ end
 
 local function consume_token (chars)
         local tok = {}
-        while chars[1]:match("[^%s()\"#'`,@;]") do
-                table.insert(tok, util.pop(chars))
+        while #chars>0 and chars[1]:match("[^%s()\"#'`,@;]") do
+                table.insert(tok, pop(chars))
         end
         return table.concat(tok), chars
 end
@@ -100,14 +101,14 @@ local function consume_number (chars)
 end
 
 local function consume_whitespace (chars)
-        while chars[1]:match("%s") do util.pop(chars) end
+        while #chars>0 and chars[1]:match("%s") do pop(chars) end
         return chars
 end
 
 local function consume_comment (chars)
         local comment = {}
         repeat
-                table.insert(comment, util.pop(chars))
+                table.insert(comment, pop(chars))
         until #chars == 0 or chars[1]:match("\n")
         return table.concat(comment), "comment", chars
 end
@@ -115,14 +116,14 @@ end
 --- API
 
 read.readtable = {
-        ["("] = function(chars) return util.pop(chars), "begin_list", chars end,
-        [")"] = function(chars) return util.pop(chars), "end_list", chars end,
+        ["("] = function(chars) return pop(chars), "open", chars end,
+        [")"] = function(chars) return pop(chars), "close", chars end,
+        ["'"] = function(chars) return pop(chars), "quote", chars end,
+        ["`"] = function(chars) return pop(chars), "quote", chars end,
+        [","] = function(chars) return pop(chars), "quote", chars end,
         ["\""] = consume_string,
         [";"] = consume_comment,
         -- ["#"] =
-        -- ["'"] =
-        -- ["`"] =
-        -- [","] =
 }
 
 function read.scan (chars)
@@ -157,18 +158,40 @@ function read.tokenize (program)
         return tokens
 end
 
+read.readmacros = {
+        open =
+                function (token, tokens)
+                        local L = {}
+                        while tokens[1].type ~= "close" do
+                                table.insert(L, read.parse(tokens))
+                        end
+                        pop(tokens) -- remove final ")"
+                        return type.List(L)
+                end,
+        close =
+                function (token, tokens)
+                        error ("Unexpected '" .. token.value .. "'")
+                end,
+        quote =
+                function (token, tokens)
+                        local Q
+                        if token.value == "'" then
+                                Q = {"quote"}
+                        elseif token.value == "`" then
+                                Q = {"quasiquote"}
+                        elseif token.value == "," then
+                                Q = {"unquote"}
+                        end
+                        table.insert(Q, read.parse(tokens))
+                        return type.List(Q)
+                end,
+}
+
 function read.parse (tokens)
         if not next(tokens) then return nil end
-        local token = util.pop(tokens)
-        if token.value == "(" then
-                local L = {}
-                while tokens[1].value ~= ")" do
-                        table.insert(L, read.parse(tokens))
-                end
-                util.pop(tokens) -- remove the final ")"
-                return type.List(L)
-        elseif token.value == ")" then
-                error("Unexpected ')'")
+        local token = pop(tokens)
+        if read.readmacros[token.type] then
+                return read.readmacros[token.type](token, tokens)
         else
                 return token.value
         end