[refactor] A new representation for symbols to handle quoted code

This is a big refactoring; the parser is now modal, to handle either
complex Node objects that carry around a lot of state with them, or
simpler objects that represent the McCarthy-style IST.  I'm still
feeling my way through the subject material.  The node construction
is such pure artifice I feel silly keeping it, and may end up revising
it (again).

The nice thing is, everything goes through evaluate.  Almost no other
code needs to know anything at all about the shape of the Nodes themselves;
it all makes assumptions based on the return value (or continuation passed)
by evaluate.

chapter-lambda-1/interpreter.coffee

@@ -2,6 +2,7 @@
  cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
 readline = require "readline"
 {inspect} = require "util"
+{Symbol} = require '../chapter1/reader_types'
 
 class LispInterpreterError extends Error
   name: 'LispInterpreterError'
@@ -10,9 +11,6 @@ class LispInterpreterError extends Error
 env_init = nil
 env_global = env_init
 
-ntype = (node) -> car node
-nvalu = (node) -> cadr node
-
 definitial = (name, value = nil) ->
   env_global = (cons (cons name, value), env_global)
   name
@@ -25,6 +23,9 @@ defprimitive = (name, nativ, arity) ->
     else
       throw new LispInterpreterError "Incorrect arity")
 
+defpredicate = (name, nativ, arity) ->
+  defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
+
 the_false_value = (cons "false", "boolean")
 
 definitial "#t", true
@@ -35,9 +36,6 @@ 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
@@ -48,6 +46,9 @@ defprimitive "/", ((a, b) -> a / b), 2
 defpredicate "lt", ((a, b) -> a < b), 2
 defpredicate "eq?", ((a, b) -> a == b), 2
 
+# MISTAKE: Variables are always of type Symbol.  This is probably a
+# mistake.
+
 extend = (env, variables, values) ->
   if (pairp variables)
     if (pairp values)
@@ -58,8 +59,8 @@ extend = (env, variables, values) ->
   else if (nilp variables)
     if (nilp values) then env else throw new LispInterpreterError "Too many values"
   else
-    if (symbolp variables)
+    if (variables instanceof Symbol)
-      (cons (cons variables, values), env)
+      (cons (cons variables.v, values), env)
     else
       nil
 
@@ -115,52 +116,82 @@ update = (id, env, value, callback) ->
 # interpreter core.  I can't help but think that this design precludes
 #  pluggable interpreter core.
 
+# TODO: Reengineer this with a call to normalize
+
 astSymbolsToLispSymbols = (node) ->
+  nvalu = (node) -> cadr node
   return nil if nilp node
-  throw (new LispInterpreterError "Not a list of variable names") if not (ntype(node) is 'list')
+  throw (new LispInterpreterError "Not a list of variable names") if not ((car node) is 'list')
   handler = (node) ->
     return nil if nilp node
-    cons (nvalu car node), (handler cdr node)
+    cons (nvalu car node).v, (handler cdr node)
   handler(nvalu 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, callback) ->
