bootstrap.lua

local function parse(str)
  local read, readchar, readcharws, peekchar, eof
  local pos = 1
  local readtable = {
    ['^"'] = function()
      local escape = {
        ['\\'] = '\\',
        ['"'] = '"'
      }
      local out = {}
      readchar()
      while peekcharws() ~= '"' do
        local char = readcharws()
        if char == '\\' then
          char = readcharws()
        end
        out[#out + 1] = char
      end
      return table.concat(out)
    end;
    ['^%('] = function()
      readchar()
      local out = {}
      while peekchar() ~= ')' do
        out[#out + 1] = read()
      end
      readchar()
      return out
    end;
    ['^[0-9]'] = function()
      local buff = {}
      while not eof() and peekcharws():match('[0-9]') do
        buff[#buff + 1] = readchar()
      end
      return tonumber(table.concat(buff))
    end
  }
  local function readsymbol()
    local buff = {}
    while not eof() and not peekcharws():match('^[ \t\n()]') do
      buff[#buff + 1] = readchar()
    end
    return { symbol = table.concat(buff) }
  end
  read = function()
    for pattern, fn in pairs(readtable) do
      if str:find(pattern, pos) then
        return fn()
      end
    end
    return readsymbol()
  end
  local function chompws()
    while not eof() and str:sub(pos, pos):match("[ \t\n]") do
      pos = pos + 1
    end
  end
  readchar = function()
    chompws()
    return readcharws()
  end
  readcharws = function()
    local char = str:sub(pos, pos)
    pos = pos + 1
    return char
  end
  peekchar = function()
    chompws()
    return peekcharws()
  end
  peekcharws = function()
    return str:sub(pos, pos)
  end
  eof = function()
    return pos > str:len()
  end
  return read(), pos
end

local function map(tbl, fn, ctx)
  local out = {}
  for k, v in ipairs(tbl) do
    out[k] = fn(v, ctx)
  end
  return out
end

local function reduce(tbl, fn, acc, ctx)
  for _, v in ipairs(tbl) do
    acc = fn(acc, v, ctx)
  end
  return acc
end

local function split(head, ...)
  return head, { ... }
end

local function wrap(fn)
  return function(eval, ctx, args)
    return fn(unpack(map(args, eval, ctx)))
  end
end

local function wrapop(fn, init)
  return wrap(function(...)
      return reduce({ ... }, fn, init)
  end)
end

local function makectx(parent, new)
  return setmetatable(new, { __index = parent })
end

function print_sexp(sexp)
  local t = type(sexp)
  if t == 'table' and sexp.symbol then
    return sexp.symbol
  elseif t == 'table' then
    return ("(%s)"):format(table.concat(map(sexp, print_sexp), ' '))
  elseif t == 'string' then
    return ('%q'):format(sexp)
  else
    return tostring(sexp)
  end
end

function eval(sexp, ctx)
  local t = type(sexp)
  if t == 'table' and sexp.symbol then
    return assert(ctx[sexp.symbol], ("%s is not bound"):format(sexp.symbol))
  elseif t == 'table' then
    local fn, args = split(unpack(sexp))
    local fv = eval(fn, ctx)
    assert(type(fv) == 'function', ("expected fv to be a function, not %s (from %s)"):format(fv, print_sexp(fn)))
    return fv(eval, ctx, args)
  else
    return sexp
  end
end

local test = {
  "()",
  "(+ 1 1)",
  '"some string"',
  "naked-atom",
  "(nested (lists))"
}

for _, v in ipairs(test) do
  print(print_sexp(parse(v)))
end

print(eval(parse("(+ 1 1)"), {
             ["+"] = wrapop(function(a, b) return a + b end, 0)
}))