[refactor] Custom reader types have unique Javascript equivalents now.

chapter1/astToList.coffee

@@ -1,6 +1,7 @@
 {car, cdr, cons, listp, nilp, nil,
  list, pairp, listToString} = require 'cons-lists/lists'
 {aSymbol, aValue, astObject} = require './astAccessors'
+{Symbol} = require './reader_types'
 
 # RICH_AST -> LISP_AST
 
@@ -25,7 +26,7 @@ normalizeForm = (form) ->
     'record': (atom) -> listToRecord1(atom)
 
     # Basic native types.  Meh.
-    'symbol': id
+    'symbol': (a) -> a.v
     'number': id
     'string': (atom) -> atom
     'nil': (atom) -> nil

chapter1/interpreter.coffee

@@ -7,11 +7,13 @@ class LispInterpreterError extends Error
   name: 'LispInterpreterError'
   constructor: (@message) ->
 
+
 env_init = nil
 env_global = env_init
 
-ntype = (node) -> car node
+defpredicate = (name, nativ, arity) ->
-nvalu = (node) -> cadr node
+  defprimitive name, ((a, b) -> if nativ.call(null, a, b) then true else the_false_value), arity
+
 
 definitial = (name, value = nil) ->
   env_global = (cons (cons name, value), env_global)
@@ -25,8 +27,6 @@ defprimitive = (name, nativ, arity) ->
     else
       throw (new LispInterpreterError "Incorrect arity"))
 
-the_false_value = (cons "false", "boolean")
-
 definitial "#t", true
 definitial "#f", the_false_value
 definitial "nil", nil
@@ -35,9 +35,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,108 +45,131 @@ defprimitive "/", ((a, b) -> a / b), 2
 defpredicate "lt", ((a, b) -> a < b), 2
 defpredicate "eq?", ((a, b) -> a == b), 2
 
-extend = (env, variables, values) ->
+the_false_value = (cons "false", "boolean")
-  if (pairp variables)
-    if (pairp values)
-      (cons (cons (car variables), (car values)),
-        (extend env, (cdr variables), (cdr values)))
-    else
-      throw new LispInterpreterError "Too few values"
-  else if (nilp variables)
-    if (nilp values) then env else throw new LispInterpreterError "Too many 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)
-
-# 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
-# macros, "->"
-
-eprogn = (exps, env) ->
-  if (pairp exps)
-    if pairp (cdr exps)
-      evaluate (car exps), env
-      eprogn (cdr exps), env
-    else
-      evaluate (car exps), env
-  else
-    nil
-
-evlis = (exps, env) ->
-  if (pairp exps)
-    (cons (evaluate (car exps), env), (evlis (cdr exps), env))
-  else
-    nil
-    
-lookup = (id, env) ->
-  if (pairp env)
-    if (caar env) == id
-      cdar env
-    else
-      lookup id, (cdr env)
-  else
-    nil
-
-update = (id, env, value) ->
-  if (pairp env)
-    if (caar env) == id
-      setcdr value, (car env)
-      value
-    else
-      update id, (cdr env), value
-  else
-    nil
-
-# 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.
-
-astSymbolsToLispSymbols = (node) ->
-  return nil if nilp node
-  throw (new LispInterpreterError "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)
-  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) ->
+metadata_evaluation =
-  [type, exp] = [(ntype e), (nvalu e)]
+  listp:   (node) -> (car node) == 'list'
-  if type == "symbol"
+  symbolp: (node) -> (car node) == 'symbol'
-    return lookup exp, env
+  numberp: (node) -> (car node) == 'number'
-  else if type in ["number", "string", "boolean", "vector"]
+  stringp: (node) -> (car node) == 'string'
-    return exp
+  nvalu:   (node) -> cadr node
-  else if type == "list"
-    head = car exp
-    if (ntype head) == 'symbol'
-      switch (nvalu head)
-        when "quote" then cdr exp
-        when "if"
-          unless (evaluate (cadr exp), env) == the_false_value
-            evaluate (caddr exp), env
-          else
-            evaluate (cadddr exp), 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)
-    else
-      invoke (evaluate (car exp), env), (evlis (cdr exp), env)
-  else
-    throw new LispInterpreterError "Can't handle a #{type}"
 