+metadata_evaluation =
-  [type, exp] = [(ntype e), (nvalu e)]
+  listp:     (node) -> (car node) == 'list'
-  if type == "symbol"
+  symbolp:   (node) -> (car node) == 'symbol'
-    return callback lookup exp, env
+  numberp:   (node) -> (car node) == 'number'
-  else if type in ["number", "string", "boolean", "vector"]
+  stringp:   (node) -> (car node) == 'string'
-    return callback exp
+  nvalu:     (node) -> cadr node
-  else if type == "list"
+  mksymbols: astSymbolsToLispSymbols
-    head = car exp
+
-    if (ntype head) == 'symbol'
+straight_evaluation = 
-      return switch (nvalu head)
+  listp:     (node) -> node.__type == 'list'
-        when "quote"
+  symbolp:   (node) -> node instanceof Symbol
-          callback cdr exp
+  commentp:  (node) -> node instanceof Comment
-        when "if"
+  numberp:   (node) -> typeof node == 'number'
-          evaluate (cadr exp), env, (res) ->
+  stringp:   (node) -> typeof node == 'string'
-            w = unless res == the_false_value then caddr else cadddr
+  boolp:     (node) -> typeof node == 'boolean'
-            evaluate (w exp), env, callback
+  nullp:     (node) -> node == null
-        when "begin"
+  vectorp:   (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]'
-          eprogn (cdr exp), env, callback
+  recordp:   (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]'
-        when "set!"
+  objectp:   (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
-          evaluate (caddr exp), env, (newvalue) ->
+  nilp:      (node) -> nilp(node)
-            update (nvalu cadr exp), env, newvalue, callback
+  nvalu:     (node) -> node
-        when "lambda"
+  mksymbols: (node) -> node
-          make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env, callback
+
-        else
+makeEvaluator = (ix = straight_evaluation, ty="straight") ->
-          evaluate (car exp), env, (fn) ->
+  (exp, env, callback) ->
-            evlis (cdr exp), env, (args) ->
+    if ix.symbolp exp
-              invoke fn, args, callback
+      return callback lookup (ix.nvalu exp).v, env
+    else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
+      return callback ix.nvalu exp
+    else if ix.listp exp
+      body = ix.nvalu exp
+      head = car body
+      if ix.symbolp head
+        return switch (ix.nvalu head).v
+          when "quote" then callback cdr body
+          when "if"
+            evaluate (cadr body), env, (res) ->
+              w = unless res == the_false_value then caddr else cadddr
+              evaluate (w body), env, callback
+          when "begin" then eprogn (cdr body), env, callback
+          when "set!"
+            evaluate (caddr body), env, (newvalue) ->
+              update (ix.nvalu cadr body).v, env, newvalue, callback
+          when "lambda"
+            make_function (ix.mksymbols cadr body), (cddr body), env, callback
+          else
+            evaluate (car body), env, (fn) ->
+              evlis (cdr body), env, (args) ->
+                invoke fn, args, callback
+      else
+        evaluate (car body), env, (fn) ->
+          evlis (cdr body), env, (args) ->
+            invoke fn, args, callback
     else
-      evaluate (car exp), env, (fn) ->
+      throw new LispInterpreterError ("Can't handle a #{type}")
-        evlis (cdr exp), env, (args) ->
+
-          invoke fn, args, callback
+nodeEval = makeEvaluator(metadata_evaluation, "node")
-  else
+lispEval = makeEvaluator(straight_evaluation, "lisp")
-    throw new LispInterpreterError ("Can't handle a #{type}")
+
+evaluate = (exp, env, cb) ->
+  (if exp? and exp.__node then nodeEval else lispEval)(exp, env, cb)
   
 module.exports = (c, cb) -> evaluate c, env_global, cb

chapter1/interpreter.coffee

@@ -26,6 +26,8 @@ defprimitive = (name, nativ, arity) ->
 defpredicate = (name, nativ, arity) ->
   defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
 
+the_false_value = (cons "false", "boolean")
+
 definitial "#t", true
 definitial "#f", the_false_value
 definitial "nil", nil
@@ -44,8 +46,6 @@ defprimitive "/", ((a, b) -> a / b), 2
 defpredicate "lt", ((a, b) -> a < b), 2
 defpredicate "eq?", ((a, b) -> a == b), 2
 
-the_false_value = (cons "false", "boolean")
-
 extend = (env, variables, values) ->
   if (pairp variables)
     if (pairp values)
@@ -56,8 +56,8 @@ extend = (env, variables, values) ->
   else if (nilp variables)
     if (nilp values) then env else throw new LispInterpreterError "Too many values"
   else
-    if (symbolp variables)
+    if (variables instanceof Symbol)
-      (cons (cons variables, values), env)
+      (cons (cons variables.v, values), env)
     else
       nil
 
@@ -107,13 +107,15 @@ update = (id, env, value) ->
   else
     nil
 
+# TODO: Reengineer this with a call to normalize
+
 astSymbolsToLispSymbols = (node) ->
   nvalu = (node) -> cadr node
   return nil if nilp node
-  throw (new LispInterpreterError "Not a list of variable names") if not (ntype(node) is 'list')
+  throw (new LispInterpreterError "Not a list of variable names") if not ((car node) is 'list')
   handler = (node) ->
     return nil if nilp node
-    cons (nvalu car node), (handler cdr node)
+    cons (nvalu car node).v, (handler cdr node)
   handler(nvalu node)
 
 
@@ -125,52 +127,54 @@ cadddr = metacadr('cadddr')
 # favor of normalizeForm (s?) and Symbol extraction
 
 metadata_evaluation =
-  listp:   (node) -> (car node) == 'list'
+  listp:     (node) -> (car node) == 'list'
-  symbolp: (node) -> (car node) == 'symbol'
+  symbolp:   (node) -> (car node) == 'symbol'
-  numberp: (node) -> (car node) == 'number'
+  numberp:   (node) -> (car node) == 'number'
-  stringp: (node) -> (car node) == 'string'
+  stringp:   (node) -> (car node) == 'string'
-  nvalu:   (node) -> cadr node
+  nvalu:     (node) -> cadr node
+  mksymbols: (node) -> astSymbolsToLispSymbols(node)
 
 straight_evaluation = 
-  listp:    (node) -> node.__type == 'list'
+  listp:     (node) -> node.__type == 'list'
-  symbolp:  (node) -> node instanceof Symbol
+  symbolp:   (node) -> node instanceof Symbol
-  commentp: (node) -> node instanceof Comment
+  commentp:  (node) -> node instanceof Comment
-  numberp:  (node) -> typeof node == 'number'
+  numberp:   (node) -> typeof node == 'number'
-  stringp:  (node) -> typeof node == 'string'
+  stringp:   (node) -> typeof node == 'string'
-  boolp:    (node) -> typeof node == 'boolean'
+  boolp:     (node) -> typeof node == 'boolean'
-  nullp:    (node) -> node == null
+  nullp:     (node) -> node == null
-  vectorp:  (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]'
+  vectorp:   (node) -> (not straight_evaluation.listp node) and toString.call(node) == '[object Array]'
-  recordp:  (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]'
+  recordp:   (node) -> (not node._prototype?) and toSTring.call(node) == '[object Object]'
-  objectp:  (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
+  objectp:   (node) -> (node._prototype?) and toString.call(node) == '[object Object]'
-  nilp:     (node) -> nilp(node)
+  nilp:      (node) -> nilp(node)
-  nvalu:    (node) -> node
+  nvalu:     (node) -> node
+  mksymbols: (node) -> node
 
 makeEvaluator = (ix = straight_evaluation, ty="straight") ->
   (exp, env) ->
-    console.log("Type:", ty)
     # Takes an AST node and evaluates it and its contents.  A node may be
     # ("list" (... contents ...)) or ("number" 42) or ("symbol" x), etc.
   
     if ix.symbolp(exp)
       return lookup (ix.nvalu exp).v, env
     else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
-      return exp
+      return ix.nvalu exp
     else if ix.listp(exp)
-      head = car ix.nvalu exp
+      body = ix.nvalu exp
+      head = car body
       if ix.symbolp(head)
         switch (ix.nvalu head).v
-          when "quote" then cdr exp
+          when "quote" then cdr body
           when "if"
-            unless (evaluate (cadr exp), env) == the_false_value
+            unless (evaluate (cadr body), env) == the_false_value
-              evaluate (caddr exp), env
+              evaluate (caddr body), env
             else
-              evaluate (cadddr exp), env
+              evaluate (cadddr body), env
-          when "begin" then eprogn (cdr exp), env
+          when "begin" then eprogn (cdr body), env
-          when "set!" then update (ix.nvalu cadr exp).v, env, (evaluate (caddr exp), env)
+          when "set!" then update (ix.nvalu cadr body).v, env, (evaluate (caddr body), env)
-          when "lambda" then make_function (astSymbolsToLispSymbols cadr exp), (cddr exp), env
+          when "lambda" then make_function (ix.mksymbols cadr body), (cddr body), env
-          else invoke (evaluate (car exp), env), (evlis (cdr exp), env)
+          else invoke (evaluate (car body), env), (evlis (cdr body), env)
       else
-        invoke (evaluate (car exp), env), (evlis (cdr exp), env)
+        invoke (evaluate (car body), env), (evlis (cdr body), env)
     else
       throw new LispInterpreterError "Can't handle a #{type}"