lisp.lua

   1 -- atom types:
   2 --   nil
   3 --   true
   4 --   {num=3.4}
   5 --   {char='a'}
   6 --   {str='bc'}
   7 --   {sym='foo'}
   8 -- non-atom type:
   9 --   {car={num=3.4}, cdr=nil}
  10 --
  11 -- should {} mean anything special? currently just '(nil)
  12 function atom(x)
  13   return x == nil or x.num or x.char or x.str or x.sym
  14 end
  15
  16 function car(x) return x.car end
  17 function cdr(x) return x.cdr end
  18 function cons(x, y) return {car=x, cdr=y} end
  19
  20 function iso(x, y)
  21   if x == nil then return y == nil end
  22   local done={}
  23   if done[x] then return done[x] == y end
  24   done[x] = y
  25   if atom(x) then
  26     if not atom(y) then return nil end
  27     for k, v in pairs(x) do
  28       if y[k] ~= v then return nil end
  29     end
  30     return true
  31   end
  32   for k, v in pairs(x) do
  33     if not iso(y[k], v) then return nil end
  34   end
  35   for k, v in pairs(y) do
  36     if not iso(x[k], v) then return nil end
  37   end
  38   return true
  39 end
  40
  41 -- primitives; feel free to add more
  42 -- format: lisp name = lua function that implements it
  43 unary_functions = {
  44   atom=atom,
  45   car=car,
  46   cdr=cdr,
  47 }
  48
  49 binary_functions = {
  50   cons=cons,
  51   iso=iso,
  52 }
  53
  54 function lookup(env, s)
  55   if env[s] then return env[s] end
  56   if env.next then return lookup(env.next, s) end
  57 end
  58
  59 function eval(x, env)
  60   function symeq(x, s)
  61     return x and x.sym == s
  62   end
  63   if x.sym then
  64     return lookup(env, x.sym)
  65   elseif atom(x) then
  66     return x
  67   -- otherwise x is a pair
  68   elseif symeq(x.car, 'quote') then
  69     return x.cdr
  70   elseif unary_functions[x.car.sym] then
  71     return eval_unary(x, env)
  72   elseif binary_functions[x.car.sym] then
  73     return eval_binary(x, env)
  74   -- special forms that don't always eval all their args
  75   elseif symeq(x.car, 'if') then
  76     return eval_if(x, env)
  77   elseif symeq(x.car.car, 'fn') then
  78     return eval_fn(x, env)
  79   elseif symeq(x.car.car, 'label') then
  80     return eval_label(x, env)
  81   end
  82 end
  83
  84 function eval_unary(x, env)
  85   return unary_functions[x.car.sym](eval(x.cdr.car, env))
  86 end
  87
  88 function eval_binary(x, env)
  89   return binary_functions[x.car.sym](eval(x.cdr.car, env),
  90                                      eval(x.cdr.cdr.car, env))
  91 end
  92
  93 function eval_if(x, env)
  94   -- syntax: (if check b1 b2)
  95   local check = x.cdr.car
  96   local b1    = x.cdr.cdr.car
  97   local b2    = x.cdr.cdr.cdr.car
  98   if eval(check, env) then
  99     return eval(b1, env)
 100   else
 101     return eval(b2, env)
 102   end
 103 end
 104
 105 function eval_fn(x, env)
 106   -- syntax: ((fn params body*) args*)
 107   local callee = x.car
 108   local args = x.cdr
 109   local params = callee.cdr.car
 110   local body = callee.cdr.cdr
 111   return eval_exprs(body,
 112                     bind_env(params, args, env))
 113 end
 114
 115 function bind_env(params, args, env)
 116   if params == nil then return env end
 117   local result = {next=env}
 118   while true do
 119     result[params.car.sym] = eval(args.car, env)
 120     params = params.cdr
 121     args = args.cdr
 122     if params == nil then break end
 123   end
 124   return result
 125 end
 126
 127 function eval_exprs(xs, env)
 128   local result = nil
 129   while xs do
 130     result = eval(xs.car, env)
 131     xs = xs.cdr
 132   end
 133   return result
 134 end
 135
 136 function eval_label(x, env)
 137   -- syntax: ((label f (fn params body*)) args*)
 138   local callee = x.car
 139   local args = x.cdr
 140   local f = callee.cdr.car
 141   local fn = callee.cdr.cdr.car
 142   return eval({car=fn, cdr=args},
 143               bind_env({f}, {callee}, env))
 144 end
 145
 146 -- testing
 147 function num(n) return {num=n} end
 148 function char(c) return {char=c} end
 149 function str(s) return {str=s} end
 150 function sym(s) return {sym=s} end
 151 function list(...)
 152   -- gotcha: no element in arg can be nil; that short-circuits the ipairs below
 153   local result = nil
 154   local curr = nil
 155   for _, x in ipairs({...}) do
 156     if curr == nil then
 157       result = {car=x}
 158       curr = result
 159     else
 160       curr.cdr = {car=x}
 161       curr = curr.cdr
 162     end
 163   end
 164   return result
 165 end
 166
 167 function p(x)
 168   p2(x)
 169   print()
 170 end
 171
 172 function p2(x)
 173   if x == nil then
 174     io.write('nil')
 175   elseif x == true then
 176     io.write('true')
 177   elseif x.num then
 178     io.write(x.num)
 179   elseif x.char then
 180     io.write("\\"..x.char)
 181   elseif x.str then
 182     io.write('"'..x.str..'"')
 183   elseif x.sym then
 184     io.write(x.sym)
 185   elseif x.cdr == nil then
 186     io.write('(')
 187     p2(x.car)
 188     io.write(')')
 189   elseif atom(x.cdr) then
 190     io.write('(')
 191     p2(x.car)
 192     io.write(' . ')
 193     p2(x.cdr)
 194     io.write(')')
 195   else
 196     io.write('(')
 197     while true do
 198       p2(x.car)
 199       x = x.cdr
 200       if x == nil then break end
 201       if atom(x) then
 202         io.write(' . ')
 203         p2(x)
 204         break
 205       end
 206       io.write(' ')
 207     end
 208     io.write(')')
 209   end
 210 end
 211
 212 x = {num=3.4}
 213 p(x)
 214
 215 p(cons(x, nil))
 216 p(list(x))
 217
 218 p(iso(cons(x, nil), cons(x, nil)))
 219 p(iso(list(x), list(x)))
 220 p(iso(list(x, x), list(x)))
 221 p(iso(list(x, x), list(x, x)))
 222 p(iso(x, cons(x, nil)))
 223
 224 p     (list(sym("cons"), num(42), num(1)))
 225 p(eval(list(sym("cons"), num(42), num(1)), {}))
 226
 227 -- ((fn () 42)) => 42
 228 -- can't use list here because of the gotcha above
 229 assert(iso(eval(cons(cons(sym('fn'), cons(nil, cons(num(42))))), {}), num(42)))
 230 -- ((fn (a) (cons a 1)) 42) => '(42 . 1)
 231 assert(iso(eval(cons(cons(sym('fn'), cons(cons(sym('a')), cons(cons(sym('cons'), cons(sym('a'), cons(num(1))))))), cons(num(42)))), cons(num(42), num(1))))