Re-arranging for Mocha.

.gitignore

@@ -7,3 +7,8 @@ package.yml
 node_modules/*
 tmp/
 test/
+bin/_mocha
+bin/mocha
+bin/coffee
+bin/cake
+

chapter3/interpreter.coffee

@@ -1,41 +1,18 @@
 {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 "../chapter1/print"
 
-cadddr = metacadr('cadddr')
-
-{inspect} = require "util"
-
-cpsdecorate = (fn) ->
-  (args...) ->
-    callback = args[args.length - 1]
-    tocall = args[0 ... (args.length-1)]
-    callback fn.apply(@, args)
-
-ntype = (node) -> car node
-nvalu = (node) -> cadr node
-
-[listToString, listToVector, pairp, cons, car, cdr,
- caar, cddr, cdar, cadr, caadr, cadar, caddr, nilp,
- nil, setcdr, metacadr, ntype, nvalu] = [listToString, 
- listToVector, pairp, cons, car, cdr, caar, cddr, 
- cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, 
- metacadr, ntype, nvalu].map(cpsdecorate)
-
-# Debugging tool.
 
 env_init = nil
 env_global = env_init
 
-# Takes a name and a value and pushes those onto the global environment.
+ntype = (node) -> car node
+nvalu = (node) -> cadr node
 
-definitial = (name, value = nil, callback) ->
+definitial = (name, value = nil) ->
-  cons name, value, (ls) ->
+  env_global = (cons (cons name, value), env_global)
-    cons ls, env_global, callback
+  name
-
-# Takes a name, a native function, and the expected arity of that
-# function, and returns the global environment with new a (native)
-# function perpared to unpack any (interpreter) variable pairs and
-# apply the (native) function with them.
 
 defprimitive = (name, nativ, arity) ->
   definitial name, ((args) ->
@@ -55,16 +32,12 @@ definitial "bar"
 definitial "fib"
 definitial "fact"
 
-# Wraps a native predicate in function to ensure the interpreter's
-# notion of falsity is preserved.
-
 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 "log", ((a) -> console.log a), 1
 defprimitive "+", ((a, b) -> a + b), 2
 defprimitive "*", ((a, b) -> a * b), 2
 defprimitive "-", ((a, b) -> a - b), 2
@@ -72,10 +45,6 @@ defprimitive "/", ((a, b) -> a / b), 2
 defpredicate "lt", ((a, b) -> a < b), 2
 defpredicate "eq?", ((a, b) -> a == b), 2
 
-# Takes an environment, a list of names and a list of values, and for
-# each name and value pair pushes that pair onto the list, adding them
-# to the environment.
-
 extend = (env, variables, values) ->
   if (pairp variables)
     if (pairp values)
@@ -91,66 +60,51 @@ extend = (env, variables, values) ->
     else
       nil
 
-# Takes a list of variable names, a function body, and an environment
+make_function = (variables, body, env, continuation) ->
-# at the time of evaluation, and returns:
+  continuation (values, cb) -> eprogn body, (extend env, variables, values), cb
-# a (native) function that takes a list of values, applies them to the
-# environment, and evaluates the body, returning the resulting value.
 
-make_function = (variables, body, env) ->
+invoke = (fn, args, cb) ->
-  (values) -> eprogn body, (extend env, variables, values)
+  fn args, cb
-
-# Evaluates a (native) function with of one arg with the arg provided.
-# Invoke runs the functions created by make_function, and is unrelated
-# to the native functions of defprimitive()
-
-invoke = (fn, arg) -> (fn arg)
 
 # 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
-# are hard-coding what ought to be a macro, namely the threading macro
+# are hard-coding what ought to be a macro, namely the threading
-# often named "->"
+# macros, "->"
 
-eprogn = (exps, env, callback) ->
+eprogn = (exps, env, cb) ->
   if (pairp exps)
     if pairp (cdr exps)
-      evaluate (car exps), env, (c) ->
+      evaluate (car exps), env, (next) ->
-        eprogn (cdr exps), env, callback
+        eprogn (cdr exps), env, cb
     else
-      evaluate (car exps), env, callback
+      evaluate (car exps), env, cb
   else
-    nil
+    cb nil
 
-# Evaluates a list of expressions and returns a list of resolved
+evlis = (exps, env, cb) ->
-# values.
+  if (pairp exps)
-
+    evaluate (car exps), env, (stepv) ->
-evlis = (exps, env, callback) ->
+      evlis (cdr exps), env, (next) ->
-  callback if (pairp exps)
+        cb cons stepv, next
-    if (pairp cdr exps)
-      evaluate  (cons (evaluate (car exps), env), (evlis (cdr exps), env))
   else
-    nil
+    cb(nil)
     
-# Locates a named reference in the environment and returns its value.
+lookup = (id, env, continuation) ->
-            
+  if (pairp env)
-lookup = (id, env, callback) ->
-  callback if (pairp env)
     if (caar env) == id
-      cdar env
+      continuation (cdar env)
     else
-      lookup id, (cdr env)
+      lookup id, (cdr env), continuation
   else
-    nil
+    continuation nil
-
-# Locates a named reference in the environment and replaces its value
-# with a new value.
 
 update = (id, env, value, callback) ->
-  callback if (pairp env)
+  if (pairp env)
     if (caar env) == id
       setcdr value, (car env)
-      value
+      callback value
     else
-      update id, (cdr env), value
+      update id, (cdr env), value, callback
   else
     nil
 
@@ -158,70 +112,52 @@ update = (id, env, value, callback ) ->
 # interpreter core.  I can't help but think that this design precludes
 #  pluggable interpreter core.
 
-# Yeah, for the CPS edition, this is WAY cheating:
+astSymbolsToLispSymbols = (node) ->
-
-astSymbolsToLispSymbols = (node, callback) ->
   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)
-  callback handler(nvalu node)
+  handler(nvalu node)
   
 
-# Takes an AST node and evaluates it and its contents, returning the
+# Takes an AST node and evaluates it and its contents.  A node may be
-# final value of the calculation.  A node may be ("list" (... contents
+# ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
-# ...)) or ("number" 42) or ("symbol" x), etc.
 
+cadddr = metacadr('cadddr')
 
-ceq = (l, r, thencallback, elsecallback) ->
+evaluate = (e, env, continuation) ->
-  (if l is r then thencallback else elsecallback)()
+  [type, exp] = [(ntype e), (nvalu e)]
-
+  if type in ["number", "string", "boolean", "vector"]
-cin = (l, r, thencallback, elsecallback) ->
+    return continuation exp
-  (if l in r then thencallback else elsecallback)()
+  else if type == "symbol"
-
+    return lookup exp, env, continuation
-cswitch = (key, ops, callback) ->
+  else if type == "list"
-  return ops[key](callback) if key of ops
+    head = car exp
-  return ops['_default'](callback) if '_default' of ops
+    if (ntype head) == 'symbol'
-  throw new Error("Can't handle invocation of #{key}")  
+      switch (nvalu head)
-
+        when "quote" then continuation cdr exp
-cpsevaluate = (exp, env, callback) ->
+        when "if"
-  cdr exp, (envexp) ->
+          evaluate (cadr exp), env, (result) ->
-    evlis envexp, env, (newenv) ->
+            unless result == the_false_value
-      car exp, (fnhandle) ->
+              evaluate (caddr exp), env, continuation
-        evaluate fnhandle, env, callback
+            else
-
+              evaluate (cadddr exp), env, continuation
-syntax =
+        when "begin" then eprogn (cdr exp), env, continuation
-  "quote": (callback) -> cdr exp, callback
+        when "set!" then evaluate (caddr exp), env, (value) ->
-  "if": (callback) ->
+          update (nvalu cadr exp), env, value, continuation
-    cadr exp, (e) ->
+        when "lambda"
-      evaluate e, env, (c) ->
+          make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env, continuation
-        cif(c, the_false_value, 
+        else
-          (-> cadddr exp, (e) -> evaluate e, env, callback),
+          console.log(cdr exp)
-          (-> caddr exp, (e) -> evaluate e, env, callback))
+          evlis (cdr exp), env, (args) ->
-  "begin": (callback) -> cdr exp, ((e) -> eprogn e, env, callback)
+            evaluate (car exp), env, (fn) ->
-  "set!": (callback) -> cadr exp, (e) ->
+              invoke fn, args, continuation
-    nvalu e, (n) ->
+    else
-      caddr exp, (r) ->
+      evlis (cdr exp), env, (args) ->
-        evaluate r, env, (r2) ->
+        evaluate (car exp), env, (fn) ->
-          update n, env, r2, callback
+          invoke fn, args, continuation
-  "lambda": (callback) -> cddr expr, (body) ->
+  else
-    cadr exp, (astSymbols) ->
+    throw new Error("Can't handle a #{type}")
-      astSymbolsToLispSymbols astSymbols, (lispSymbols) ->
-        make_function lispSymbols, body, env, callback
-  "_default": (callback) -> cpsevaluate exp, env, callback
-
-evaluate = (e, env, callback) ->
-  ntype e, (type) ->
-    nvalu e, (exp) ->
-      ceq type, "symbol", (-> lookup exp, env, callback), ->
-        cin type, ["number", "string", "boolean", "vector"], (-> callback exp), (->
-          ceq type, "list", (->
-            car exp, (head) ->
-              ntype head, (h) -> ceq h, "symbol", -> nvalu head, (hv) ->
-                cswitch hv, syntax, callback
-              ), -> cpsevaluate exp, env, callback
-          ), ->  throw new Error("Can't handle a #{type}")
-
-module.exports = (c) -> evaluate c, env_global
 
+module.exports = (c, continuation) -> evaluate c, env_global, continuation

chapter3/test.coffee

@@ -1,14 +0,0 @@
-lisp = require './interpreter.coffee'
-{read, readForms} = require '../chapter1/reader'
-{inspect} = require 'util'
-
-ast = read("(log (begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5)))")
-
-# 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))) 1))")
-
-# ast = read("(begin (set! fact (lambda (x) (+ x x))) (fact 5))")
-# ast = read("(begin (set! fact (lambda (x) (- x 4))) (fact 5))")
-
-(lisp ast)

test/test_chapter1.coffee

@@ -1,13 +1,15 @@
 lisp = require './lisp_ch1'
 {read, readForms} = require './reader'
 {inspect} = require 'util'
-ast = read("(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5))")
 
-# ast = read("(begin (if (lt 4 2) (+ 4 1)  (+ 2 1)))")
+# ast = read("(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5))")
+
+# ast = read("(begin (if (lt 4 5) (+ 4 1)  (+ 2 1)))")
 # ast = read("(begin (set! fact 4) fact)")
 # 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))")
+ast = read("(begin (set! fact (lambda (x) (- x 4))) (fact 5))")
+# ast = read("(begin ((lambda () (+ 5 5))))")
 
 console.log "Result:",  (lisp ast)

test/test_chapter3.coffee

@@ -0,0 +1,15 @@
+lisp = require './interpreter'
+{read, readForms} = require '../chapter1/reader'
+{inspect} = require 'util'
+
+ast = read("(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5))")
+
+# ast = read("(begin (if (lt 4 5) (+ 4 1)  (+ 2 1)))")
+# ast = read("(begin (set! fact 4) fact)")
+# 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))")
+# ast = read("(begin ((lambda () (+ 5 5))))")
+
+lisp(ast,  (r) -> console.log("Result:", r))