Fork of Lua 5.1 to encourage end-user programming
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

#### 231 lines 5.0 KiB Raw Permalink Blame History

 `-- atom types:` `-- nil` `-- true` `-- {num=3.4}` `-- {char='a'}` `-- {str='bc'}` `-- {sym='foo'}` `-- non-atom type:` `-- {car={num=3.4}, cdr=nil}` `--` `-- should {} mean anything special? currently just '(nil)` `function atom(x)` ` return x == nil or x.num or x.char or x.str or x.sym` `end` `function car(x) return x.car end` `function cdr(x) return x.cdr end` `function cons(x, y) return {car=x, cdr=y} end` `function iso(x, y)` ` if x == nil then return y == nil end` ` local done={}` ` if done[x] then return done[x] == y end` ` done[x] = y` ` if atom(x) then` ` if not atom(y) then return nil end` ` for k, v in pairs(x) do` ` if y[k] ~= v then return nil end` ` end` ` return true` ` end` ` for k, v in pairs(x) do` ` if not iso(y[k], v) then return nil end` ` end` ` for k, v in pairs(y) do` ` if not iso(x[k], v) then return nil end` ` end` ` return true` `end` `-- primitives; feel free to add more` `-- format: lisp name = lua function that implements it` `unary_functions = {` ` atom=atom,` ` car=car,` ` cdr=cdr,` `}` `binary_functions = {` ` cons=cons,` ` iso=iso,` `}` `function lookup(env, s)` ` if env[s] then return env[s] end` ` if env.next then return lookup(env.next, s) end` `end` `function eval(x, env)` ` function symeq(x, s)` ` return x and x.sym == s` ` end` ` if x.sym then` ` return lookup(env, x.sym)` ` elseif atom(x) then` ` return x` ` -- otherwise x is a pair` ` elseif symeq(x.car, 'quote') then` ` return x.cdr` ` elseif unary_functions[x.car.sym] then` ` return eval_unary(x, env)` ` elseif binary_functions[x.car.sym] then` ` return eval_binary(x, env)` ` -- special forms that don't always eval all their args` ` elseif symeq(x.car, 'if') then` ` return eval_if(x, env)` ` elseif symeq(x.car.car, 'fn') then` ` return eval_fn(x, env)` ` elseif symeq(x.car.car, 'label') then` ` return eval_label(x, env)` ` end` `end` `function eval_unary(x, env)` ` return unary_functions[x.car.sym](eval(x.cdr.car, env))` `end` `function eval_binary(x, env)` ` return binary_functions[x.car.sym](eval(x.cdr.car, env),` ` eval(x.cdr.cdr.car, env))` `end` `function eval_if(x, env)` ` -- syntax: (if check b1 b2)` ` local check = x.cdr.car` ` local b1 = x.cdr.cdr.car` ` local b2 = x.cdr.cdr.cdr.car` ` if eval(check, env) then` ` return eval(b1, env)` ` else` ` return eval(b2, env)` ` end` `end` `function eval_fn(x, env)` ` -- syntax: ((fn params body*) args*)` ` local callee = x.car` ` local args = x.cdr` ` local params = callee.cdr.car` ` local body = callee.cdr.cdr` ` return eval_exprs(body,` ` bind_env(params, args, env))` `end` `function bind_env(params, args, env)` ` if params == nil then return env end` ` local result = {next=env}` ` while true do` ` result[params.car.sym] = eval(args.car, env)` ` params = params.cdr` ` args = args.cdr` ` if params == nil then break end` ` end` ` return result` `end` `function eval_exprs(xs, env)` ` local result = nil` ` while xs do` ` result = eval(xs.car, env)` ` xs = xs.cdr` ` end` ` return result` `end` `function eval_label(x, env)` ` -- syntax: ((label f (fn params body*)) args*)` ` local callee = x.car` ` local args = x.cdr` ` local f = callee.cdr.car` ` local fn = callee.cdr.cdr.car` ` return eval({car=fn, cdr=args},` ` bind_env({f}, {callee}, env))` `end` `-- testing` `function num(n) return {num=n} end` `function char(c) return {char=c} end` `function str(s) return {str=s} end` `function sym(s) return {sym=s} end` `function list(...)` ` -- gotcha: no element in arg can be nil; that short-circuits the ipairs below` ` local result = nil` ` local curr = nil` ` for _, x in ipairs({...}) do` ` if curr == nil then` ` result = {car=x}` ` curr = result` ` else` ` curr.cdr = {car=x}` ` curr = curr.cdr` ` end` ` end` ` return result` `end` `function p(x)` ` p2(x)` ` print()` `end` `function p2(x)` ` if x == nil then` ` io.write('nil')` ` elseif x == true then` ` io.write('true')` ` elseif x.num then` ` io.write(x.num)` ` elseif x.char then` ` io.write("\\"..x.char)` ` elseif x.str then` ` io.write('"'..x.str..'"')` ` elseif x.sym then` ` io.write(x.sym)` ` elseif x.cdr == nil then` ` io.write('(')` ` p2(x.car)` ` io.write(')')` ` elseif atom(x.cdr) then` ` io.write('(')` ` p2(x.car)` ` io.write(' . ')` ` p2(x.cdr)` ` io.write(')')` ` else` ` io.write('(')` ` while true do` ` p2(x.car)` ` x = x.cdr` ` if x == nil then break end` ` if atom(x) then` ` io.write(' . ')` ` p2(x)` ` break` ` end` ` io.write(' ')` ` end` ` io.write(')')` ` end` `end` `x = {num=3.4}` `p(x)` `p(cons(x, nil))` `p(list(x))` `p(iso(cons(x, nil), cons(x, nil)))` `p(iso(list(x), list(x)))` `p(iso(list(x, x), list(x)))` `p(iso(list(x, x), list(x, x)))` `p(iso(x, cons(x, nil)))` `p (list(sym("cons"), num(42), num(1)))` `p(eval(list(sym("cons"), num(42), num(1)), {}))` `-- ((fn () 42)) => 42` `-- can't use list here because of the gotcha above` `assert(iso(eval(cons(cons(sym('fn'), cons(nil, cons(num(42))))), {}), num(42)))` `-- ((fn (a) (cons a 1)) 42) => '(42 . 1)` ```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)))) ``` ``` ```