It works recursively. This will restore your faith in humanity!
I spent far too much time debugging an issue with metacadr (see the cons-list commits for details), but this now successfully recurses and all of its code paths are exercised by the factorial/fibonacci exercises. This is a Coffeescript implementation of the language described at the end of chapter 1 of Lisp In Small Pieces. Also, added a syntax-aware pretty printer. It's very primitive, but it's good enough for some debugging.
This commit is contained in:
parent
570fb2b1df
commit
11e1ed7cf4
|
@ -3,6 +3,7 @@
|
|||
*~
|
||||
*.orig
|
||||
npm-debug.log
|
||||
package.yml
|
||||
node_modules/*
|
||||
tmp/
|
||||
test/
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
|
||||
readline = require "readline"
|
||||
{inspect} = require "util"
|
||||
print = require "./print"
|
||||
|
||||
|
||||
env_init = nil
|
||||
env_global = env_init
|
||||
|
@ -55,12 +57,14 @@ extend = (env, variables, values) ->
|
|||
else
|
||||
if (symbolp variables)
|
||||
(cons (cons variables, values), env)
|
||||
else
|
||||
nil
|
||||
|
||||
make_function = (variables, body, env) ->
|
||||
(values) -> eprogn body, (extend env, variables, values)
|
||||
|
||||
invoke = (fn, args) ->
|
||||
fn(args)
|
||||
(fn args)
|
||||
|
||||
# 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
|
||||
|
@ -71,9 +75,11 @@ eprogn = (exps, env) ->
|
|||
if (pairp exps)
|
||||
if pairp (cdr exps)
|
||||
evaluate (car exps), env
|
||||
return eprogn (cdr exps), env
|
||||
return evaluate (car exps), env
|
||||
nil
|
||||
eprogn (cdr exps), env
|
||||
else
|
||||
evaluate (car exps), env
|
||||
else
|
||||
nil
|
||||
|
||||
evlis = (exps, env) ->
|
||||
if (pairp exps)
|
||||
|
@ -104,8 +110,6 @@ update = (id, env, value) ->
|
|||
# interpreter core. I can't help but think that this design precludes
|
||||
# pluggable interpreter core.
|
||||
|
||||
cadddr = metacadr("cadddr")
|
||||
|
||||
astSymbolsToLispSymbols = (node) ->
|
||||
return nil if nilp node
|
||||
throw "Not a list of variable names" if not (ntype(node) is 'list')
|
||||
|
@ -118,16 +122,18 @@ astSymbolsToLispSymbols = (node) ->
|
|||
# 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) ->
|
||||
[type, exp] = [(ntype e), (nvalu e)]
|
||||
if type == "symbol"
|
||||
return lookup exp, env
|
||||
if type in ["number", "string", "boolean", "vector"]
|
||||
else if type in ["number", "string", "boolean", "vector"]
|
||||
return exp
|
||||
if type == "list"
|
||||
else if type == "list"
|
||||
head = car exp
|
||||
if (ntype head) == 'symbol'
|
||||
return switch (nvalu head)
|
||||
switch (nvalu head)
|
||||
when "quote" then cdr exp
|
||||
when "if"
|
||||
unless (evaluate (cadr exp), env) == the_false_value
|
||||
|
@ -137,9 +143,10 @@ evaluate = (e, env) ->
|
|||
when "begin" then eprogn (cdr exp), env
|
||||
when "set!" then update (nvalu cadr exp), env, (evaluate (caddr exp), env)
|
||||
when "lambda" then make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env
|
||||
else
|
||||
invoke (evaluate (car exp), env), (evlis (cdr exp), env)
|
||||
return invoke (evaluate (car exp), env), (evlis (cdr exp), env)
|
||||
throw new Error("Can't handle a #{type}")
|
||||
else invoke (evaluate (car exp), env), (evlis (cdr exp), env)
|
||||
else
|
||||
invoke (evaluate (car exp), env), (evlis (cdr exp), env)
|
||||
else
|
||||
throw new Error("Can't handle a #{type}")
|
||||
|
||||
module.exports = (c) -> evaluate c, env_global
|
||||
|
|
|
@ -0,0 +1,21 @@
|
|||
{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
|
||||
|
||||
ntype = (node) -> car node
|
||||
nvalu = (node) -> cadr node
|
||||
|
||||
evlis = (exps, d) ->
|
||||
if (pairp exps) then evaluate((car exps), d) + " " + evlis((cdr exps), d) else ""
|
||||
|
||||
indent = (d) ->
|
||||
([0..d].map () -> " ").join('')
|
||||
|
||||
evaluate = (e, d = 0) ->
|
||||
[type, exp] = [(ntype e), (nvalu e)]
|
||||
if type == "symbol" then exp
|
||||
else if type in ["number", "boolean"] then exp
|
||||
else if type == "string" then '"' + exp + '"'
|
||||
else if type == "list" then "\n" + indent(d) + "(" + evlis(exp, d + 2) + ")"
|
||||
else throw "Don't recognize a #{type}"
|
||||
|
||||
module.exports = (c) -> evaluate c, 0
|
||||
|
|
@ -5,5 +5,9 @@ ast = read("(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))
|
|||
|
||||
# ast = read("(begin (if (lt 4 2) (+ 4 1) (+ 2 1)))")
|
||||
# ast = read("(begin (set! fact 4) fact)")
|
||||
ast = read("(begin ((lambda (t) (if (lt t 2) (+ 4 1) (+ 2 1))) 4))")
|
||||
# ast = read("(begin ((lambda (t) (if (lt t 2) (+ 4 1) (+ 2 1))) 1))")
|
||||
|
||||
# ast = read("(begin (set! fact (lambda (x) (+ x x))) (fact 5))")
|
||||
# ast = read("(begin (set! fact (lambda (x) (- x 4))) (fact 5))")
|
||||
|
||||
console.log "Result:", (lisp ast)
|
||||
|
|
Loading…
Reference in New Issue