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:
Elf M. Sternberg 2015-05-20 15:47:51 -07:00
parent 570fb2b1df
commit 11e1ed7cf4
4 changed files with 47 additions and 14 deletions

1
.gitignore vendored
View File

@ -3,6 +3,7 @@
*~
*.orig
npm-debug.log
package.yml
node_modules/*
tmp/
test/

View File

@ -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

21
src/print.coffee Normal file
View File

@ -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

View File

@ -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)