LispInSmallPieces/chapter-lambda-1/interpreter.coffee

163 lines
4.6 KiB
CoffeeScript
Raw Normal View History

2015-05-21 20:02:39 +00:00
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
2015-06-17 19:34:31 +00:00
readline = require "readline"
2015-05-21 20:02:39 +00:00
{inspect} = require "util"
2015-06-17 19:34:31 +00:00
print = require "../chapter1/print"
2015-05-21 20:02:39 +00:00
2015-06-11 00:28:47 +00:00
env_init = nil
env_global = env_init
2015-06-17 19:34:31 +00:00
ntype = (node) -> car node
nvalu = (node) -> cadr node
2015-05-21 20:02:39 +00:00
2015-06-17 19:34:31 +00:00
definitial = (name, value = nil) ->
env_global = (cons (cons name, value), env_global)
name
2015-05-21 20:02:39 +00:00
defprimitive = (name, nativ, arity) ->
definitial name, ((args, callback) ->
2015-05-21 20:02:39 +00:00
vmargs = listToVector(args)
if (vmargs.length == arity)
callback nativ.apply null, vmargs
2015-05-21 20:02:39 +00:00
else
throw "Incorrect arity")
the_false_value = (cons "false", "boolean")
definitial "#t", true
definitial "#f", the_false_value
definitial "nil", nil
definitial "foo"
definitial "bar"
definitial "fib"
definitial "fact"
defpredicate = (name, nativ, arity) ->
defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
defprimitive "cons", cons, 2
defprimitive "car", car, 2
defprimitive "set-cdr!", setcdr, 2
defprimitive "+", ((a, b) -> a + b), 2
defprimitive "*", ((a, b) -> a * b), 2
defprimitive "-", ((a, b) -> a - b), 2
defprimitive "/", ((a, b) -> a / b), 2
defpredicate "lt", ((a, b) -> a < b), 2
defpredicate "eq?", ((a, b) -> a == b), 2
extend = (env, variables, values) ->
if (pairp variables)
if (pairp values)
(cons (cons (car variables), (car values)),
(extend env, (cdr variables), (cdr values)))
else
throw "Too few values"
else if (nilp variables)
if (nilp values) then env else throw "Too many values"
else
if (symbolp variables)
(cons (cons variables, values), env)
else
nil
make_function = (variables, body, env, callback) ->
callback (values, cb) -> eprogn body, (extend env, variables, values), cb
invoke = (fn, args, callback) ->
fn args, callback
2015-05-21 20:02:39 +00:00
# Takes a list of nodes and calls evaluate on each one, returning the
# last one as the value of the total expression. In this example, we
2015-06-17 19:34:31 +00:00
# are hard-coding what ought to be a macro, namely the threading
# macros, "->"
2015-05-21 20:02:39 +00:00
eprogn = (exps, env, callback) ->
2015-05-21 20:02:39 +00:00
if (pairp exps)
if pairp (cdr exps)
2015-06-17 19:34:31 +00:00
evaluate (car exps), env, (next) ->
eprogn (cdr exps), env, callback
2015-05-21 20:02:39 +00:00
else
evaluate (car exps), env, callback
2015-05-21 20:02:39 +00:00
else
callback nil
evlis = (exps, env, callback) ->
2015-06-17 19:34:31 +00:00
if (pairp exps)
evlis (cdr exps), env, (rest) ->
evaluate (car exps), env, (calc) ->
callback cons calc, rest
2015-05-21 20:02:39 +00:00
else
callback nil
2015-06-17 19:34:31 +00:00
lookup = (id, env) ->
2015-06-17 19:34:31 +00:00
if (pairp env)
2015-05-21 20:02:39 +00:00
if (caar env) == id
cdar env
2015-05-21 20:02:39 +00:00
else
lookup id, (cdr env)
2015-05-21 20:02:39 +00:00
else
nil
2015-05-21 20:02:39 +00:00
2015-06-17 19:34:31 +00:00
update = (id, env, value, callback) ->
if (pairp env)
2015-05-21 20:02:39 +00:00
if (caar env) == id
setcdr value, (car env)
2015-06-17 19:34:31 +00:00
callback value
2015-05-21 20:02:39 +00:00
else
2015-06-17 19:34:31 +00:00
update id, (cdr env), value, callback
2015-05-21 20:02:39 +00:00
else
callback nil
2015-05-21 20:02:39 +00:00
# This really ought to be the only place where the AST meets the
# interpreter core. I can't help but think that this design precludes
# pluggable interpreter core.
2015-06-17 19:34:31 +00:00
astSymbolsToLispSymbols = (node) ->
2015-05-21 20:02:39 +00:00
return nil if nilp node
throw "Not a list of variable names" if not (ntype(node) is 'list')
handler = (node) ->
return nil if nilp node
cons (nvalu car node), (handler cdr node)
2015-06-17 19:34:31 +00:00
handler(nvalu node)
2015-05-21 20:02:39 +00:00
2015-06-17 19:34:31 +00:00
# Takes an AST node and evaluates it and its contents. A node may be
# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
cadddr = metacadr('cadddr')
evaluate = (e, env, callback) ->
2015-06-17 19:34:31 +00:00
[type, exp] = [(ntype e), (nvalu e)]
if type == "symbol"
return callback lookup exp, env
else if type in ["number", "string", "boolean", "vector"]
return callback exp
2015-06-17 19:34:31 +00:00
else if type == "list"
head = car exp
if (ntype head) == 'symbol'
return switch (nvalu head)
when "quote"
callback cdr exp
2015-06-17 19:34:31 +00:00
when "if"
evaluate (cadr exp), env, (res) ->
w = unless res == the_false_value then caddr else cadddr
evaluate (w exp), env, callback
when "begin"
eprogn (cdr exp), env, callback
when "set!"
evaluate (caddr exp), env, (newvalue) ->
update (nvalu cadr exp), env, newvalue, callback
2015-06-17 19:34:31 +00:00
when "lambda"
make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env, callback
2015-06-17 19:34:31 +00:00
else
evaluate (car exp), env, (fn) ->
evlis (cdr exp), env, (args) ->
invoke fn, args, callback
2015-06-17 19:34:31 +00:00
else
evaluate (car exp), env, (fn) ->
evlis (cdr exp), env, (args) ->
invoke fn, args, callback
2015-06-17 19:34:31 +00:00
else
throw new Error("Can't handle a #{type}")
2015-05-21 20:02:39 +00:00
module.exports = (c, cb) -> evaluate c, env_global, cb