[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
-nvalu = (node) -> cadr node
+defpredicate = (name, nativ, arity) ->
+  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,7 +45,34 @@ 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")
+
+cadddr = metacadr('cadddr')
+
+metadata_evaluation =
+  listp:   (node) -> (car node) == 'list'
+  symbolp: (node) -> (car node) == 'symbol'
+  numberp: (node) -> (car node) == 'number'
+  stringp: (node) -> (car node) == 'string'
+  nvalu:   (node) -> cadr node
+
+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)),
@@ -63,18 +87,18 @@ extend = (env, variables, values) ->
         else
           nil
     
-make_function = (variables, body, env) ->
+    make_function = (variables, body, env) ->
       (values) -> eprogn body, (extend env, variables, values)
     
-invoke = (fn, args) ->
+    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, "->"
+    # 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) ->
+    eprogn = (exps, env) ->
       if (pairp exps)
         if pairp (cdr exps)
           evaluate (car exps), env
@@ -84,13 +108,13 @@ eprogn = (exps, env) ->
       else
         nil
     
-evlis = (exps, env) ->
+    evlis = (exps, env) ->
       if (pairp exps)
         (cons (evaluate (car exps), env), (evlis (cdr exps), env))
       else
         nil
         
-lookup = (id, env) ->
+    lookup = (id, env) ->
       if (pairp env)
         if (caar env) == id
           cdar env
@@ -99,7 +123,7 @@ lookup = (id, env) ->
       else
         nil
     
-update = (id, env, value) ->
+    update = (id, env, value) ->
       if (pairp env)
         if (caar env) == id
           setcdr value, (car env)
@@ -109,11 +133,11 @@ update = (id, 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.
+    # 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) ->
+    astSymbolsToLispSymbols = (node) ->
       return nil if nilp node
       throw (new LispInterpreterError "Not a list of variable names") if not (ntype(node) is 'list')
       handler = (node) ->
@@ -121,13 +145,9 @@ astSymbolsToLispSymbols = (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.
   
-# 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

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) ->
-  list(type, value, line, column)
+mkObj = (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
-  makeObj 'symbol', symbol, line, column
+    return mkObj 'number', number, 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