+straight_evaluation = 
+  listp:    (node) -> node.__type == 'list'
+  symbolp:  (node) -> node instanceOf Symbol
+  commentp: (node) -> node instanceOf Comment
+  numberp:  (node) -> typeof node == 'number'
+  stringp:  (node) -> typeof node == 'string'
+  boolp:    (node) -> typeof node == 'boolean'
+  nullp:    (node) -> node == null
+  vectorp:  (node) -> (not listp node) and toString.call(node) == '[object Array]'
+  recordp:  (node) -> (not x._prototype?) and toSTring.call(node) == '[object Object]')
+  objectp:  (node) -> (x._prototype?) and toString.call(node) == '[object Object]')
+  nilp:     (node) -> node == nilp
+  nvalu:    (node) -> node
+
+makeEvaluator = (ix = straight_evaluation) ->
+  (exp, env) ->
+    extend = (env, variables, values) ->
+      if (pairp variables)
+        if (pairp values)
+          (cons (cons (car variables), (car values)),
+            (extend env, (cdr variables), (cdr values)))
+        else
+          throw new LispInterpreterError "Too few values"
+      else if (nilp variables)
+        if (nilp values) then env else throw new LispInterpreterError "Too many 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)
+    
+    # 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
+    # macros, "->"
+    
+    eprogn = (exps, env) ->
+      if (pairp exps)
+        if pairp (cdr exps)
+          evaluate (car exps), env
+          eprogn (cdr exps), env
+        else
+          evaluate (car exps), env
+      else
+        nil
+    
+    evlis = (exps, env) ->
+      if (pairp exps)
+        (cons (evaluate (car exps), env), (evlis (cdr exps), env))
+      else
+        nil
+        
+    lookup = (id, env) ->
+      if (pairp env)
+        if (caar env) == id
+          cdar env
+        else
+          lookup id, (cdr env)
+      else
+        nil
+    
+    update = (id, env, value) ->
+      if (pairp env)
+        if (caar env) == id
+          setcdr value, (car env)
+          value
+        else
+          update id, (cdr env), value
+      else
+        nil
+    
+    # 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.
+    
+    astSymbolsToLispSymbols = (node) ->
+      return nil if nilp node
+      throw (new LispInterpreterError "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)
+      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.
+  
+    [type, exp] = [(ntype e), (nvalu e)]
+    if type == "symbol"
+      return lookup exp, env
+    else if type in ["number", "string", "boolean", "vector"]
+      return exp
+    else if type == "list"
+      head = car exp
+      if (ntype head) == 'symbol'
+        switch (nvalu head)
+          when "quote" then cdr exp
+          when "if"
+            unless (evaluate (cadr exp), env) == the_false_value
+              evaluate (caddr exp), env
+            else
+              evaluate (cadddr exp), 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)
+      else
+        invoke (evaluate (car exp), env), (evlis (cdr exp), env)
+    else
+      throw new LispInterpreterError "Can't handle a #{type}"
+  
 module.exports = (c) -> evaluate c, env_global

chapter1/reader.coffee

@@ -1,5 +1,6 @@
 {car, cdr, cons, nil, nilp, pairp, vectorToList, list} = require 'cons-lists/lists'
 {inspect} = require "util"
+{Symbol, Comment} = require "./reader_types"
 
 
 NEWLINES   = ["\n", "\r", "\x0B", "\x0C"]
@@ -28,17 +29,19 @@ class Source
 
   done: -> @index > @max
 
+mkNode = (obj) -> Object.defineProperty obj, '__node', {value: true}
+
 # IO -> IO
 skipWS = (inStream) ->
   while inStream.peek() in WHITESPACE then inStream.next()
 
 # (type, value, line, column) -> (node {type, value, line, column)}
-makeObj = (type, value, line, column) ->
+mkObj = (type, value, line, column) ->
-  list(type, value, line, column)
+  mkNode list type, value, line, column
 
 # msg -> (IO -> Node => Error)
 handleError = (message) ->
-  (line, column) -> makeObj('error', message, line, column)
+  (line, column) -> mkObj('error', message, line, column)
 
 # IO -> Node => Comment
 readComment = (inStream) ->
@@ -47,7 +50,7 @@ readComment = (inStream) ->
     inStream.next()).join("")
   if not inStream.done()
     inStream.next()
-  makeObj 'comment', r, line, column
+  mkObj 'comment', (new Comment r), line, column
 
 # IO -> (Node => Literal => String) | Error
 readString = (inStream) ->
@@ -60,7 +63,7 @@ readString = (inStream) ->
   if inStream.done()
     return handleError("end of file seen before end of string.")(line, column)
   inStream.next()
-  makeObj 'string', (string.join ''), line, column
+  mkObj 'string', (string.join ''), line, column
 
 # (String) -> (Node => Literal => Number) | Nothing
 readMaybeNumber = (symbol) ->
@@ -86,8 +89,8 @@ readSymbol = (inStream, tableKeys) ->
     inStream.next()).join ''
   number = readMaybeNumber symbol
   if number?
-    return makeObj 'number', number, line, column
+    return mkObj 'number', number, line, column
-  makeObj 'symbol', symbol, line, column
+  mkObj 'symbol', (new Symbol symbol), line, column
 
 
 # (Delim, TypeName) -> IO -> (IO, node) | Error
@@ -99,7 +102,7 @@ makeReadPair = (delim, type) ->
     [line, column] = inStream.position()
     if inStream.peek() == delim
       inStream.next()
-      return makeObj(type, nil, line, column)
+      return mkObj(type, nil, line, column)
 
     # IO -> (IO, Node) | Error
     dotted = false
@@ -112,12 +115,12 @@ makeReadPair = (delim, type) ->
       if inStream.done() then return handleError("Unexpected end of input")(line, column)
       if dotted then return handleError("More than one symbol after dot")
       return obj if (car obj) == 'error'
-      if (car obj) == 'symbol' and (car cdr obj) == '.'
+      if (car obj) == 'symbol' and (car cdr obj).v == '.'
         dotted = true
         return readEachPair inStream
       cons obj, readEachPair inStream
 
-    ret = makeObj type, readEachPair(inStream), line, column
+    ret = mkObj type, readEachPair(inStream), line, column
     inStream.next()
     ret
 
@@ -130,7 +133,7 @@ prefixReader = (type) ->
     [line1, column1] = inStream.position()
     obj = read inStream, true, null, true
     return obj if (car obj) == 'error'
-    makeObj "list", cons((makeObj("symbol", type, line1, column1)), cons(obj)), line, column
+    mkObj "list", cons((mkObj("symbol", type, line1, column1)), cons(obj)), line, column
 
 # I really wanted to make anything more complex than a list (like an
 # object or a vector) something handled by a read macro.  Maybe in a
@@ -200,7 +203,7 @@ readForms = (inStream) ->
     cons obj, readEach inStream
 
   obj = readEach inStream
-  if (car obj) == 'error' then obj else makeObj "list", obj, line, column
+  if (car obj) == 'error' then obj else mkObj "list", obj, line, column
 
 exports.read = read
 exports.readForms = readForms

chapter1/reader_types.coffee

@@ -0,0 +1,6 @@
+exports.Symbol = class
+  constructor: (@v) ->
+
+exports.Comment = class
+  constructor: (@text) ->
+    

chapter3/interpreter.coffee

@@ -264,7 +264,6 @@ evaluateCatch = (tag, body, env, kont) ->
 class CatchCont extends Continuation
   constructor: (@kont, @body, @env) ->
   resume: (value) ->
-    console.log(value)
     evaluateBegin @body, @env, (new LabeledCont @kont, normalizeForm car value)
 
 class LabeledCont extends Continuation