.gitignore

@@ -6,11 +6,4 @@ npm-debug.log
 package.yml
 node_modules/*
 tmp/
-bin/_mocha
+test/
-bin/mocha
-bin/coffee
-bin/cake
-bin/coffeelint
-test-reports.xml
-LisperatorLanguage
-chapter?/test.coffee

Makefile

@@ -1,33 +0,0 @@
-.PHONY: test
-
-# docs: $(patsubst %.md,%.html,$(wildcard *.md))
-
-SOURCES= chapter1/*.coffee chapter3/*.coffee chapter-lambda-1/*.coffee test/*.coffee
-
-%.js: src/%.coffee
-	node_modules/.bin/mocha coffee -c -o . $<
-
-%.html: %.md header.html footer.html
-	cat header.html > $@
-	pandoc $< >> $@
-	cat footer.html >> $@
-
-node_modules: package.json
-	mkdir -p node_modules
-	npm install
-
-lint:
-	coffeelint $(SOURCES)
-
-test: clean node_modules
-	@JUNIT_REPORT_PATH=test-reports.xml JUNIT_REPORT_STACK=1 ./node_modules/.bin/mocha \
-		--reporter mocha-jenkins-reporter --compilers coffee:coffee-script/register || true
-
-ltest: node_modules
-	node_modules/.bin/mocha --compilers coffee:coffee-script/register
-
-watch:
-	while inotifywait $(SOURCES) ; do make test; done
-
-clean: 
-	rm -f report.xml test-reports.xml

README.md

@@ -1,37 +1,2 @@
-# A Collection of Interpreters from Lisp In Small Pieces, written in Coffeescript
+Not much to see here.  Just practicing a few things.  If you're
-
+expecting miracles, this isn't the place for it.
-## Purpose
-
-I don't know Lisp, so I figured the correct place to start was to write
-my own interpreter.  After buying five different textbooks (*The
-Structure and Interpretation of Computer Programs*, aka "The Wizard
-Book", Friedman's *The Essentials of Programming Languages*, *Let over
-Lambda*, *On Lisp*, and one more) I decided Christian Quinnec's *Lisp In
-Small Pieces* gave the clearest step-by-step introduction.
-
-Since I didn't know Lisp, my task was to translate what Quiennec wrote
-in his book into a language I *did* know: Javascript.  Well,
-Coffeescript, which is basically Javascript with a lot of the
-syntactical noise removed, which is why I liked it.
-
-## Usage
-
-I don't know if you're going to get much out of it, but the reader
-(which I had to write by hand, seeing as I didn't *have* a native Lisp
-reader on hand in my Javascripty environment), and each interpreter has
-a fairly standard test case that demonstrates that each language does
-what it says it does: you can do math, set variables, name and create
-functions, and even do recursion.
-
-## Notes
-
-chapter-lambda-1 is not from Lisp In Small Pieces.  It is a primitive
-CPS interpreter built on top of the interpreter from LiSP Chapter 1,
-using techniques derived from a fairly facile reading of 
-<a href="http://lisperator.net/pltut/">Lisperator's "Implement A
-Programming Language in Javascript."</a>  But it was fun.
-
-## LICENSE AND COPYRIGHT NOTICE: NO WARRANTY GRANTED OR IMPLIED
-
-See the LICENSE file.
-

chapter-lambda-1/interpreter.coffee

@@ -1,195 +0,0 @@
-{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar,
- cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
-{Node} = require "../chapter1/reader_types"
-
-class LispInterpreterError extends Error
-  name: 'LispInterpreterError'
-  constructor: (@message) ->
-
-env_init = nil
-env_global = env_init
-
-definitial = (name, value = nil) ->
-  env_global = (cons (cons name, value), env_global)
-  name
-
-defprimitive = (name, nativ, arity) ->
-  definitial name, ((args, callback) ->
-    vmargs = listToVector(args)
-    if (vmargs.length == arity)
-      callback nativ.apply null, vmargs
-    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
-definitial "#f", the_false_value
-definitial "nil", nil
-definitial "foo"
-definitial "bar"
-definitial "fib"
-definitial "fact"
-
-defprimitive "cons", cons, 2
-defprimitive "car", car, 2
-defprimitive "set-cdr!", setcdr, 2
-defprimitive "+", ((a, b) -> a + b), 2
-defprimitive "*", ((a, b) -> a * b), 2
-defprimitive "-", ((a, b) -> a - b), 2
-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)
-      (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 (variables.type == 'symbol')
-      (cons (cons variables, values), env)
-    else
-      nil
-
-make_function = (variables, body, env, callback) ->
-  callback (values, cb) -> eprogn body, (extend env, variables, values), cb
-
-invoke = (fn, args, callback) ->
-  fn args, callback
-
-# 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, callback) ->
-  if (pairp exps)
-    if pairp (cdr exps)
-      evaluate (car exps), env, (next) ->
-        eprogn (cdr exps), env, callback
-    else
-      evaluate (car exps), env, callback
-  else
-    callback nil
-
-evlis = (exps, env, callback) ->
-  if (pairp exps)
-    evlis (cdr exps), env, (rest) ->
-      evaluate (car exps), env, (calc) ->
-        callback cons calc, rest
-  else
-    callback nil
-
-lookup = (id, env) ->
-  if (pairp env)
-    if (caar env) == id
-      cdar env
-    else
-      lookup id, (cdr env)
-  else
-    nil
-
-update = (id, env, value, callback) ->
-  if (pairp env)
-    if (caar env) == id
-      setcdr value, (car env)
-      callback value
-    else
-      update id, (cdr env), value, callback
-  else
-    callback 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.
-
-# TODO: Reengineer this with a call to normalize
-
-astSymbolsToLispSymbols = (node) ->
-  return nil if nilp node
-  throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
-  handler = (cell) ->
-    return nil if nilp cell
-    cons (car cell).value, (handler cdr cell)
-  handler node.value
-
-# 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')
-
-metadata_evaluation =
-  listp:     (node) -> node.type == 'list'
-  symbolp:   (node) -> node.type == 'symbol'
-  numberp:   (node) -> node.type == 'number'
-  stringp:   (node) -> node.type == 'string'
-  commentp:  (node) -> node.type == 'comment'
-  nvalu:     (node) -> node.value
-  mksymbols: (list) -> astSymbolsToLispSymbols(list)
-
-straight_evaluation =
-  listp:     (cell) -> cell.__type == 'list'
-  symbolp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
-  commentp:  (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
-  numberp:   (cell) -> typeof cell == 'number'
-  stringp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
-  boolp:     (cell) -> typeof cell == 'boolean'
-  nullp:     (cell) -> cell == null
-  vectorp:   (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
-  recordp:   (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
-  objectp:   (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
-  nilp:      (cell) -> nilp(cell)
-  nvalu:     (cell) -> cell
-  mksymbols: (cell) -> cell
-
-makeEvaluator = (ix = straight_evaluation, ty="straight") ->
-  (exp, env, callback) ->
-    if ix.symbolp exp
-      return callback lookup (ix.nvalu exp), 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)
-          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), 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
-      throw new LispInterpreterError ("Can't handle a #{type}")
-
-nodeEval = makeEvaluator(metadata_evaluation, "node")
-lispEval = makeEvaluator(straight_evaluation, "lisp")
-
-evaluate = (exp, env, cb) ->
-  (if exp? and (exp instanceof Node) then nodeEval else lispEval)(exp, env, cb)
-  
-module.exports = (c, cb) -> evaluate c, env_global, cb

chapter1/astAccessors.coffee

@@ -1,10 +0,0 @@
-{car, cdr, listp} = require 'cons-lists/lists'
-{Node, Symbol} = require "./reader_types"
-
-module.exports = ops =
-  astObject: (form) -> form instanceof Node
-  aValue:  (form) ->   form.value
-  aSymbol: (form) ->   form.value
-  isAList: (form) ->   ops.astObject(form) and form.type == 'list'
-  isARecord: (form) -> ops.astObject(form) and form.type == 'record'
-  isAVector: (form) -> ops.astObject(form) and form.type == 'vector'

chapter1/astToList.coffee

@@ -1,56 +0,0 @@
-{car, cdr, cons, listp, nilp, nil,
- list, pairp, listToString} = require 'cons-lists/lists'
-{astObject} = require './astAccessors'
-{Symbol} = require './reader_types'
-
-# RICH_AST -> LISP_AST
-
-normalizeForm = (form) ->
-  
-  listToRecord1 = (l) ->
-    o = Object.create(null)
-    while(l != nil)
-      o[normalizeForm(car l)] = normalizeForm(car cdr l)
-      l = cdr cdr l
-      null
-    o
-
-  listToVector1 = (l) ->
-    while(l != nil) then p = normalizeForm(car l); l = cdr l; p
-
-  id = (a) -> a
-
-  methods =
-    'list': normalizeForms
-    'vector': (atom) -> listToVector1(atom)
-    'record': (atom) -> listToRecord1(atom)
-
-    # Basic native types.  Meh.
-    'symbol': (id) -> new Symbol(id.name)
-    'number': id
-    'string': id
-    'nil': (atom) -> nil
-
-    # Values inherited from the VM.
-    'true': (atom) -> true
-    'false': (atom) -> false
-    'null': (atom) -> null
-    'undefined': (atom) -> undefined
-
-  methods[form.type](form.value)
-
-
-normalizeForms = (forms) ->
-  # Yes, this reifies the expectation than an empty list and 'nil' are
-  # the same.
-  return nil if nilp forms
-
-  # Handle dotted list.
-  if (astObject forms)
-    return normalizeForm(forms)
-  cons(normalizeForm(car forms), normalizeForms(cdr forms))
-
-module.exports =
-  normalizeForm: normalizeForm
-  normalizeForms: normalizeForms
-

chapter1/interpreter.coffee

@@ -1,185 +0,0 @@
-{listToString, listToVector, pairp, cons, car, cdr, caar, cddr,
- cdar, cadr, caadr, cadar, caddr, nilp, nil, setcdr, metacadr} = require "cons-lists/lists"
-{Node} = require "./reader_types"
-
-class LispInterpreterError extends Error
-  name: 'LispInterpreterError'
-  constructor: (@message, position = null) ->
-
-env_init = nil
-env_global = env_init
-
-definitial = (name, value = nil) ->
-  env_global = (cons (cons name, value), env_global)
-  name
-
-defprimitive = (name, nativ, arity) ->
-  definitial name, ((args) ->
-    vmargs = listToVector(args)
-    if (vmargs.length == arity)
-      nativ.apply null, vmargs
-    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
-definitial "#f", the_false_value
-definitial "nil", nil
-definitial "foo"
-definitial "bar"
-definitial "fib"
-definitial "fact"
-
-defprimitive "cons", cons, 2
-defprimitive "car", car, 2
-defprimitive "set-cdr!", setcdr, 2
-defprimitive "+", ((a, b) -> a + b), 2
-defprimitive "*", ((a, b) -> a * b), 2
-defprimitive "-", ((a, b) -> a - b), 2
-defprimitive "/", ((a, b) -> a / b), 2
-defpredicate "lt", ((a, b) -> a < b), 2
-defpredicate "eq?", ((a, b) -> a == b), 2
-
-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 (variables.type == 'symbol')
-      (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
-
-# TODO: Reengineer this with a call to normalize
-
-tap = (i) -> console.log(i) ; i
-
-astSymbolsToLispSymbols = (node) ->
-  return nil if nilp node
-  throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
-  handler = (cell) ->
-    return nil if nilp cell
-    cons (car cell).value, (handler cdr cell)
-  handler node.value
-
-cadddr = metacadr('cadddr')
-
-# This is really the only thing that changes behavior between "reader
-# nodes" (nodes loaded with debugging metadata) and a standard cons
-# object.  TODO: astSymbolsToLispSymbols should be deprecated in
-# favor of normalizeForm (s?) and Symbol extraction
-
-metadata_evaluation =
-  listp:     (node) -> node.type == 'list'
-  symbolp:   (node) -> node.type == 'symbol'
-  numberp:   (node) -> node.type == 'number'
-  stringp:   (node) -> node.type == 'string'
-  commentp:  (node) -> node.type == 'comment'
-  nvalu:     (node) -> node.value
-  mksymbols: (list) -> astSymbolsToLispSymbols(list)
-
-straight_evaluation =
-  listp:     (cell) -> cell.__type == 'list'
-  symbolp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
-  commentp:  (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
-  numberp:   (cell) -> typeof cell == 'number'
-  stringp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
-  boolp:     (cell) -> typeof cell == 'boolean'
-  nullp:     (cell) -> cell == null
-  vectorp:   (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
-  recordp:   (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
-  objectp:   (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
-  nilp:      (cell) -> nilp(cell)
-  nvalu:     (cell) -> cell
-  mksymbols: (cell) -> cell
-
-makeEvaluator = (ix = straight_evaluation, ty="straight") ->
-  (exp, env) ->
-    # 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), env
-    else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
-      return ix.nvalu exp
-    else if ix.listp(exp)
-      body = ix.nvalu exp
-      head = car body
-      if ix.symbolp(head)
-        switch (ix.nvalu head)
-          when "quote" then cdr body
-          when "if"
-            unless (evaluate (cadr body), env) == the_false_value
-              evaluate (caddr body), env
-            else
-              evaluate (cadddr body), env
-          when "begin" then eprogn (cdr body), env
-          when "set!" then update (ix.nvalu cadr body), env, (evaluate (caddr body), env)
-          when "lambda" then make_function (ix.mksymbols cadr body), (cddr body), env
-          else invoke (evaluate (car body), env), (evlis (cdr body), env)
-      else
-        invoke (evaluate (car body), env), (evlis (cdr body), env)
-    else
-      throw new LispInterpreterError "Can't handle a #{exp.type}"
-
-nodeEval = makeEvaluator(metadata_evaluation, "node")
-lispEval = makeEvaluator(straight_evaluation, "lisp")
-
-evaluate = (exp, env) ->
-  (if exp? and (exp instanceof Node) then nodeEval else lispEval)(exp, env)
-
-module.exports = (c) -> evaluate c, env_global

chapter1/reader_types.coffee

@@ -1,11 +0,0 @@
-exports.Node = class
-  constructor: (@type, @value, @line, @column) ->
-
-exports.Symbol = class
-  constructor: (@name) ->
-    
-exports.Comment = class
-  constructor: (@text) ->
-
-
-          

chapter3/interpreter.coffee

@@ -1,448 +0,0 @@
-{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar,
- cadr, caadr, cadar, caddr, nilp, nil, setcdr,
- metacadr, setcar} = require "cons-lists/lists"
-{normalizeForms, normalizeForm} = require "../chapter1/astToList"
-{Node, Symbol} = require '../chapter1/reader_types'
-
-class LispInterpreterError extends Error
-  name: 'LispInterpreterError'
-  constructor: (@message) ->
-
-the_false_value = (cons "false", "boolean")
-
-# Base class that represents a value.  Base class representing a LiSP
-# value, a primitive, or a function
-
-eq = (id1, id2) ->
-  if id1 instanceof Symbol and id2 instanceof Symbol
-    return id1.name == id2.name
-  id1 == id2
-
-class Value
-
-# Represents the base class of a continuation.  Calls to invoke resume
-# the contained continuation, which is typecast to one of the specific
-# continuation needs of conditional, sequence, etc...
-
-class Continuation
-  constructor: (@kont) ->
-  invoke: (value, env, kont) ->
-    if nilp cdr value
-      @kont.resume (car value)
-    else
-      throw new LispInterpreterError "Continuations expect one argument"
-  unwind: (value, ktarget) ->
-    if (@kont == ktarget) then (@kont.resume value) else (@kont.unwind value, ktarget)
-  catchLookup: (tag, kk) ->
-    @kont.catchLookup tag, kk
-
-# Abstract class representing the environment
-
-class Environment
-  lookup: -> throw new LispInterpreterError "Nonspecific invocation"
-  update: -> throw new LispInterpreterError "Nonspecific invocation"
-  blockLookup: -> throw new LispInterpreterError "Not an Environment"
-
-# Base of the environment stack.  If you hit this, your variable was
-# never found for lookup/update.  Note that at this time in the
-# class, you have not
-
-class NullEnv extends Environment
-  lookup: (e) -> throw new LispInterpreterError "Unknown variable #{e}"
-  update: (e) -> throw new LispInterpreterError "Unknown variable #{e}"
-  blockLookup: (name) -> throw new LispInterpreterError "Unknown block label #{name}"
-
-# This appears to be an easy and vaguely abstract handle to the
-# environment.  The book is not clear on the distinction between the
-# FullEnv and the VariableEnv.
-
-class FullEnv extends Environment
-  constructor: (@others, @name) ->
-    @_type = "FullEnv"
-  lookup: (name, kont) ->
-    @others.lookup name, kont
-  update: (name, kont, value) ->
-    @others.update name, kont, value
-  blockLookup: (name, kont, value) ->
-    @others.blockLookup(name, kont, value)
-
-# This is the classic environment pair; either it's *this*
-# environment, or it's a parent environment, until you hit the
-# NullEnv.  Once the name has been found, the continuation is called
-# with the found value.
-
-class VariableEnv extends FullEnv
-  constructor: (@others, @name, @value) ->
-    @_type = "VariableEnv"
-  lookup: (name, kont) ->
-    if name == @name
-      kont.resume @value
-    else
-      @others.lookup name, kont
-  update: (name, kont, value) ->
-    if name == @name
-      @value = value
-      kont.resume value
-    else
-      @others.update name, kont, value
-
-# "Renders the quote term to the current continuation"; in a more
-# familiar parlance, calls resume in the current context with the
-# quoted term uninterpreted.
-
-evaluateQuote = (v, env, kont) ->
-  kont.resume normalizeForms v
-
-# Evaluates the conditional expression, creating a continuation with
-# the current environment that, when resumed, evaluates either the
-# true or false branch, again in the current enviornment.
-
-evaluateIf = (exps, env, kont) ->
-  evaluate (car exps), env, new IfCont(kont, (cadr exps), (caddr exps), env)
-
-
-class IfCont extends Continuation
-  constructor: (@kont, @ift, @iff, @env) ->
-    @_type = "IfCont"
-  resume: (value) ->
-    evaluate (if value == the_false_value then @iff else @ift), @env, @kont
-
-# Sequences: evaluates the current expression with a continuation that
-# represents "the next expression" in the sequence.  Upon resumption,
-# calls this function with that next expression.
-
-evaluateBegin = (exps, env, kont) ->
-  if (pairp exps)
-    if pairp (cdr exps)
-      evaluate (car exps), env, (new BeginCont kont, exps, env)
-    else
-      evaluate (car exps), env, kont
-  else
-    kont.resume("Begin empty value")
-
-class BeginCont extends Continuation
-  constructor: (@kont, @exps, @env) ->
-    @_type = "BeginCont"
-  resume: (v) -> evaluateBegin (cdr @exps), @env, @kont
-
-# In this continuation, we simply pass the continuation and the name
-# to the environment to look up.  The environment knows to call the
-# continuation with the value.
-
-evaluateVariable = (name, env, kont) ->
-  env.lookup(name, kont)
-
-# This is the same dance as lookup, only with the continuation being
-# called after an update has been performed.
-
-evaluateSet = (name, exp, env, kont) ->
-  evaluate exp, env, (new SetCont(kont, name, env))
-
-class SetCont extends Continuation
-  constructor: (@kont, @name, @env) ->
-    @_type = "SetCont"
-  resume: (value) ->
-    @env.update @name, @kont, value
-
-# Calls the current contunation, passing it a new function wrapper.
-
-evaluateLambda = (names, exp, env, kont) ->
-  kont.resume new Function names, exp, env
-
-# Upon invocation, evaluates the body with a new environment that
-# consists of the original names, their current values as called, and
-# the continuation an the moment of invocation, which will continue
-# (resume) execution once the function is finished.
-#
-# By the way: this is pretty much the whole the point.
-
-class Function extends Value
-  constructor: (@variables, @body, @env) ->
-    @_type = "Function"
-  invoke: (values, env, kont) ->
-    evaluateBegin @body, (extend @env, @variables, values), kont
-
-# Helper function to build name/value pairs for the current execution
-# context.
-
-extend = (env, names, values) ->
-  if (pairp names) and (pairp values)
-    new VariableEnv (extend env, (cdr names), (cdr values)), (car names), (car values)
-  else if (nilp names)
-    if (nilp values) then env else throw new LispInterpreterError "Arity mismatch"
-  else
-    new VariableEnv env, names, values
-
-# Now we start the invocation: this is applying the function.  Let's
-# take it stepwise.
-
-# Create a function environment.  Calls the evaluateArguments(), which
-# in turns goes down the list of arguments and creates a new
-# environment, and then the continuation is to actually appy the nev
-# environment to the existing function.
-
-evaluateApplication = (exp, exps, env, kont) ->
-  evaluate exp, env, (new EvFunCont kont, exps, env)
-
-class EvFunCont extends Continuation
-  constructor: (@kont, @exp, @env) ->
-    @_type = "EvFunCont"
-  resume: (f) ->
-    evaluateArguments @exp, @env, (new ApplyCont(@kont, f, @env))
-
-# Evaluate the first list, creating a new list of the arguments.  Upon
-# completion, resume the continuation with the gather phase
-
-evaluateArguments = (exp, env, kont) ->
-  if (pairp exp)
-    evaluate (car exp), env, (new ArgumentCont kont, exp, env)
-  else
-    kont.resume(nil)
-
-class ArgumentCont extends Continuation
-  constructor: (@kont, @exp, @env) ->
-    @_type = "ArgumentCont"
-  resume: (v) ->
-    evaluateArguments (cdr @exp), @env, (new GatherCont @kont, v)
-
-# Gather the arguments as each ArgumentCont is resumed into a list to
-# be passed to our next step.
-
-class GatherCont extends Continuation
-  constructor: (@kont, @value) ->
-    @_type = "GatherCont"
-  resume: (value) ->
-    @kont.resume (cons @value, value)
-
-# Upon resumption, invoke the function.
-
-class ApplyCont extends Continuation
-  constructor: (@kont, @fn, @env) ->
-    @_type = "ApplyCont"
-  resume: (value) ->
-    @fn.invoke value, @env, @kont
-
-# A special continuation that represents what we want the interpreter
-# to do when it's done processing.
-
-class BottomCont extends Continuation
-  constructor: (@kont, @func) ->
-    @_type = "BottomCont"
-  resume: (value) ->
-    @func(value)
-  unwind: (value, ktarget) ->
-    throw new LispInterpreterError "Obsolete continuation"
-  catchLookup: (tag, kk) ->
-    throw new LispInterpreterError "No associated catch"
-
-evaluateBlock = (label, body, env, kont) ->
-  k = new BlockCont(kont, label)
-  evaluateBegin body, (new BlockEnv env, label, kont), k
-
-class BlockCont extends Continuation
-  constructor: (@kont, @label) ->
-    @_type = "BlockCont"
-  resume: (value) ->
-    @kont.resume value
-
-class BlockEnv extends FullEnv
-  constructor: (@others, @name, @kont) ->
-  blockLookup: (name, kont, value) ->
-    if (name == @name)
-      kont.unwind value, @kont
-    else
-      @others.blockLookup(name, kont, value)
-
-evaluateReturnFrom = (label, form, env, kont) ->
-  evaluate form, env, (new ReturnFromCont kont, env, label)
-
-class ReturnFromCont extends Continuation
-  constructor: (@kont, @env, @label) ->
-  resume: (v) ->
-    @env.blockLookup @label, @kont, v
-
-evaluateCatch = (tag, body, env, kont) ->
-  evaluate tag, env, (new CatchCont kont, body, env)
-
-class CatchCont extends Continuation
-  constructor: (@kont, @body, @env) ->
-  resume: (value) ->
-    evaluateBegin @body, @env, (new LabeledCont @kont, value)
-
-class LabeledCont extends Continuation
-  constructor: (@kont, @tag) ->
-  resume: (value) ->
-    @kont.resume value
-  catchLookup: (tag, kk) ->
-    if eq tag, @tag
-      evaluate kk.form, kk.env, (new ThrowingCont kk, tag, this)
-    else
-      @kont.catchLookup tag, kk
-
-class ThrowCont extends Continuation
-  constructor: (@kont, @form, @env) ->
-  resume: (value) ->
-    @catchLookup value, @
-  
-evaluateThrow = (tag, form, env, kont) ->
-  evaluate tag, env, (new ThrowCont kont, form, env)
-
-class ThrowingCont extends Continuation
-  constructor: (@kont, @tag, @resumecont) ->
-  resume: (value) ->
-    @resumecont.resume value
-
-evaluateUnwindProtect = (form, cleanup, env, kont) ->
-  evaluate form, env, (new UnwindProtectCont kont, cleanup, env)
-
-class UnwindProtectCont extends Continuation
-  constructor: (@kont, @cleanup, @env) ->
-  resume: (value) ->
-    evaluateBegin @cleanup, @env, (new ProtectReturnCont @kont, value)
-
-class Primitive extends Value
-  constructor: (@name, @nativ) ->
-    @_type = "Primitive"
-  invoke: (args, env, kont) ->
-    @nativ.apply null, [args, env, kont]
-
-env_init = new NullEnv()
-
-definitial = (name, value = nil) ->
-  env_init = new VariableEnv env_init, name, value
-  name
-
-defprimitive = (name, nativ, arity) ->
-  definitial name, new Primitive name, (args, env, kont) ->
-    vmargs = listToVector(args)
-    if (vmargs.length == arity)
-      kont.resume (nativ.apply null, vmargs)
-    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
-
-definitial "#t", true
-definitial "#f", the_false_value
-definitial "nil", nil
-
-# FIXME: All of these things dereference to the same value!!!!
-
-for i in [
-  "x", "y", "z", "a", "b", "c", "foo", "bar", "hux",
-  "fib", "fact", "visit", "primes", "length"]
-  definitial i
-
-defprimitive "cons", cons, 2
-defprimitive "car", car, 2
-defprimitive "cdr", cdr, 2
-defprimitive "set-cdr!", setcdr, 2
-defprimitive "set-car!", setcar, 2
-defprimitive "+", ((a, b) -> a + b), 2
-defprimitive "*", ((a, b) -> a * b), 2
-defprimitive "-", ((a, b) -> a - b), 2
-defprimitive "/", ((a, b) -> a / b), 2
-defpredicate "lt", ((a, b) -> a < b), 2
-defpredicate "gt", ((a, b) -> a > b), 2
-defpredicate "lte", ((a, b) -> a <= b), 2
-defpredicate "gte", ((a, b) -> a >= b), 2
-defpredicate "eq?", ((a, b) -> a == b), 2
-defpredicate "pair?", ((a) -> pairp a), 1
-defpredicate "nil?", ((a) -> nilp a), 1
-defpredicate "symbol?", ((a) -> /\-?[0-9]+$/.test(a) == false), 1
-
-definitial "call/cc", new Primitive "call/cc", (values, env, kont) ->
-  if nilp cdr values
-    (car values).invoke (cons kont), env, kont
-  else
-    throw new LispInterpreterError "Incorrect arity for call/cc"
-
-definitial "apply", new Primitive "apply", (values, env, kont) ->
-  if pairp cdr values
-    f = car values
-    args = (() ->
-      (flat = (args) ->
-        if nilp (cdr args) then (car args) else (cons (car args), (flat cdr args)))(cdr values))()
-    f.invoke args, env, kont
-
-definitial "funcall", new Primitive "funcall", (args, env, kont) ->
-  if not nilp cdr args
-    @kont.invoke (car args), (cdr args)
-  else
-    throw new LispInterpreterError "Invoke requires a function name and arguments"
-
-definitial "list", new Primitive "list", (values, env, kont) ->
-  (values, env, kont) -> kont.resume(values)
-
-# Only called in rich node mode...
-
-astSymbolsToLispSymbols = (node) ->
-  return nil if nilp node
-  throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
-  handler = (cell) ->
-    return nil if nilp cell
-    cons (car cell).value, (handler cdr cell)
-  handler node.value
-
-metadata_evaluation =
-  listp:     (node) -> node.type == 'list'
-  symbolp:   (node) -> node.type == 'symbol'
-  numberp:   (node) -> node.type == 'number'
-  stringp:   (node) -> node.type == 'string'
-  commentp:  (node) -> node.type == 'comment'
-  nvalu:     (node) -> node.value
-  mksymbols: (list) -> astSymbolsToLispSymbols(list)
-
-straight_evaluation =
-  listp:     (cell) -> cell.__type == 'list'
-  symbolp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
-  commentp:  (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
-  numberp:   (cell) -> typeof cell == 'number'
-  stringp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
-  boolp:     (cell) -> typeof cell == 'boolean'
-  nullp:     (cell) -> cell == null
-  vectorp:   (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
-  recordp:   (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
-  objectp:   (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
-  nilp:      (cell) -> nilp(cell)
-  nvalu:     (cell) -> cell
-  mksymbols: (cell) -> cell
-
-makeEvaluator = (ix = straight_evaluation, ty="straight") ->
-  (exp, env, kont) ->
-    if ix.symbolp exp
-      return evaluateVariable (ix.nvalu exp), env, kont
-    else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
-      return kont.resume ix.nvalu exp
-    else if ix.listp exp
-      body = ix.nvalu exp
-      head = car body
-      if ix.symbolp head
-        switch (ix.nvalu head)
-          when "quote" then evaluateQuote (cadr body), env, kont
-          when "if" then evaluateIf (cdr body), env, kont
-          when "begin" then evaluateBegin (cdr body), env, kont
-          when "set!" then evaluateSet (ix.nvalu cadr body), (caddr body), env, kont
-          when "lambda" then evaluateLambda (ix.mksymbols cadr body), (cddr body), env, kont
-          when "block" then evaluateBlock (ix.nvalu cadr body), (cddr body), env, kont
-          when "return-from" then evaluateReturnFrom (ix.nvalu cadr body), (caddr body), env, kont
-          when "catch" then evaluateCatch (cadr body), (cddr body), env, kont
-          when "throw" then evaluateThrow (cadr body), (caddr body), env, kont
-          when "unwind-protect" then evaluateUnwindProtect (cadr body), (cddr body), env, kont
-          else evaluateApplication (car body), (cdr body), env, kont
-      else
-        evaluateApplication (car body), (cdr body), env, kont
-    else
-      throw new LispInterpreterError("Can't handle a '#{type}'")
-  
-nodeEval = makeEvaluator(metadata_evaluation, "node")
-lispEval = makeEvaluator(straight_evaluation, "lisp")
-
-evaluate = (exp, env, kont) ->
-  (if exp? and (exp instanceof Node) then nodeEval else lispEval)(exp, env, kont)
-
-interpreter = (ast, kont) ->
-  evaluate ast, env_init, new BottomCont null, kont
-
-module.exports = interpreter

chapter3g/interpreter.coffee

@@ -1,549 +0,0 @@
-{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar,
- cadr, caadr, cadar, caddr, nilp, nil, setcdr,
- metacadr, setcar} = require "cons-lists/lists"
-{normalizeForms, normalizeForm} = require "../chapter1/astToList"
-{Node, Symbol} = require '../chapter1/reader_types'
-
-class LispInterpreterError extends Error
-  name: 'LispInterpreterError'
-  constructor: (@message) ->
-
-the_false_value = (cons "false", "boolean")
-
-# An equality function that compares two values.  This is necessary
-# because object comparison in Javascipt is by reference, not by value.
-# I want them to be by value, and this accomplishes that in this one
-# special case.
-
-eq = (id1, id2) ->
-  if id1 instanceof Symbol and id2 instanceof Symbol
-    return id1.name == id2.name
-  id1 == id2
-
-# Base class that represents a value.  Base class representing a LiSP
-# value, a primitive, or a function
-
-class Value
-
-# Represents the base class of a continuation.  
-
-class Continuation
-  # Takes an existing continuation, which represents what to do when
-  # this continuation is invoked.
-  constructor: (@kont) ->
-
-  # Near as I can tell, this exists strictly to support call/cc
-  invoke: (value, env, kont) ->
-    if nilp cdr value
-      @kont.resume (car value)
-    else
-      throw new LispInterpreterError "Continuations expect one argument"
-
-  # As we're unwinding the stack, when we receive a new ktarget we've
-  # "breached" where this protection was created and need to resume the
-  # continuation passed there.
-  unwind: (value, ktarget) ->
-    if (@ == ktarget) then (@kont.resume value) else (@kont.unwind value, ktarget)
-
-  # When a throw happens, we need to proceed down the stack looking
-  # for a CatchContinuation.  This supports that for all continuations.
-  catchLookup: (tag, kk) ->
-    @kont.catchLookup tag, kk
-
-  # Resume is literally the "What to do next."  
-  resume: (value) ->
-    throw new LispInterpreterError "Wrong continuation for #{@_type}"
-
-# Abstract class representing the environment
-
-class Environment
-  lookup: -> throw new LispInterpreterError "Nonspecific invocation"
-  update: -> throw new LispInterpreterError "Nonspecific invocation"
-  blockLookup: -> throw new LispInterpreterError "Not an Environment"
-
-# Base of the environment stack.  If you hit this, your variable was
-# never found for lookup/update.  Note that at this time in the
-# class, you have not
-
-class NullEnv extends Environment
-  lookup: (e) -> throw new LispInterpreterError "Unknown variable #{e}"
-  update: (e) -> throw new LispInterpreterError "Unknown variable #{e}"
-  blockLookup: (name) -> throw new LispInterpreterError "Unknown block label #{name}"
-
-# This appears to be an easy and vaguely abstract handle to the
-# environment.  The book is not clear on the distinction between the
-# FullEnv and the VariableEnv.
-
-class FullEnv extends Environment
-  constructor: (@others, @name) ->
-    @_type = "FullEnv"
-  lookup: (name, kont) ->
-    @others.lookup name, kont
-  update: (name, kont, value) ->
-    @others.update name, kont, value
-  blockLookup: (name, kont, value) ->
-    @others.blockLookup(name, kont, value)
-
-# This is the classic environment pair; either it's *this*
-# environment, or it's a parent environment, until you hit the
-# NullEnv.  Once the name has been found, the continuation is called
-# with the found value.
-
-class VariableEnv extends FullEnv
-  constructor: (@others, @name, @value) ->
-    @_type = "VariableEnv"
-  lookup: (name, kont) ->
-    if name == @name
-      kont.resume @value
-    else
-      @others.lookup name, kont
-  update: (name, kont, value) ->
-    if name == @name
-      @value = value
-      kont.resume value
-    else
-      @others.update name, kont, value
-
-# "Renders the quote term to the current continuation"; in a more
-# familiar parlance, calls resume in the current context with the
-# quoted term uninterpreted.
-
-evaluateQuote = (v, env, kont) ->
-  kont.resume normalizeForms v
-
-# Evaluates the conditional expression, creating a continuation with
-# the current environment that, when resumed, evaluates either the
-# true or false branch, again in the current enviornment.
-
-evaluateIf = (exps, env, kont) ->
-  evaluate (car exps), env, new IfCont(kont, (cadr exps), (caddr exps), env)
-
-class IfCont extends Continuation
-  constructor: (@kont, @ift, @iff, @env) ->
-    @_type = "IfCont"
-  resume: (value) ->
-    evaluate (if value == the_false_value then @iff else @ift), @env, @kont
-
-# Sequences: evaluates the current expression with a continuation that
-# represents "the next expression" in the sequence.  Upon resumption,
-# calls this function with that next expression.  You can begin to
-# note how the "what to do next" gets wrapped in deeper and deeper
-# layers of context until the current needs are resolved and we
-# finally reach that final expression.
-
-evaluateBegin = (exps, env, kont) ->
-  if (pairp exps)
-    if pairp (cdr exps)
-      evaluate (car exps), env, (new BeginCont kont, exps, env)
-    else
-      evaluate (car exps), env, kont
-  else
-    kont.resume("Begin empty value")
-
-class BeginCont extends Continuation
-  constructor: (@kont, @exps, @env) ->
-    @_type = "BeginCont"
-  resume: (v) -> evaluateBegin (cdr @exps), @env, @kont
-
-# In this continuation, we simply pass the continuation and the name
-# to the environment to look up.  The environment knows to call the
-# continuation with the value.
-
-evaluateVariable = (name, env, kont) ->
-  env.lookup(name, kont)
-
-# This is the same dance as lookup, only with the continuation being
-# called after an update has been performed.
-
-evaluateSet = (name, exp, env, kont) ->
-  evaluate exp, env, (new SetCont(kont, name, env))
-
-class SetCont extends Continuation
-  constructor: (@kont, @name, @env) ->
-    @_type = "SetCont"
-  resume: (value) ->
-    @env.update @name, @kont, value
-
-# Calls the current contunation, passing it a new function wrapper.
-
-evaluateLambda = (names, exp, env, kont) ->
-  kont.resume new Function names, exp, env
-
-# Upon invocation, evaluates the body with a new environment that
-# consists of the original names, their current values as called, and
-# the continuation an the moment of invocation, which will continue
-# (resume) execution once the function is finished.
-#
-# By the way: this is pretty much the whole the point.
-
-class Function extends Value
-  constructor: (@variables, @body, @env) ->
-    @_type = "Function"
-  invoke: (values, env, kont) ->
-    evaluateBegin @body, (extend @env, @variables, values), kont
-
-# Helper function to build name/value pairs for the current execution
-# context.
-
-extend = (env, names, values) ->
-  if (pairp names) and (pairp values)
-    new VariableEnv (extend env, (cdr names), (cdr values)), (car names), (car values)
-  else if (nilp names)
-    if (nilp values) then env else throw new LispInterpreterError "Arity mismatch"
-  else
-    new VariableEnv env, names, values
-
-# Now we start the invocation: this is applying the function.  Let's
-# take it stepwise.
-
-# Evaluate the application of a function call.  The first step is to
-# evaluate the first element of the function call, assuming it is or
-# will resolve to a function (something of type * -> *).  The
-# continuation we create is to evaluate-function-cont.
-
-evaluateApplication = (exp, exps, env, kont) ->
-  evaluate exp, env, (new EvFunCont kont, exps, env)
-
-# After the function reference is finally generated, the resume()
-# function here takes that reference and creates an
-# apply-continuation, then calls evaluateArguments.  See that.
-
-class EvFunCont extends Continuation
-  constructor: (@kont, @exp, @env) ->
-    @_type = "EvFunCont"
-  resume: (f) ->
-    evaluateArguments @exp, @env, (new ApplyCont(@kont, f, @env))
-
-# Evaluate the argument list, creating a new list of the arguments.
-# For each argument pair, in calls the gather-cont, which creates the
-# actual pair and resumes by processing the next pair, building the
-# new environment.  When the list is exhausted, the EvFunCont's built
-# ApplyCont() is called with the generated new environment and its
-# associated thunk.
-
-evaluateArguments = (exp, env, kont) ->
-  if (pairp exp)
-    evaluate (car exp), env, (new ArgumentCont kont, exp, env)
-  else
-    kont.resume(nil)
-
-class ArgumentCont extends Continuation
-  constructor: (@kont, @exp, @env) ->
-    @_type = "ArgumentCont"
-  resume: (v) ->
-    evaluateArguments (cdr @exp), @env, (new GatherCont @kont, v)
-
-# Gather the arguments as each ArgumentCont is resumed into a list to
-# be passed to our next step.
-
-class GatherCont extends Continuation
-  constructor: (@kont, @value) ->
-    @_type = "GatherCont"
-  resume: (value) ->
-    @kont.resume (cons @value, value)
-
-# Called with the new environment, and the orginal continuation that
-# says what to do with the value generated by this function, now that
-# it's actually been invoke.
-
-class ApplyCont extends Continuation
-  constructor: (@kont, @fn, @env) ->
-    @_type = "ApplyCont"
-  resume: (value) ->
-    @fn.invoke value, @env, @kont
-
-# A special continuation that represents what we want the interpreter
-# to do when it's done processing.
-
-class BottomCont extends Continuation
-  constructor: (@kont, @func) ->
-    @_type = "BottomCont"
-  resume: (value) ->
-    @func(value)
-  unwind: (value, ktarget) ->
-    throw new LispInterpreterError "Obsolete continuation"
-  catchLookup: (tag, kk) ->
-    throw new LispInterpreterError "No associated catch"
-
-# A block is an implicit begin.  So we evaluate it's contents with a
-# new block-environment, which will automatically unwind any contents
-# found within by traversing up the environment stack looking for
-# labels that match the one with which this block was created.
-
-evaluateBlock = (label, body, env, kont) ->
-  k = new BlockCont(kont, label)
-  evaluateBegin body, (new BlockEnv env, label, k), k
-
-class BlockCont extends Continuation
-  constructor: (@kont, @label) ->
-    @_type = "BlockCont"
-  resume: (value) ->
-    @kont.resume value
-
-class BlockEnv extends FullEnv
-  constructor: (@others, @name, @kont) ->
-  blockLookup: (name, kont, value) ->
-    if (name == @name)
-      kont.unwind value, @kont
-    else
-      @others.blockLookup(name, kont, value)
-
-evaluateReturnFrom = (label, form, env, kont) ->
-  evaluate form, env, (new ReturnFromCont kont, env, label)
-
-# Note that when return-from-cont's body has been evaluated, we then
-# unwind up the environment stack until we find the first block that
-# has the same label and call the continuation saved there.  Note that
-# this is the *first* time that continuation and executable is stored
-# on the environment, and isn't implicitly part of the continuation
-# stack.
-
-class ReturnFromCont extends Continuation
-  constructor: (@kont, @env, @label) ->
-    @_type = "ReturnFromCont"
-  resume: (v) ->
-    @env.blockLookup @label, @kont, v
-
-evaluateCatch = (tag, body, env, kont) ->
-  evaluate tag, env, (new CatchCont kont, body, env)
-
-# catch-continuation receives (from evaluate) the processed value of a
-# tag, the current environment, and what should happen after the
-# context containing the catch is complete (the passed in 'kont' to
-# evaluateCatch).  That processed value becomes the label of the new
-# labeled-continuation.
-
-class CatchCont extends Continuation
-  constructor: (@kont, @body, @env) ->
-    @_type = "CatchFromCont"
-  resume: (value) ->
-    evaluateBegin @body, @env, (new LabeledCont @kont, value)
-
-# Resume here does just that; it just resumes with the continuation
-# passed in above.  But should catch be *triggered* by a throw (and
-# the throw-continuation), we get the contents of throw as an object
-# to be evaluated with its current environment, then continue with
-# *this* as the continuation passed to throwing-continuation, which
-# resumes the catchLookup until the stack is exhausted.
-
-class LabeledCont extends Continuation
-  constructor: (@kont, @tag) ->
-    @_type = "LabeledFromCont"
-  resume: (value) ->
-    @kont.resume value
-  catchLookup: (tag, kk) ->
-    if eq tag, @tag
-      evaluate kk.form, kk.env, (new ThrowingCont kk, tag, this)
-    else
-      @kont.catchLookup tag, kk
-
-class ThrowCont extends Continuation
-  constructor: (@kont, @form, @env) ->
-    @_type = "ThrowCont"
-  resume: (value) ->
-    @catchLookup value, @
-  
-evaluateThrow = (tag, form, env, kont) ->
-  evaluate tag, env, (new ThrowCont kont, form, env)
-
-class UnwindCont extends Continuation
-  constructor: (@kont, @value, @target) ->
-  resume: (value) ->
-    @kont.unwind @value, @target
-
-evaluateUnwindProtect = (form, cleanup, env, kont) ->
-  evaluate form, env, (new UnwindProtectCont kont, cleanup, env)
-
-# If the continuation is "resumed," it works like normal; but if its
-# "unwound," it works its way up the unwind stack looking for the
-# target continuation to which to deliver the value.
-
-class UnwindProtectCont extends Continuation
-  constructor: (@kont, @cleanup, @env) ->
-    @_type = "UnwindProtectCont"
-  resume: (value) ->
-    evaluateBegin @cleanup, @env, (new ProtectReturnCont @kont, value)
-  unwind: (value, target) ->
-    evaluateBegin @cleanup, @env, (new UnwindCont @kont, value, target)
-
-# Works its way through the stack environment stack, looking for
-# ("breaching") protected blocks to unwind, and processing them as
-# necessary.  One of those will by definition be the continuation
-# passed to the catch continuation: the throwing-continuation was
-# constructed with the catch continuation itself as the address of the
-# resumecont.
-
-class ThrowingCont extends Continuation
-  constructor: (@kont, @tag, @resumecont) ->
-    @_type = "ThrowingCont"
-  resume: (value) ->
-    @kont.unwind value, @resumecont
-
-# Note that this behavior basically much like throwing-continuation,
-# except that it's the resumption (the next continuation), rather than
-# the rewind.
-
-class ProtectReturnCont extends Continuation
-  constructor: (@kont, @value) ->
-    @_type = "ProtectReturnCont"
-  resume: (value) ->
-    @kont.resume @value
-
-# The bottom of the function pile, where native code is invoked.
-
-class Primitive extends Value
-  constructor: (@name, @nativ) ->
-    @_type = "Primitive"
-  invoke: (args, env, kont) ->
-    @nativ.apply null, [args, env, kont]
-
-env_init = new NullEnv()
-
-definitial = (name, value = nil) ->
-  env_init = new VariableEnv env_init, name, value
-  name
-
-defprimitive = (name, nativ, arity) ->
-  definitial name, new Primitive name, (args, env, kont) ->
-    vmargs = listToVector(args)
-    if (vmargs.length == arity)
-      # Note that native.apply(ctx, vmargs) is expected to return a
-      # singleton, like all evaluate() passes.
-      kont.resume (nativ.apply null, vmargs)
-    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
-
-definitial "#t", true
-definitial "#f", the_false_value
-definitial "nil", nil
-
-# FIXME: All of these things dereference to the same value!!!!
-
-for i in [
-  "x", "y", "z", "a", "b", "c", "foo", "bar", "hux",
-  "fib", "fact", "visit", "primes", "length"]
-  definitial i
-
-defprimitive "cons", cons, 2
-defprimitive "car", car, 2
-defprimitive "cdr", cdr, 2
-defprimitive "set-cdr!", setcdr, 2
-defprimitive "set-car!", setcar, 2
-defprimitive "+", ((a, b) -> a + b), 2
-defprimitive "*", ((a, b) -> a * b), 2
-defprimitive "-", ((a, b) -> a - b), 2
-defprimitive "/", ((a, b) -> a / b), 2
-defpredicate "lt", ((a, b) -> a < b), 2
-defpredicate "gt", ((a, b) -> a > b), 2
-defpredicate "lte", ((a, b) -> a <= b), 2
-defpredicate "gte", ((a, b) -> a >= b), 2
-defpredicate "eq?", ((a, b) -> a == b), 2
-defpredicate "pair?", ((a) -> pairp a), 1
-defpredicate "nil?", ((a) -> nilp a), 1
-defpredicate "symbol?", ((a) -> /\-?[0-9]+$/.test(a) == false), 1
-
-definitial "call/cc", new Primitive "call/cc", (values, env, kont) ->
-  if nilp cdr values
-    (car values).invoke (cons kont), env, kont
-  else
-    throw new LispInterpreterError "Incorrect arity for call/cc"
-
-definitial "apply", new Primitive "apply", (values, env, kont) ->
-  if pairp cdr values
-    f = car values
-    args = (() ->
-      (flat = (args) ->
-        if nilp (cdr args) then (car args) else (cons (car args), (flat cdr args)))(cdr values))()
-    f.invoke args, env, kont
-
-definitial "funcall", new Primitive "funcall", (args, env, kont) ->
-    if not nilp cdr args
-      kont.invoke (env.lookup (car args)), (cdr args)
-    else
-      throw new LispInterpreterError "Invoke requires a function name and arguments"
-
-definitial "list", new Primitive "list", (values, env, kont) ->
-  (values, env, kont) -> kont.resume(values)
-
-# Only called in rich node mode...
-
-astSymbolsToLispSymbols = (node) ->
-  return nil if nilp node
-  throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
-  handler = (cell) ->
-    return nil if nilp cell
-    cons (car cell).value, (handler cdr cell)
-  handler node.value
-
-metadata_evaluation =
-  listp:     (node) -> node.type == 'list'
-  symbolp:   (node) -> node.type == 'symbol'
-  numberp:   (node) -> node.type == 'number'
-  stringp:   (node) -> node.type == 'string'
-  commentp:  (node) -> node.type == 'comment'
-  nvalu:     (node) -> node.value
-  mksymbols: (list) -> astSymbolsToLispSymbols(list)
-
-# The hairness of this makes me doubt the wisdom of using Javascript.
-
-straight_evaluation = 
-  listp:     (cell) -> cell.__type == 'list'
-  symbolp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] not in ["\"", ";"]
-  commentp:  (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
-  numberp:   (cell) -> typeof cell == 'number'
-  stringp:   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
-  boolp:     (cell) -> typeof cell == 'boolean'
-  nullp:     (cell) -> cell == null
-  vectorp:   (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
-  recordp:   (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
-  objectp:   (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
-  nilp:      (cell) -> nilp(cell)
-  nvalu:     (cell) -> cell
-  mksymbols: (cell) -> cell
-
-
-prox = 
-  "quote":   (body, env, kont, ix) -> evaluateQuote (cadr body), env, kont
-  "if":      (body, env, kont, ix) -> evaluateIf (cdr body), env, kont
-  "begin":   (body, env, kont, ix) -> evaluateBegin (cdr body), env, kont
-  "set!":    (body, env, kont, ix) -> evaluateSet (ix.nvalu cadr body), (caddr body), env, kont
-  "lambda":  (body, env, kont, ix) -> evaluateLambda (ix.mksymbols cadr body), (cddr body), env, kont
-  "block":   (body, env, kont, ix) -> evaluateBlock (ix.nvalu cadr body), (cddr body), env, kont
-  "return":  (body, env, kont, ix) -> evaluateReturnFrom (ix.nvalu cadr body), (caddr body), env, kont
-  "catch":   (body, env, kont, ix) -> evaluateCatch (cadr body), (cddr body), env, kont
-  "throw":   (body, env, kont, ix) -> evaluateThrow (cadr body), (caddr body), env, kont
-  "protect": (body, env, kont, ix) -> evaluateUnwindProtect (cadr body), (cddr body), env, kont
-
-makeEvaluator = (ix = straight_evaluation, ty="straight") ->
-  (exp, env, kont) ->
-    if ix.symbolp exp
-      return evaluateVariable (ix.nvalu exp), env, kont
-    else if ([ix.numberp, ix.stringp].filter (i) -> i(exp)).length > 0
-      return kont.resume ix.nvalu exp
-    else if ix.listp exp
-      body = ix.nvalu exp
-      head = car body
-      if ix.symbolp head
-        # Every call is boiled down to body/env/kont (with ix.nvalu tossed in for fun)
-        # It should be possible to move natives into an address space
-        if prox[(ix.nvalu head)]?
-          prox[(ix.nvalu head)](body, env, kont, ix)
-        else evaluateApplication (car body), (cdr body), env, kont
-      else
-        evaluateApplication (car body), (cdr body), env, kont
-    else
-      throw new LispInterpreterError("Can't handle a '#{type}'")
-  
-nodeEval = makeEvaluator(metadata_evaluation, "node")
-lispEval = makeEvaluator(straight_evaluation, "lisp")
-
-evaluate = (exp, env, kont) ->
-  (if exp? and (exp instanceof Node) then nodeEval else lispEval)(exp, env, kont)
-
-interpreter = (ast, kont) ->
-  evaluate ast, env_init, new BottomCont null, kont
-
-module.exports = interpreter

chapter3g/test.coffee

@@ -1,12 +0,0 @@
-olisp = require '../chapter3g/interpreter'
-{read, readForms} = require '../chapter1/reader'
-{inspect} = require 'util'
-
-lisp = (ast) ->
-  ret = undefined
-  olisp ast, (i) -> ret = i
-  return ret
-
-# console.log lisp read "(catch 2 (* 7 (catch 1 (* 3 (catch 2 (throw 1 (throw 2 5)) )) )))"
-
-console.log lisp read "((lambda (c) (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) (set! c 1) ))) ) 0)"

chapter4/interpreter.coffee

@@ -1,479 +0,0 @@
-{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar,
- cadr, caadr, cadar, caddr, nilp, nil, setcdr,
- metacadr, setcar} = require "cons-lists/lists"
-{length} = require "cons-lists/reduce"
-{normalizeForms, normalizeForm} = require "../chapter1/astToList"
-{Node, Comment, Symbol} = require '../chapter1/reader_types'
-{inspect} = require 'util'
-
-itap = (a) -> return inspect a, true, null, false
-
-class LispInterpreterError extends Error
-  name: 'LispInterpreterError'
-  constructor: (@message) ->
-
-the_false_value = (cons "false", "boolean")
-
-eq = (id1, id2) ->
-  if id1 instanceof Symbol and id2 instanceof Symbol
-    return id1.name == id2.name
-  id1 == id2
-
-# Only called in rich node mode...
-
-astSymbolsToLispSymbols = (node) ->
-  return nil if nilp node
-  throw (new LispInterpreterError "Not a list of variable names") if not node.type == 'list'
-  handler = (cell) ->
-    return nil if nilp cell
-    cons (car cell).value, (handler cdr cell)
-  handler node.value
-
-cadddr = metacadr('cadddr')
-
-intlistp =     (node) -> node.type == 'list'
-intpairp =     (node) -> node.type == 'list' and ((node.value.length < 2) or node.value[1].node.type != 'list')
-intsymbolp =   (node) -> node.type == 'symbol' or node instanceof Symbol
-intnumberp =   (node) -> node.type == 'number'
-intstringp =   (node) -> node.type == 'string'
-intcommentp =  (node) -> node.type == 'comment'
-intnvalu =     (node) -> node.value
-intatomp =     (node) -> node.type in ['symbol', 'number', 'string']
-intnullp =     (node) -> node.type == 'symbol' and node.value.name == 'null'
-intmksymbols = (list) -> astSymbolsToLispSymbols(list)
-
-# The hairness of this makes me doubt the wisdom of using Javascript.
-
-sBehavior = new Symbol 'behavior'
-sBoolean  = new Symbol 'boolean'
-sBoolify  = new Symbol 'boolify'
-sFunction = new Symbol 'function'
-sSymbol   = new Symbol 'symbol'
-sString   = new Symbol 'string'
-sValue    = new Symbol 'chars'
-sName     = new Symbol 'name'
-sNumber   = new Symbol 'number'
-sNull     = new Symbol 'null'
-sTag      = new Symbol 'tag'
-sType     = new Symbol 'type'
-sValue    = new Symbol 'value'
-sPair     = new Symbol 'pair'
-sCar      = new Symbol 'car'
-sCdr      = new Symbol 'cdr'
-sSetCar   = new Symbol 'setcar'
-sSetCdr   = new Symbol 'setcdr'
-
-prox =
-  "quote":   (body, env, mem, kont) -> evaluateQuote (cadr body), env, mem, kont
-  "if":      (body, env, mem, kont) -> evaluateIf (cadr body), (caddr body), (cadddr body), env, mem, kont
-  "begin":   (body, env, mem, kont) -> evaluateBegin (cdr body), env, mem, kont
-  "set!":    (body, env, mem, kont) -> evaluateSet (intnvalu cadr body), (caddr body), env, mem, kont
-  "lambda":  (body, env, mem, kont) -> evaluateLambda (intmksymbols cadr body), (cddr body), env, mem, kont
-  "or":      (body, env, mem, kont) -> evaluateOr (cadr body), (caddr body), env, mem, kont
-
-#  ___          _           _
-# | __|_ ____ _| |_  _ __ _| |_ ___ _ _
-# | _|\ V / _` | | || / _` |  _/ _ \ '_|
-# |___|\_/\__,_|_|\_,_\__,_|\__\___/_|
-#
-
-transcode = (value, mem, qont) ->
-  forms = [
-    [intnullp, -> qont theEmptyList, mem],
-    [((v) -> intsymbolp(v) and v in ['#t', '#f']), (-> qont (createBoolean value), mem)]
-    [intsymbolp, (-> qont (createSymbol value), mem)]
-    [intnumberp, (-> qont (createNumber value), mem)]
-    [intstringp, (-> qont (createString value), mem)]
-    [intlistp,   (-> transcode (car intnvalu value), mem, (addr, mem2) ->
-      (transcode (cdr intvalu value), mem2, (d, mem3) ->
-        (allocatePair addr, d, mem3, qont)))]
-  ]
-  found = (form[1] for form in forms when form[0](value))
-  if found.length != 1
-    throw new LispInterpreterError "Bad transcode match for #{value}"
-  found[0]()
-
-transcode2 = (value, mem, qont) ->
-  forms = [
-    [((v) -> v instanceof Symbol and v.name == 'null'), (-> qont theEmptyList, mem)],
-    [((v) -> v instanceof Symbol and v.name in ['#t', '#f']), (-> qont (createBoolean value), mem)]
-    [((v) -> v instanceof Symbol), (-> qont (createSymbol value), mem)]
-    [((v) -> typeof v == 'string'), (-> qont (createString value), mem)]
-    [((v) -> typeof v == 'number'), (-> qont (createNumber value), mem)]
-    [((v) -> v.__type == 'list'), (-> transcode (car value), mem, (addr, mem2) ->
-      (transcode (cdr value), mem2, (d, mem3) ->
-        (allocatePair addr, d, mem3, qont)))]
-  ]
-  found = (form[1] for form in forms when form[0](value))
-  if found.length < 1
-    throw new LispInterpreterError "Bad transcode match for #{value}"
-  found[0]()
-
-
-transcodeBack = (value, mem) ->
-  forms = [
-    [sBoolean,  ((v) -> ((v sBoolify) true, false))]
-    [sSymbol,   ((v) -> (v sName))]
-    [sString,   ((v) -> (v sValue))]
-    [sNumber,   ((v) -> (v sValue))]
-    [sPair,     ((v) ->
-      cons (transcodeBack (mem (v sCar)), mem), (transcodeBack (mem (v sCdr)), mem))]
-    [sFunction, (v) -> v]
-  ]
-  found = (form[1] for form in forms when (eq (value sType), form[0]))
-  if found.length != 1
-    throw new LispInterpreterError "Bad transcode-back match for #{value}"
-  found[0](value)
-
-evaluate = (exp, env, mem, kont) ->
-  if intatomp exp
-    if intsymbolp exp
-      evaluateVariable (intnvalu exp), env, mem, kont
-    else
-      evaluateQuote exp, env, mem, kont
-  else
-    body = intnvalu exp
-    head = car body
-    pname = (intnvalu head)
-    if pname instanceof Symbol and prox[pname.name]?
-      prox[pname.name](body, env, mem, kont)
-    else
-      evaluateApplication head, (cdr body), env, mem, kont
-
-env_init = (id) ->
-  throw new LispInterpreterError "No binding for " + id
-
-# This is basically the core definition of 'mem': it returns a
-# function enclosing the address (a monotomically increasing number as
-# memory is allocated) and the value.  Update is passed the current
-# memory, the address, and the value; it returns a function that says
-# "If the requested address is my address, return my value, otherwise
-# I'll call the memory handed to me at creation time with the address,
-# and it'll go down the line."  Update basically adds to a 'stack'
-# built entirely out of pointers to the base mem.
-
-update = (mem, addr, value) ->
-  (addra) -> if (eq addra, addr) then value else (mem addra)
-
-updates = (mem, addrs, values) ->
-  if (pairp addrs)
-    updates (update mem, (car addrs), (car values)), (cdr addrs), (cdr values)
-  else
-    mem
-
-# Memory location zero contains the position of the stack.
-
-expandStore = (highLocation, mem) ->
-  update mem, 0, highLocation
-
-mem_init = expandStore 0, (a) ->
-  throw new LispInterpreterError "No such address #{a}"
-
-newLocation = (mem) ->
-  (mem 0) + 1
-
-evaluateVariable = (name, env, mem, kont) ->
-  kont (mem (env name)), mem
-
-evaluateSet = (name, exp, env, mem, kont) ->
-  evaluate exp, env, mem, (value, mem2) ->
-    kont value, (update mem2, (env name), value)
-
-evaluateApplication = (exp, exprs, env, mem, kont) ->
-  
-  # In chapter 3, this was a series of jumping continuations chasing
-  # each other.  Here, all of the continuations are kept in one place,
-  # and the argument list is built by tail-calls to evaluateArguments
-  # until the list is exhausted, at which point the continuation is
-  # called.  The continuation is built in the second paragraph below.
-
-  evaluateArguments = (exprs, env, mem, kont) ->
-    if (pairp exprs)
-      evaluate (car exprs), env, mem, (value, mem2) ->
-        evaluateArguments (cdr exprs), env, mem2, (value2, mem3) ->
-          kont (cons value, value2), mem3
-    else
-      kont cons(), mem
-
-  evaluate exp, env, mem, (fun, mem2) ->
-    evaluateArguments exprs, env, mem2, (value2, mem3) ->
-      if eq (fun sType), sFunction
-        (fun sBehavior) value2, mem3, kont
-      else
-        throw new LispInterpreterError "Not a function #{(car value2)}"
-
-# Creates a memory address for the function, then creates a new memory
-# address for each argument, then evaluates the expressions in the
-# lambda, returning the value of the last one.
-
-evaluateLambda = (names, exprs, env, mem, kont) ->
-  allocate 1, mem, (addrs, mem2) ->
-    kont (createFunction (car addrs), (values, mem, kont) ->
-      if eq (length names), (length values)
-        allocate (length names), mem, (addrs, mem2) ->
-          evaluateBegin exprs, (updates env, names, addrs), (updates mem2, addrs, values), kont
-      else
-        throw new LispInterpreterError "Incorrect Arrity"), mem2
-
-evaluateIf = (expc, expt, expf, env, mem, kont) ->
-  evaluate expc, env, mem, (env, mems) ->
-    evaluate ((env sBoolify) expt, expf), env, mems, kont
-
-evaluateQuote = (c, env, mem, kont) ->
-  transcode2 (normalizeForm c), mem, kont
-
-# By starting over "from here," we undo all side-effect assignments
-# that were effected by expression 1
-
-evaluateOr = (exp1, exp2, env, mem, kont) ->
-  evaluate exp1, env, mem, (value, mem2) ->
-    ((value sBoolify) (-> kont value, mem2), (-> evaluate exp2, env, mem, kont))()
-
-# I like how, in this version, we explicitly throw away the meaning of
-# all but the last statement in evaluateBegin.
-evaluateBegin = (exps, env, mem, kont) ->
-  if pairp (cdr exps)
-    evaluate (car exps), env, mem, (_, mems) ->
-      evaluateBegin (cdr exps), env, mems, kont
-  else
-    evaluate (car exps), env, mem, kont
-
-theEmptyList = (msg) ->
-  switch msg
-    when sType then sNull
-    when sBoolify then (x, y) -> x
-
-createBoolean = (value) ->
-  combinator = if value then ((x, y) -> x) else ((x, y) -> y)
-  (msg) ->
-    switch msg
-      when sType then sBoolean
-      when sBoolify then combinator
-
-createSymbol = (value) ->
-  (msg) ->
-    switch msg
-      when sType then sSymbol
-      when sName then value
-      when sBoolify then (x, y) -> x
-
-createNumber = (value) ->
-  (msg) ->
-    switch msg
-      when sType then sNumber
-      when sValue then value
-      when sBoolify then (x, y) -> x
-
-createString = (value) ->
-  (msg) ->
-    switch msg
-      when sType then sString
-      when sValue then value
-      when sBoolify then (x, y) -> x
-
-createFunction = (tag, behavior) ->
-  (msg) ->
-    switch msg
-      when sType then sFunction
-      when sBoolify then (x, y) -> x
-      when sTag then tag
-      when sBehavior then behavior
-
-# I'm not sure I get the difference between allocate and update.
-# Update appears to have the power to append to the memory list
-# without updating highLocation.  If I'm reading this correct, then
-# what we're actually looking at is a simulation of a memory
-# subsystem, with expandStore/newLocation/allocate taking on the duty
-# of "managing" our stack, and update actually just doing the managing
-# the stack, and letting the garbage collector do its thing when a
-# pointer to memory function goes out of scope.  In short: the
-# allocate collection of functions is "going through the motions" of
-# managing memory; had this been a real memory manager, you'd have
-# a lot more work to do.
-
-allocate = (num, mem, q) ->
-  if (num > 0)
-    do ->
-      addr = newLocation mem
-      allocate (num - 1), (expandStore addr, mem), (addrs, mem2) ->
-        q (cons addr, addrs), mem2
-  else
-    q cons(), mem
-
-allocateList = (values, mem, q) ->
-  consify = (values, q) ->
-    if (pairp values)
-      consify (cdr values), (value, mem2) ->
-        allocatePair (car values), value, mem2, q
-    else
-      q theEmptyList, mem
-  consify values, q
-
-allocatePair = (addr, d, mem, q) ->
-  allocate 2, mem, (addrs, mem2) ->
-    q (createPair (car addrs), (cadr addrs)), (update (update mem2, (car addrs), addr), (cadr addrs), d)
-
-createPair = (a, d) ->
-  (msg) ->
-    switch msg
-      when sType then sPair
-      when sBoolify then (x, y) -> x
-      when sSetCar then (mem, val) -> update mem, a, val
-      when sSetCdr then (mem, val) -> update mem, d, val
-      when sCar then a
-      when sCdr then d
-
-env_global = env_init
-mem_global = mem_init
-
-# The name is pushed onto the global environment, with a corresponding
-# address.  The address is pushed onto the current memory, with the
-# corresponding boxed value.
-
-defInitial = (name, value) ->
-  if typeof name == 'string'
-    name = new Symbol name
-  allocate 1, mem_global, (addrs, mem2) ->
-    env_global = update env_global, name, (car addrs)
-    mem_global = update mem2, (car addrs), value
-
-defPrimitive = (name, arity, value) ->
-  defInitial name, allocate 1, mem_global, (addrs, mem2) ->
-    mem_global = expandStore (car addrs), mem2
-    createFunction (car addrs), (values, mem, kont) ->
-      if (eq arity, (length values))
-        value values, mem, kont
-      else
-        throw new LispInterpreterError "Wrong arity for #{name}"
-
-#  ___      _ _   _ _ _         _   _
-# |_ _|_ _ (_) |_(_) (_)_____ _| |_(_)___ _ _
-#  | || ' \| |  _| | | |_ / _` |  _| / _ \ ' \
-# |___|_||_|_|\__|_|_|_/__\__,_|\__|_\___/_||_|
-#
-
-
-defInitial "#t", createBoolean true
-defInitial "#f", createBoolean false
-defInitial "nil", null
-
-defPrimitive "<=", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber)
-    kont (createBoolean (((car values) sValue) <= ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Comparison requires numbers"
-
-defPrimitive "<", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber)
-    kont (createBoolean (((car values) sValue) < ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Comparison requires numbers"
-
-defPrimitive ">=", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber)
-    kont (createBoolean (((car values) sValue) >= ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Comparison requires numbers"
-
-defPrimitive ">", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber)
-    kont (createBoolean (((car values) sValue) > ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Comparison requires numbers"
-
-defPrimitive "=", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sType), sNumber)
-    kont (createBoolean (((car values) sValue) == ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Comparison requires numbers"
-
-defPrimitive "*", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber)
-    kont (createNumber (((car values) sValue) * ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Multiplication requires numbers"
-
-defPrimitive "+", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sType), sNumber)
-    kont (createNumber (((car values) sValue) + ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Addition requires numbers"
-
-defPrimitive "/", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber)
-    kont (createNumber (((car values) sValue) / ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Division requires numbers"
-
-defPrimitive "*", 2, (values, mem, kont) ->
-  if (eq ((car values) sType), sNumber) and (eq ((cadr values) sName), sNumber)
-    kont (createNumber (((car values) sValue) - ((cadr values) sValue))), mem
-  else
-    throw new LispInterpreterError "Subtraction requires numbers"
-
-defPrimitive "cons", 2, (values, mem, kont) ->
-  allocatePair (car values), (cadr values), mem, kont
-
-defPrimitive "car", 1, (values, mem, kont) ->
-  if (eq ((car values) sType) sPair)
-    kont (mem ((car values) sCar)), mem
-  else
-    throw new LispInterpreterError "Not a pair"
-
-defPrimitive "cdr", 1, (values, mem, kont) ->
-  if (eq ((car values) sType) sPair)
-    kont (mem ((car values) sCdr)), mem
-  else
-    throw new LispInterpreterError "Not a pair"
-
-defPrimitive "setcdr", 2, (values, mem, kont) ->
-  if (eq ((car values) sType) sPair)
-    pair = (car values)
-    kont pair, ((pair sSetCdr) mem, (cadr values))
-  else
-    throw new LispInterpreterError "Not a pair"
-
-defPrimitive "setcar", 2, (values, mem, kont) ->
-  if (eq ((car values) sType) sPair)
-    pair = (car values)
-    kont pair, ((pair sSetCar) mem, (cadr values))
-  else
-    throw new LispInterpreterError "Not a pair"
-
-defPrimitive "eq?", 2, (values, mem, kont) ->
-  kont createBoolean (
-    if (eq ((car values) sType), ((cadr values) sType))
-      switch ((car values) sType)
-        when sBoolean
-          ((car values) sBoolify) (((cadr values) sBoolify) true, false), (((cadr values) sBoolify) false, true)
-        when sSymbol
-          eq ((car values) sName), ((cadr values) sName)
-        when sPair
-          (((car values) sCar) == ((cadr values) sCar) and
-           ((car values) sCdr) == ((cadr values) sCdr))
-        when sFunction
-          ((car values) sTag) == ((cadr values) sTag)
-        else false
-    else false)
-
-defPrimitive "eqv?", 2, (values, mem, kont) ->
-  kont createBoolean (
-    if (eq ((car values) sType), ((cadr values) sType))
-      switch ((car values) sType)
-        when sBoolean
-          ((car values) sBoolify) (((cadr values) sBoolify) true, false), (((cadr values) sBoolify) false, true)
-        when sSymbol
-          eq ((car values) sName), ((cadr values) sName)
-        when sNumber
-          ((car values) sValue) == ((cadr values) sValue)
-        when sPair
-          (((car values) sCar) == ((cadr values) sCar) and
-           ((car values) sCdr) == ((cadr values) sCdr))
-        when sFunction
-          ((car values) sTag) == ((cadr values) sTag)
-        else false
-    else false)
-
-module.exports = (ast, kont) ->
-  evaluate ast, env_global, mem_global, (value, mem) ->
-    kont (transcodeBack value, mem)

chapter4/reader.coffee

@@ -1,204 +0,0 @@
-{car, cdr, cons, nil, nilp, pairp, vectorToList, list} = require 'cons-lists/lists'
-{inspect} = require "util"
-{Node, Comment, Symbol} = require "../chapter1/reader_types"
-
-NEWLINES   = ["\n", "\r", "\x0B", "\x0C"]
-WHITESPACE = [" ", "\t"].concat(NEWLINES)
-
-EOF = new (class Eof)()
-EOO = new (class Eoo)()
-
-class Source
-  constructor: (@inStream) ->
-    @index = 0
-    @max = @inStream.length - 1
-    @line = 0
-    @column = 0
-
-  peek: -> @inStream[@index]
-
-  position: -> [@line, @column]
-
-  next: ->
-    c = @peek()
-    return EOF if @done()
-    @index++
-    [@line, @column] = if @peek() in NEWLINES then [@line + 1, 0] else [@line, @column + 1]
-    c
-
-  done: -> @index > @max
-
-# IO -> IO
-skipWS = (inStream) ->
-  while inStream.peek() in WHITESPACE then inStream.next()
-
-# msg -> (IO -> Node => Error)
-handleError = (message) ->
-  (line, column) -> new Node('error', message, line, column)
-
-# IO -> Node => Comment
-readComment = (inStream) ->
-  [line, column] = inStream.position()
-  r = (while inStream.peek() != "\n" and not inStream.done()
-    inStream.next()).join("")
-  if not inStream.done()
-    inStream.next()
-  new Node 'comment', (new Comment r), line, column
-
-# IO -> (Node => Literal => String) | Error
-readString = (inStream) ->
-  [line, column] = inStream.position()
-  inStream.next()
-  string = until inStream.peek() == '"' or inStream.done()
-    if inStream.peek() == '\\'
-      inStream.next()
-    inStream.next()
-  if inStream.done()
-    return handleError("end of file seen before end of string.")(line, column)
-  inStream.next()
-  new Node 'string', (string.join ''), line, column
-
-# (String) -> (Node => Literal => Number) | Nothing
-readMaybeNumber = (symbol) ->
-  if symbol[0] == '+'
-    return readMaybeNumber symbol.substr(1)
-  if symbol[0] == '-'
-    ret = readMaybeNumber symbol.substr(1)
-    return if ret? then -1 * ret else undefined
-  if symbol.search(/^0x[0-9a-fA-F]+$/) > -1
-    return parseInt(symbol, 16)
-  if symbol.search(/^0[0-9a-fA-F]+$/) > -1
-    return parseInt(symbol, 8)
-  if symbol.search(/^[0-9]+$/) > -1
-    return parseInt(symbol, 10)
-  if symbol.search(/^nil$/) > -1
-    return nil
-  undefined
-
-# (IO, macros) -> (IO, Node => Number | Symbol) | Error
-readSymbol = (inStream, tableKeys) ->
-  [line, column] = inStream.position()
-  symbol = (until (inStream.done() or inStream.peek() in tableKeys or inStream.peek() in WHITESPACE)
-    inStream.next()).join ''
-  number = readMaybeNumber symbol
-  if number?
-    return new Node 'number', number, line, column
-  new Node 'symbol', (new Symbol symbol), line, column
-
-
-# (Delim, TypeName) -> IO -> (IO, node) | Error
-makeReadPair = (delim, type) ->
-  # IO -> (IO, Node) | Error
-  (inStream) ->
-    inStream.next()
-    skipWS inStream
-    [line, column] = inStream.position()
-    if inStream.peek() == delim
-      inStream.next()
-      return new Node type, nil, line, column
-
-    # IO -> (IO, Node) | Error
-    dotted = false
-    readEachPair = (inStream) ->
-      [line, column] = inStream.position()
-      obj = read inStream, true, null, true
-      if inStream.peek() == delim
-        if dotted then return obj
-        return cons obj, nil
-      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 obj.type == 'error'
-      if obj.type == 'symbol' and obj.value == '.'
-        dotted = true
-        return readEachPair inStream
-      cons obj, readEachPair inStream
-
-    ret = new Node type, readEachPair(inStream), line, column
-    inStream.next()
-    ret
-
-# Type -> (IO -> (IO, Node))
-prefixReader = (type) ->
-  # IO -> (IO, Node)
-  (inStream) ->
-    [line, column] = inStream.position()
-    inStream.next()
-    [line1, column1] = inStream.position()
-    obj = read inStream, true, null, true
-    return obj if obj.type == 'error'
-    new Node "list", cons((new Node("symbol", (new 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
-# future revision I can vertically de-integrate these.
-
-readMacros =
-  '"': readString
-  '(': makeReadPair ')', 'list'
-  ')': handleError "Closing paren encountered"
-  '[': makeReadPair ']', 'vector'
-  ']': handleError "Closing bracket encountered"
-  '{': makeReadPair('}', 'record', (res) ->
-    res.length % 2 == 0 and true or mkerr "record key without value")
-  '}': handleError "Closing curly without corresponding opening."
-  "`": prefixReader 'back-quote'
-  "'": prefixReader 'quote'
-  ",": prefixReader 'unquote'
-  ";": readComment
-
-
-# Given a stream, reads from the stream until a single complete lisp
-# object has been found and returns the object
-
-# IO -> Form
-read = (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, inReadMacros = null, keepComments = false) ->
-  inStream = if inStream instanceof Source then inStream else new Source inStream
-  inReadMacros = if InReadMacros? then inReadMacros else readMacros
-  inReadMacroKeys = (i for i of inReadMacros)
-
-  c = inStream.peek()
-
-  # (IO, Char) -> (IO, Node) | Error
-  matcher = (inStream, c) ->
-    if inStream.done()
-      return if recursiveP then handleError('EOF while processing nested object')(inStream) else nil
-    if c in WHITESPACE
-      inStream.next()
-      return nil
-    if c == ';'
-      return readComment(inStream)
-    ret = if c in inReadMacroKeys then inReadMacros[c](inStream) else readSymbol(inStream, inReadMacroKeys)
-    skipWS inStream
-    ret
-
-  while true
-    form = matcher inStream, c
-    skip = (not nilp form) and (form.type == 'comment') and not keepComments
-    break if (not skip and not nilp form) or inStream.done()
-    c = inStream.peek()
-    null
-  form
-
-# readForms assumes that the string provided contains zero or more
-# forms.  As such, it always returns a list of zero or more forms.
-
-# IO -> (Form* | Error)
-readForms = (inStream) ->
-  inStream = if inStream instanceof Source then inStream else new Source inStream
-  return nil if inStream.done()
-
-  # IO -> (FORM*, IO) | Error
-  [line, column] = inStream.position()
-  readEach = (inStream) ->
-    obj = read inStream, true, null, false
-    return nil if (nilp obj)
-    return obj if obj.type == 'error'
-    cons obj, readEach inStream
-
-  obj = readEach inStream
-  if obj.type == 'error' then obj else new Node "list", obj, line, column
-
-exports.read = read
-exports.readForms = readForms
-exports.Node = Node
-exports.Symbol = Symbol

chapter5/interpreter5a.coffee

@@ -1,374 +0,0 @@
-{listToString, listToVector, pairp, cons, car, cdr, caar, cddr, cdar,
- cadr, caadr, cadar, caddr, nilp, nil, setcdr,
- metacadr, setcar} = require "cons-lists/lists"
-{map} = require "cons-lists/reduce"
-{length} = require "cons-lists/reduce"
-{Node, Comment, Symbol} = require '../chapter5/reader_types'
-{inspect} = require 'util'
-
-itap = (a) -> console.log inspect a, true, null, false; a
-ftap = (a) -> console.log Function.prototype.toString.call(a); a
-
-
-class Value
-  vpos = 0
-  constructor: (@v) ->
-    vpos = vpos + 1
-
-inValue = (f) ->
-  new Value(f)
-
-class LispInterpreterError extends Error
-  name: 'LispInterpreterError'
-  constructor: (@message) ->
-
-the_false_value = (cons "false", "boolean")
-
-eq = (id1, id2) ->
-  if id1 instanceof Symbol and id2 instanceof Symbol
-    return id1.name == id2.name
-  id1 == id2
-
-cadddr = metacadr('cadddr')
-
-# Hack
-gsym = (x) -> if (x instanceof Symbol) then x.name else x
-
-consp = (e) ->
-  ((pairp e) and (typeof (car e) == 'number') and
-  ((car e) > 0) and (pairp cdr e) and (typeof (cadr e) == 'number') and
-  ((cadr e) > 0) and (nilp cddr e))
-
-convert = (exp, store) ->
-  conv = (e) ->
-    if consp e
-      cons (conv (store (car e)).v), (conv (store (cadr e)).v)
-    else
-      if symbolp e then e.name
-      else if stringp e then '"' + e | '"'
-      else e
-  conv exp.v
-
-# 5.2.4
-# f[y → z] = λx . if y = x then z else f(x) endif
-# 
-# Accepts a parent function, and ID and a value.  Returns a function
-# that takes a request ID.  If the request ID equals the ID above,
-# return the value, else call the parent function with the request
-# ID.
-#
-# Calls allocate 
-
-extend = (next, id, value) ->
-  (x) -> if (eq x, id) then value else (next x)
-
-# f[y* → z*] = if #y>0 then f[y*†1 → z*†1][y*↓1 → z*↓1] else f endif
-#
-# Helper.  Builds a stack of extend() functions, at tail of which it
-# appends the parent function.
-#
-#
-lextends = (fn, ids, values) ->
-  if (pairp ids)
-    extend (lextends fn, (cdr ids), (cdr values)), (car ids), (car values)
-  else
-    fn
-
-translate = (exp, store, qont) ->
-  if (pairp exp)
-    translate (car exp), store, (val1, store1) ->
-      translate (cdr exp), store1, (val2, store2) ->
-        allocate store2, 2, (store, addrs) ->
-          qont (inValue addrs), (extend (extend store, (car addrs), val1), (cadr addrs), val2)
-  else
-    qont (inValue exp), store
-  
-# Allocate is a function that takes a store, a number of addresses to
-# allocate within that store, and a continuation; at the end, it calls
-# the continuation with the store object and the new addresses.
-        
-allocate = (->
-  loc = 0
-  (store, num, qont) ->
-    aloop = (n, a) ->
-      if (n > 0)
-        loc = loc - 1
-        aloop (n - 1), (cons loc, a)
-      else
-        qont store, a
-    aloop(num, cons()))()
-
-
-listp =     (cell) -> cell.__type == 'list'
-atomp =     (cell) -> not (cell.__type?) or (not cell.__type == 'list')
-symbolp =   (cell) -> cell instanceof Symbol
-commentp =  (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == ";"
-numberp =   (cell) -> typeof cell == 'number'
-stringp =   (cell) -> typeof cell == 'string' and cell.length > 0 and cell[0] == "\""
-boolp =     (cell) -> typeof cell == 'boolean'
-nullp =     (cell) -> cell == null
-vectorp =   (cell) -> (not straight_evaluation.listp cell) and toString.call(cell) == '[object Array]'
-recordp =   (cell) -> (not cell._prototype?) and toSTring.call(cell) == '[object Object]'
-objectp =   (cell) -> (cell._prototype?) and toString.call(cell) == '[object Object]'
-nilp =      (cell) -> nilp(cell)
-nvalu =     (cell) -> cell
-mksymbols = (cell) -> cell
-
-sBehavior = new Symbol 'behavior'
-sBoolean  = new Symbol 'boolean'
-sBoolify  = new Symbol 'boolify'
-sFunction = new Symbol 'function'
-sSymbol   = new Symbol 'symbol'
-sString   = new Symbol 'string'
-sQuote    = new Symbol 'quote'
-sLambda   = new Symbol 'lambda'
-sIf       = new Symbol 'if'
-sValue    = new Symbol 'value'
-sChars    = new Symbol 'chars'
-sBegin    = new Symbol 'begin'
-sName     = new Symbol 'name'
-sNumber   = new Symbol 'number'
-sNull     = new Symbol 'null'
-sTag      = new Symbol 'tag'
-sSet      = new Symbol 'set'
-sType     = new Symbol 'type'
-sValue    = new Symbol 'value'
-sPair     = new Symbol 'pair'
-sCar      = new Symbol 'car'
-sCdr      = new Symbol 'cdr'
-sSetCar   = new Symbol 'setcar'
-sSetCdr   = new Symbol 'setcdr'
-
-ValueToFunction = (e) ->
-  c = e.v
-  if (typeof c == 'function') then c else throw new LispInterpreterError("Not a function: " + Object.toString(c))
-
-ValueToPair = (e) ->
-  c = e.v
-  if pairp c then c else throw new LispInterpreterError("Not a pair: " + Object.toString(c))
-
-ValueToNumber = (e) ->
-  c = parseInt(e.v, 10)
-  if (typeof c == 'number') then c else throw new LispInterpreterError("Not a number: " + Object.toString(c))
-
-ValueToPrimitive = (e) ->
-  return e.v
-
-store_init = (a) -> throw new LispInterpreterError "No such address: #{a}"
-env_init = (a) -> throw new LispInterpreterError "No such variable: #{a}"  
-
-class Interpreter
-  constructor: ->
-    arity_check = (name, arity, fn) =>
-      (values, kont, store) =>
-        if not eq (length values), arity
-          throw new LispInterpreterError "Incorrect Arity for #{name}"
-        fn(values, kont, store)
-
-    @definitial "cons", inValue arity_check "cons", 2, (values, kont, store) =>
-      allocate store, 2, (store, addrs) =>
-        kont (inValue (cons (car addrs), (cadr addrs))), (lextends store, addrs, values)
-  
-    @definitial "car", inValue arity_check "car", 1, (values, kont, store) =>
-      kont (store car @valueToPair (car values)), store
-  
-    @definitial "cdr", inValue arity_check "car", 1, (values, kont, store) =>
-      kont (store cadr @valueToPair (car values)), store
-  
-    @defprimitive "pair?", ((v) -> inValue (consp v.v)), 1
-    @defprimitive "eq?", ((v1, v2) -> inValue (eq v1.v, v2.v)), 2
-    @defprimitive "symbol?", ((v) -> inValue (symbolp v.v)), 1
-  
-    @definitial "set-car!", inValue arity_check, "set-car!", 2, (values, kont, store) ->
-      kont (car values), (extend store, (car (ValueToPair (car values))), (cadr values))
-  
-    @definitial "set-cdr!", inValue arity_check, "set-cdr!", 2, (values, kont, store) ->
-      kont (car values), (extend store, (cadr (ValueToPair (car values))), (cadr values))
-
-    @defarithmetic "+",  ((x, y) -> x + y),  2
-    @defarithmetic "-",  ((x, y) -> x - y),  2
-    @defarithmetic "*",  ((x, y) -> x * y),  2
-    @defarithmetic "/",  ((x, y) -> x / y),  2
-    @defarithmetic "<",  ((x, y) -> x < y),  2
-    @defarithmetic ">",  ((x, y) -> x > y),  2
-    @defarithmetic "=",  ((x, y) -> x == y), 2
-    @defarithmetic "<=", ((x, y) -> x <= y), 2
-    @defarithmetic ">=", ((x, y) -> x >= y), 2
-    @defarithmetic "%",  ((x, y) -> x % y),  2
-  
-    @definitial "apply", arity_check "apply", 2, inValue (values, kont, store) ->
-      flat = (v) ->
-        if pairp v.v
-          cons (store (car (ValueToPair v))), (flat (store (cadr (ValueToPair v))))
-        else
-          cons()
-
-      collect = (values) ->
-        if nullp cdr values
-          flat car values
-        else
-          cons (car values), (collect cdr values)
-
-      (ValueToFunction (car values)) (collect (cdr values)), kont, store
-
-    @definitial '#t', (inValue true)
-    @definitial '#f', (inValue false)
-    @definitial 'nil', (inValue cons())
-
-    @definitial "x", inValue (new Object(null))
-    @definitial "y", inValue (new Object(null))
-    @definitial "z", inValue (new Object(null))
-    @definitial "a", inValue (new Object(null))
-    @definitial "b", inValue (new Object(null))
-    @definitial "c", inValue (new Object(null))
-    @definitial "foo", inValue (new Object(null))
-    @definitial "bar", inValue (new Object(null))
-    @definitial "hux", inValue (new Object(null))
-    @definitial "fib", inValue (new Object(null))
-    @definitial "fact", inValue (new Object(null))
-    @definitial "visit", inValue (new Object(null))
-    @definitial "length", inValue (new Object(null))
-    @definitial "filter", inValue (new Object(null))
-    @definitial "primes", inValue (new Object(null))
-
-  meaning: (e) ->
-    meaningTable =
-      "quote":  ((e) => @meaningQuotation (cadr e))
-      'lambda': ((e) => @meaningAbstraction (cadr e), (cddr e))
-      'if':     ((e) => @meaningAlternative (cadr e), (caddr e), (cadddr e))
-      'begin':  ((e) => @meaningSequence (cdr e))
-      'set!':   ((e) => @meaningAssignment (cadr e), (caddr e))
-
-    if (atomp e)
-      return if (symbolp e) then (@meaningReference gsym(e)) else (@meaningQuotation e)
-    n = gsym(car e)
-    if meaningTable[n]?
-      meaningTable[n](e)
-    else
-      @meaningApplication (car e), (cdr e)
-
-  meaningSequence: (exps) =>
-    (env, kont, store) =>
-      (@meaningsSequence exps) env, kont, store
-
-  meaningsMultipleSequence: (exp, exps) ->
-    (env, kont, store) =>
-      hkont = (values, store1) =>
-        (@meaningsSequence exps) env, kont, store1
-      (@meaning exp) env, hkont, store
-
-  meaningsSingleSequence: (exp) ->
-    (env, kont, store) =>
-      (@meaning exp) env, kont, store
-
-  meaningsSequence: (exps) ->
-    if not (pairp exps)
-      throw new LispInterpreterError("Illegal Syntax")
-    if pairp cdr exps
-      @meaningsMultipleSequence (car exps), (cdr exps)
-    else
-      @meaningsSingleSequence (car exps)
-
-  meaningQuotation: (val) ->
-    (env, kont, store) ->
-      (translate val, store, kont)
-
-  meaningReference: (name) ->
-    (env, kont, store) ->
-      kont (store (env name)), store
-
-  # Extensional alternative
-
-  meaningAlternative: (exp1, exp2, exp3) ->
-    boolify = (value) ->
-      if (eq? value (inValue false)) then ((x, y) -> y) else ((x, y) -> x)
-
-    ef = (val, val1, val2) ->
-      val val1, val2
-
-    (env, kont, store) =>
-      hkont = (val, store1) =>
-        ef (boolify val), ((@meaning exp2) env, kont, store1), ((@meaning exp3) env, kont, store1)
-      (@meaning exp1)(env, hkont, store)
-
-  # Assignment
-
-  meaningAssignment: (name, exp) ->
-    name = if name instanceof Symbol then name.name else name
-    console.log(name)
-    (env, kont, store) =>
-      hkont = (val, store1) ->
-        kont val, (extend store1, (env name), val)
-      (@meaning exp) env, hkont, store
-
-  # Abstraction (keeps a lambda)
-
-  meaningAbstraction: (names, exps) ->
-    (env, kont, store) =>
-      funcrep = (vals, kont1, store1) =>
-        if not (eq (length vals), (length names))
-          throw new LispInterpreterError("Incorrect Arity.")
-        argnamestostore = (store2, addrs) =>
-          (@meaningsSequence exps) (lextends env, names, addrs), kont1, (lextends store2, addrs, vals)
-        allocate store1, (length names), argnamestostore
-      kont (inValue funcrep), store
-
-  meaningVariable: (name) ->
-    (m) ->
-      (vals, env, kont, store) ->
-        allocate store, 1, (store, addrs) ->
-          addr = (car addrs)
-          m (cdr vals), (extend env, names, addr), kont, (extend store, addr, (car vals))
-
-  meaningApplication: (exp, exps) ->
-    (env, kont, store) =>
-      hkont = (func, store1) =>
-        kont2 = (values, store2) ->
-          (ValueToFunction func) values, kont, store2
-        (@meanings exps) env, kont2, store1
-      (@meaning exp) env, hkont, store
-
-  meanings: (exps) =>
-    meaningSomeArguments = (exp, exps) =>
-      (env, kont, store) =>
-        hkont = (value, store1) =>
-          hkont2 = (values, store2) ->
-            kont (cons value, values), store2
-          (@meanings exps) env, hkont2, store1
-        (@meaning exp) env, hkont, store
-
-    meaningNoArguments = ->
-      (env, kont, store) ->
-        kont (cons()), store
-
-    if pairp exps
-      meaningSomeArguments (car exps), (cdr exps)
-    else
-      meaningNoArguments()
-
-  definitial: (name, value) ->
-    allocate store_init, 1, (store, addrs) ->
-      env_init = extend env_init, name, (car addrs)
-      store_init = extend store, (car addrs), value
-      name
-
-  defprimitive: (name, value, arity) ->
-    callable = (values, kont, store) =>
-      if not eq arity, (length values)
-        throw new LispInterpreterError "Incorrect Arity for #{name}"
-      kont (value.apply(null, listToVector(values))), store
-    @definitial name, (inValue callable)
-
-  defarithmetic: (name, value, arity) ->
-    callable = (values, kont, store) ->
-      if not eq arity, (length values)
-        throw new LispInterpreterError "Incorrect Arity for #{name}"
-      kont (inValue (value.apply(null, listToVector(map values, ValueToNumber)))), store
-    @definitial name, (inValue callable)
-
-module.exports = (ast, kont) ->
-  interpreter = new Interpreter()
-  store_current = store_init
-  (interpreter.meaning ast)(env_init,
-    ((value, store_final) -> kont (convert value, store_final)), store_current)
-

chapter5/reader.coffee

@@ -1,170 +0,0 @@
-{car, cdr, cons, nil, nilp, pairp, vectorToList, list} = require 'cons-lists/lists'
-{inspect} = require "util"
-{Comment, Symbol} = require "../chapter5/reader_types"
-
-NEWLINES   = ["\n", "\r", "\x0B", "\x0C"]
-WHITESPACE = [" ", "\t"].concat(NEWLINES)
-
-EOF = new (class Eof)()
-EOO = new (class Eoo)()
-
-class ReadError extends Error
-  name: 'LispInterpreterError'
-  constructor: (@message) ->
-
-class Source
-  constructor: (@inStream) ->
-    @index = 0
-    @max = @inStream.length - 1
-    @line = 0
-    @column = 0
-
-  peek: -> @inStream[@index]
-
-  position: -> [@line, @column]
-
-  next: ->
-    c = @peek()
-    return EOF if @done()
-    @index++
-    [@line, @column] = if @peek() in NEWLINES then [@line + 1, 0] else [@line, @column + 1]
-    c
-
-  done: -> @index > @max
-
-# IO -> IO
-skipWS = (inStream) ->
-  while inStream.peek() in WHITESPACE then inStream.next()
-
-readMaybeNumber = (symbol) ->
-  if symbol[0] == '+'
-    return readMaybeNumber symbol.substr(1)
-  if symbol[0] == '-'
-    ret = readMaybeNumber symbol.substr(1)
-    return if ret? then -1 * ret else undefined
-  if symbol.search(/^0x[0-9a-fA-F]+$/) > -1
-    return parseInt(symbol, 16)
-  if symbol.search(/^0[0-9a-fA-F]+$/) > -1
-    return parseInt(symbol, 8)
-  if symbol.search(/^[0-9]+$/) > -1
-    return parseInt(symbol, 10)
-  if symbol.search(/^nil$/) > -1
-    return nil
-  undefined
-
-# (Delim, TypeName) -> IO -> (IO, Node) | Errorfor
-makeReadPair = (delim, type) ->
-  # IO -> (IO, Node) | Error
-  (inStream) ->
-    inStream.next()
-    skipWS inStream
-    if inStream.peek() == delim
-      inStream.next() unless inStream.done()
-      return if type then cons((new Symbol type), nil) else nil
-
-    # IO -> (IO, Node) | Error
-    dotted = false
-    readEachPair = (inStream) =>
-      obj = @read inStream, true, null, true
-      if inStream.peek() == delim
-        if dotted then return obj
-        return cons obj, nil
-      return obj if obj instanceof ReadError
-      if inStream.done() then return new ReadError "Unexpected end of input"
-      if dotted then return new ReadError "More than one symbol after dot in list"
-      if @acc(obj) instanceof Symbol and @acc(obj).name == '.'
-        dotted = true
-        return readEachPair inStream
-      cons obj, readEachPair inStream
-
-    obj = readEachPair(inStream)
-    inStream.next()
-    if type then cons((new Symbol type), obj) else obj
-
-# Type -> IO -> IO, Node
-
-class Reader
-  prefixReader = (type) ->
-    # IO -> IO, Node
-    (inStream) ->
-      inStream.next()
-      obj = @read inStream, true, null, true
-      return obj if obj instanceof ReadError
-      list((new Symbol type), obj)
-
-  "acc": (obj) -> obj
-
-  "symbol": (inStream) ->
-    symbol = (until (inStream.done() or @[inStream.peek()]? or inStream.peek() in WHITESPACE)
-      inStream.next()).join ''
-    number = readMaybeNumber symbol
-    if number?
-      return number
-    new Symbol symbol
-
-  "read": (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, keepComments = false) ->
-    inStream = if inStream instanceof Source then inStream else new Source inStream
-
-    c = inStream.peek()
-
-    # (IO, Char) -> (IO, Node) | Error
-    matcher = (inStream, c) =>
-      if inStream.done()
-        return if recursiveP then (new ReadError 'EOF while processing nested object') else nil
-      if c in WHITESPACE
-        inStream.next()
-        return nil
-      if c == ';'
-        return readComment(inStream)
-      ret = if @[c]? then @[c](inStream) else @symbol(inStream)
-      skipWS inStream
-      ret
-
-    while true
-      form = matcher inStream, c
-      skip = (not nilp form) and (form instanceof Comment) and not keepComments
-      break if (not skip and not nilp form) or inStream.done()
-      c = inStream.peek()
-      null
-    form
-
-  '(': makeReadPair ')', null
-
-  '[': makeReadPair ']', 'vector'
-
-  '{': makeReadPair('}', 'record', (res) ->
-    res.length % 2 == 0 and true or mkerr "record key without value")
-
-  '"': (inStream) ->
-    inStream.next()
-    s = until inStream.peek() == '"' or inStream.done()
-      if inStream.peek() == '\\'
-        inStream.next()
-      inStream.next()
-    return (new ReadError "end of file seen before end of string") if inStream.done()
-    inStream.next()
-    s.join ''
-
-  ')': (inStream) -> new ReadError "Closing paren encountered"
-
-  ']': (inStream) -> new ReadError "Closing bracket encountered"
-
-  '}': (inStream) -> new ReadError "Closing curly without corresponding opening."
-
-  "`": prefixReader 'back-quote'
-
-  "'": prefixReader 'quote'
-
-  ",": prefixReader 'unquote'
-
-  ";": (inStream) ->
-    r = (while inStream.peek() != "\n" and not inStream.done()
-      inStream.next()).join("")
-    inStream.next() if not inStream.done()
-    new Comment r
-
-exports.Source = Source
-exports.ReadError = ReadError
-exports.Reader = Reader
-reader = new Reader()
-exports.read = -> reader.read.apply(reader, arguments)

chapter5/reader_rawtoform.coffee

@@ -1,39 +0,0 @@
-{car, cdr, cons, listp, nilp, nil,
- list, pairp, listToString} = require 'cons-lists/lists'
-
-{Symbol, Comment} = require './reader_types'
-
-class Normalize
-  normalize: (form) ->
-    return nil if nilp form
-
-    if (pairp form)
-      if (car form) instanceof Symbol and (car form).name in ['vector', 'record']
-        @[(car form).name](cdr form)
-      else
-        @list form
-    else
-      form
-
-  list: (form) ->
-    handle = (form) =>
-      return nil if nilp form
-      if not pairp form
-        return @normalize form
-      cons (@normalize car form), (handle cdr form)
-    handle form
-
-  vector: (form) ->
-    until (nilp form) then p = @normalize(car form); form = cdr form; p
-
-  record: (form) ->
-    o = Object.create(null)
-    until (nilp form)
-      o[(@normalize car form)] = (@normalize car cdr form)
-      form = cdr cdr form
-      null
-    o
-
-exports.Normalize = Normalize
-normalize = new Normalize()
-exports.normalize = -> normalize.normalize.apply(normalize, arguments)

chapter5/reader_tracktoform.coffee

@@ -1,14 +0,0 @@
-{Node} = require './reader_types'
-{Normalize} = require './reader_rawtoform'
-
-liftToNode = (f) ->
-  (form) ->
-    return f.call this, (if (form instanceof Node) then form.v else form)
-
-NodeNormalize = class
-for own key, func of Normalize::
-  NodeNormalize::[key] = liftToNode(func)
-
-exports.Normalize = NodeNormalize
-normalize = new NodeNormalize()
-exports.normalize = -> normalize.normalize.apply(normalize, arguments)

chapter5/reader_types.coffee

@@ -1,11 +0,0 @@
-exports.Node = class
-  constructor: (@v, @line, @column) ->
-
-exports.Symbol = class
-  constructor: (@name) ->
-    
-exports.Comment = class
-  constructor: (@text) ->
-
-
-          

chapter5/tracking_reader.coffee

@@ -1,25 +0,0 @@
-{Reader, ReadError, Source} = require './reader'
-{Node} = require './reader_types'
-
-liftToTrack = (f) ->
-  (ioStream) ->
-    ioStream = if ioStream instanceof Source then ioStream else new Source ioStream
-    [line, column] = ioStream.position()
-    obj = f.apply(this, arguments)
-    if obj instanceof ReadError
-      obj['line'] = line
-      obj['column'] = column
-      return obj
-    if obj instanceof Node then obj else new Node obj, line, column
-
-TrackingReader = class
-
-for own key, func of Reader::
-  TrackingReader::[key] = liftToTrack(func)
-TrackingReader::acc = (obj) -> obj.v
-
-exports.ReadError = ReadError
-exports.Reader = TrackingReader
-exports.reader = reader = new TrackingReader()
-exports.read = -> reader.read.apply(reader, arguments)
-

coffeelint.json

@@ -1,129 +0,0 @@
-{
-  "arrow_spacing": {
-    "level": "ignore"
-  },
-  "braces_spacing": {
-    "level": "ignore",
-    "spaces": 0,
-    "empty_object_spaces": 0
-  },
-  "camel_case_classes": {
-    "level": "error"
-  },
-  "coffeescript_error": {
-    "level": "error"
-  },
-  "colon_assignment_spacing": {
-    "level": "ignore",
-    "spacing": {
-      "left": 0,
-      "right": 0
-    }
-  },
-  "cyclomatic_complexity": {
-    "value": 10,
-    "level": "ignore"
-  },
-  "duplicate_key": {
-    "level": "error"
-  },
-  "empty_constructor_needs_parens": {
-    "level": "ignore"
-  },
-  "ensure_comprehensions": {
-    "level": "warn"
-  },
-  "eol_last": {
-    "level": "ignore"
-  },
-  "indentation": {
-    "value": 2,
-    "level": "error"
-  },
-  "line_endings": {
-    "level": "ignore",
-    "value": "unix"
-  },
-  "max_line_length": {
-    "value": 120,
-    "level": "error",
-    "limitComments": true
-  },
-  "missing_fat_arrows": {
-    "level": "ignore",
-    "is_strict": false
-  },
-  "newlines_after_classes": {
-    "value": 3,
-    "level": "ignore"
-  },
-  "no_backticks": {
-    "level": "error"
-  },
-  "no_debugger": {
-    "level": "warn",
-    "console": false
-  },
-  "no_empty_functions": {
-    "level": "ignore"
-  },
-  "no_empty_param_list": {
-    "level": "ignore"
-  },
-  "no_implicit_braces": {
-    "level": "ignore",
-    "strict": true
-  },
-  "no_implicit_parens": {
-    "strict": true,
-    "level": "ignore"
-  },
-  "no_interpolation_in_single_quotes": {
-    "level": "ignore"
-  },
-  "no_plusplus": {
-    "level": "ignore"
-  },
-  "no_stand_alone_at": {
-    "level": "ignore"
-  },
-  "no_tabs": {
-    "level": "error"
-  },
-  "no_this": {
-    "level": "ignore"
-  },
-  "no_throwing_strings": {
-    "level": "error"
-  },
-  "no_trailing_semicolons": {
-    "level": "error"
-  },
-  "no_trailing_whitespace": {
-    "level": "error",
-    "allowed_in_comments": false,
-    "allowed_in_empty_lines": true
-  },
-  "no_unnecessary_double_quotes": {
-    "level": "ignore"
-  },
-  "no_unnecessary_fat_arrows": {
-    "level": "warn"
-  },
-  "non_empty_constructor_needs_parens": {
-    "level": "ignore"
-  },
-  "prefer_english_operator": {
-    "level": "ignore",
-    "doubleNotLevel": "ignore"
-  },
-  "space_operators": {
-    "level": "ignore"
-  },
-  "spacing_after_comma": {
-    "level": "ignore"
-  },
-  "transform_messes_up_line_numbers": {
-    "level": "warn"
-  }
-}

docs/20150607.md

@@ -1,67 +0,0 @@
-I've been working my way through a Lisp textbook, *Lisp In Small
-Pieces*, by Christian Quinnec.  It was originally written in French and
-is not that well known among English-speaking Lisperati, not in
-comparison to the Wizard book or Paul Graham's *On Lisp*, but what
-caught my attention was how it really was in *small* pieces.  Each
-chapter ended with an interpreter described, sometimes in code,
-sometimes in text; if you were smart enough, you could actually piece
-the whole thing together and see how it worked.
-
-I decided to make things hard for myself.  Since I'm *not* a Lisperati
-(although I may well and truly be seduced by Hy), I decided to make
-things hard for myself by writing the interpreter in Coffeescript.  Most
-Lisp books assume you have a Lisp handy, and Quinnec's examples are fine
-and dandy on many variants of Scheme, but for a fun time I decided to
-write it in something else.  Raganwald claims Javascript "is a Lisp,"
-and if that's so it ought to be good enough to write a Lisp in it.
-
-I mean, it's obviously been done before.  I tried once before but got
-lost.  *LiSP* does me the favor of keeping me on track.
-
-You can see all my sourcecode at <a
-href="https://github.com/elfsternberg/LispInSmallPieces">Github: Lisp In
-Small Pieces</a>.
-
-Chapter 1 contains the base interpreter.  It also contains a
-hand-written Lisp reader, and refers to another project I have on
-GitHub, <a
-href="https://github.com/elfsternberg/cons-lists">cons-lists</a>, which
-is exactly what it sounds like, a singly-linked list implementation in
-Javascript, using nested Javascript arrays as the base.  The base
-interpreter is very primitive-- you can't even create new variable names
-in the global namespace!  Although you can shadow them using lambdas, so
-it's pretty much bog standard Lambda Calculus.
-
-Chapter "Lambda 1" contains a continuation-passing variant of the
-interpreter from Chapter 1.  It's basically a facile reading of
-Lisperator's λ-language intepreter, with my own parser front-end and
-some CPS style.  It passes all the tests, but it's a distraction.
-
-Chapter 3 contains the same interpreter, only using the architecture
-Quinnec describes in Chapter 3 of his book.
-
-Chapter 2 describes a number of different methodologies for binding,
-scoping, and namespaces.  The material is interesting but I didn't
-pursue writing the various interpreters.  I "got" what Quinnec was
-saying, and if I'm ever interested in writing something with scoping
-rules outside of the lexical scopes with which I'm familiar, I might
-revisit the material.
-
-The next step will be to add functions to the Chapter 3 interpreter to
-do the various continuation management games, like call/cc, throw/catch,
-$and so forth.  Because *those*, I feel I need to understand.
-
-How far will I take this project?  I’m not sure.  Chapter 4 is
-"Assignment and Side Effects," so I’ll do that.  Chapter 5 is theory,
-and 6 implementation, of a "fast interpreter" of the kind French
-programming language guys apparently love to study.  I’ll read them, but
-I’m not sure what code I’ll generate out of that.  Chapter 7,
-"Compilation," is interesting in that he starts by defining a VM that on
-top of which our bytecode will run, and implement both the VM and the
-compiler in Scheme.  I think I want to do that chapter, and then
-re-write the compiler to create LLVM-compatible code instead, just to
-learn LLVM.  Chapter 8 implements EVAL, chapter 9 has Macros, and
-chapter 10 has Object-Oriented Lisp.  So I’ll probably do those as well.
-
-And then... we’ll see.  I surprised myself by doing Chapter 3 in less
-than two weeks.

docs/new.md

@@ -1,12 +0,0 @@
-This doesn't really look like the read/analyze/compile passes that one
-expects of a modern Lisp.
-
-Reading converts the source code into a list of immutable values in the
-low-level AST of the system.  Reading and analysis must be combined if
-there are to be reader macros (which I want to support).
-
-... and then a miracle occurs ...
-
-Compilation is the process of turning the AST into javascript.
-
-

extras/jenkins_config.xml

@@ -1,57 +0,0 @@
-<?xml version='1.0' encoding='UTF-8'?>
-<project>
-  <actions/>
-  <description>Building in the chapters of Lisp In Small Pieces.</description>
-  <logRotator class="hudson.tasks.LogRotator">
-    <daysToKeep>-1</daysToKeep>
-    <numToKeep>10</numToKeep>
-    <artifactDaysToKeep>-1</artifactDaysToKeep>
-    <artifactNumToKeep>-1</artifactNumToKeep>
-  </logRotator>
-  <keepDependencies>false</keepDependencies>
-  <properties/>
-  <scm class="hudson.plugins.git.GitSCM" plugin="git@2.3.4">
-    <configVersion>2</configVersion>
-    <userRemoteConfigs>
-      <hudson.plugins.git.UserRemoteConfig>
-        <url>file:///home/elf/Projects/LispInSmallPieces</url>
-      </hudson.plugins.git.UserRemoteConfig>
-    </userRemoteConfigs>
-    <branches>
-      <hudson.plugins.git.BranchSpec>
-        <name>*/master</name>
-      </hudson.plugins.git.BranchSpec>
-    </branches>
-    <doGenerateSubmoduleConfigurations>false</doGenerateSubmoduleConfigurations>
-    <submoduleCfg class="list"/>
-    <extensions/>
-  </scm>
-  <canRoam>true</canRoam>
-  <disabled>false</disabled>
-  <blockBuildWhenDownstreamBuilding>false</blockBuildWhenDownstreamBuilding>
-  <blockBuildWhenUpstreamBuilding>false</blockBuildWhenUpstreamBuilding>
-  <triggers>
-    <org.jenkinsci.plugins.fstrigger.triggers.FolderContentTrigger plugin="fstrigger@0.39">
-      <spec></spec>
-      <path>file:///home/elf/Projects/LispInSmallPieces</path>
-      <excludeCheckLastModificationDate>false</excludeCheckLastModificationDate>
-      <excludeCheckContent>false</excludeCheckContent>
-      <excludeCheckFewerOrMoreFiles>false</excludeCheckFewerOrMoreFiles>
-    </org.jenkinsci.plugins.fstrigger.triggers.FolderContentTrigger>
-  </triggers>
-  <concurrentBuild>false</concurrentBuild>
-  <builders>
-    <hudson.tasks.Shell>
-      <command>make node_modules test</command>
-    </hudson.tasks.Shell>
-  </builders>
-  <publishers>
-    <hudson.tasks.junit.JUnitResultArchiver plugin="junit@1.2-beta-4">
-      <testResults>test-reports.xml</testResults>
-      <keepLongStdio>false</keepLongStdio>
-      <testDataPublishers/>
-      <healthScaleFactor>1.0</healthScaleFactor>
-    </hudson.tasks.junit.JUnitResultArchiver>
-  </publishers>
-  <buildWrappers/>
-</project>

package.json

@@ -1,5 +1,5 @@
 {
-  "name": "LispInSmallPieces",
+  "name": "CoffeeLisp",
   "version": "0.0.1",
   "description": "A Coffeescript rendition of Lisp In Small Pieces",
   "main": "bin/lisp",
@@ -8,21 +8,13 @@
     "cons-lists": "git+https://github.com/elfsternberg/cons-lists.git"
   },
   "devDependencies": {
-    "coffeelint": "~1.10.0",
     "chai": "^2.0.0",
-    "mocha": "^2.1.0",
+    "mocha": "^2.1.0"
-    "mocha-jenkins-reporter": "^0.1.7"
   },
   "scripts": {
-    "test": "make test",
+    "test": "echo \"Error: no test specified\" && exit 1"
-    "build": "make node_modules"
-  },
-  "repository": {
-    "type": "git",
-    "url": "ssh://elfsternberg@elfsternberg.com/home/elfsternberg/repos/LispInSmallPieces"
   },
   "keywords": [
-    "lisp",
     "scheme",
     "practice",
     "interpreter",

racket/chap1.rkt

@@ -0,0 +1,192 @@
+; Lisp In Small Pieces, chapter 1 Simple Lambda Calculus interpreter
+; with global environment, simple lexical closures enforced by singly
+; linked lists.
+
+; This covers only severals exercise: I added 'exit as an exit value;
+; I fixed the definition of '<', and then applied the exercise out of 
+; the book.
+
+; Any of the exercises that needed call/cc I've avoided for the simple
+; reason that I started this to learn lisp, I'm a raw beginner, and 
+; call/cc is definitely advance estorics.
+
+; Needed for 'wrong-syntax', which is Racket's version of the "wrong"
+; exception tosser.
+
+(require racket/syntax)
+
+; LISP requires a mutatable environment, so using mcons/mpair for
+; that.
+
+(require scheme/mpair)
+
+; Weird; racket needs this as a patch.  I would have expected it as
+; present in the default list of functions!
+
+(define (atom? x)
+  (and (not (null? x))
+       (not (pair? x))))
+
+(define env_init '())
+
+(define env_global env_init)
+
+; So, this macro places *into the current scope* (i.e. no building of
+; a new scope that gets reaped upon exit) the names of variables and
+; potential initial values.
+
+(define-syntax definitial
+  (syntax-rules ()
+    ((definitial name)
+     (begin (set! env_global (mcons (mcons 'name 'void) env_global)) 'name))
+    ((definitial name value)
+     (begin (set! env_global (mcons (mcons 'name value) env_global)) 'name))))
+
+; Oh! This macro (same scope thing again) associates named things with
+; values in the target environment (the host language), along with
+; arity checking.  (which it doesn't do for 'if', for example)
+
+(define-syntax defprimitive
+  (syntax-rules ()
+    ((defprimitive name value arity)
+     (definitial name 
+       (lambda (values)
+         (if (= arity (length values))
+             (apply value values)
+             (wrong-syntax #'here "Incorrect arity ~s" (list 'name values))))))))
+
+; Sometimes, you do have to define something before you use it. Lesson
+; learned.
+
+(define the-false-value (cons "false" "boolean"))
+
+(definitial t #t)
+(definitial f the-false-value)
+(definitial nil '())
+(definitial foo)
+(definitial bar)
+(definitial fib)
+(definitial fact)
+
+(define-syntax defpredicate
+  (syntax-rules ()
+    ((_ name native arity)
+     (defprimitive name (lambda args (or (apply native args) the-false-value)) arity))))
+
+(defprimitive cons cons 2)
+(defprimitive car car 1)
+(defprimitive set-cdr! set-mcdr! 2)
+(defprimitive + + 2)
+(defprimitive - - 2)
+(defprimitive * * 2)
+(defpredicate lt < 2)
+(defpredicate eq? eq? 2)
+
+; This function extends the environment so that *at this moment of
+; extension* the conslist head points to the old environment, then
+; when it's done it points to the new environment.  What's interesting
+; is that the conslist head points to the last object initialized, not
+; the first.
+
+(define (extend env variables values) 
+  (cond ((pair? variables)
+         (if (pair? values) 
+             (mcons (mcons (car variables) (car values))
+                    (extend env (cdr variables) (cdr values)))
+             (wrong-syntax #'here "Too few values")))
+        ((null? variables)
+         (if (null? values) 
+             env 
+             (wrong-syntax #'here "Too many values")))
+        ((symbol? variables) (mcons (mcons variables values) env))))
+                         
+; Already we're starting to get some scope here.  Note that
+; make-function provides the environment, not the invoke.  This makes
+; this a lexically scoped interpreter.
+
+(define (make-function variables body env) 
+  (lambda (values) 
+    (eprogn body (extend env variables values))))
+
+; if it's a function, invoke it.  Wow. Much complex. Very interpret.
+
+(define (invoke fn args) 
+  (if (procedure? fn)
+      (fn args)
+      (wrong-syntax #'here "Not an function ~s" fn)))
+
+; Iterate through the exps, return the value of the last one.
+
+(define (eprogn  exps env)
+  (if (pair? exps)
+      (if (pair? (cdr exps))
+          (begin (evaluate (car exps) env)
+                 (eprogn (cdr exps) env))
+          (evaluate (car exps) env))
+      '()))
+  
+; Iterate through the exps, return a list of the values of the
+; evaluated expressions
+
+(define (evlis exps env)
+  (if (pair? exps) 
+      (cons (evaluate (car exps) env)
+            (evlis (cdr exps) env))
+      '()))
+
+; silly patch because of the mutatable lists
+
+(define-syntax mcaar (syntax-rules () ((_ e) (mcar (mcar e)))))
+(define-syntax mcdar (syntax-rules () ((_ e) (mcdr (mcar e)))))
+
+; Iterate through the environment, find an ID, return its associated
+; value.
+
+(define (lookup id env)
+  (if (mpair? env)
+      (if (eq? (mcaar env) id)
+          (mcdar env)
+          (lookup id (mcdr env)))
+      (wrong-syntax #'here "No such binding ~s" id)))
+
+; Iterate through the environment, find an ID, and change its value to
+; the new value.  Again, purely global environment.  Really starting
+; to grok how the environment "stack" empowers modern runtimes.
+
+(define (update! id env value)
+  (if (mpair? env)
+      (if (eq? (mcaar env) id)
+          (begin (set-mcdr! (mcar env) value) value)
+          (update! id (mcdr env) value))
+      (wrong-syntax #'here "No such binding ~s" id)))
+
+; Core evaluation rules.
+
+(define (evaluate exp env)
+  (if (atom? exp)
+      (cond 
+       ((symbol? exp) (lookup exp env))
+       ((or (number? exp) (string? exp) (char? exp) (boolean? exp) (vector? exp)) exp)
+       (else (wrong-syntax #'here "Cannot evaluate")))
+      (case (car exp)
+        ((quote) (cadr exp))
+        ; Note: No checks that the statement even vaguely resembles the rules.
+        ((if) (if (not (eq? (evaluate (cadr exp) env) the-false-value))
+                  (evaluate (caddr exp) env)
+                  (evaluate (cadddr exp) env)))
+        ((begin) (eprogn (cdr exp) env))
+        ((set!) (update! (cadr exp) env (evaluate (caddr exp) env)))
+        ((lambda) (make-function (cadr exp) (cddr exp) env))
+        (else (invoke (evaluate (car exp) env) (evlis (cdr exp) env))))))
+
+; Run it.  Note that the function toplevel is self-referential.
+
+(define (chapter1-scheme)
+  (define (toplevel)
+    (let ((result (evaluate (read) env_global)))
+      (if (not (eq? result 'exit))
+          (begin (display result) (toplevel))
+          #f)))
+  (toplevel))
+
+; (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1))))))

racket/chap3.rkt

@@ -0,0 +1,10 @@
+(define (find-symbol id tree)
+  (call/cc
+   (lambda (exit) 
+     (define (find tree)
+       (if (pair? tree)
+           (or (find (car tree)) (find (cdr tree)))
+           (if (eq? tree id) (exit #t) #f)))
+     (find tree))))
+           
+       

src/eval.coffee

@@ -0,0 +1,17 @@
+lookup = require './lookup'
+{car, cdr, cadr, caadr, cdadr} = require './lists'
+
+lispeval = (element, scope) ->
+
+  switch (car element)
+    when 'number' then parseInt (cadr element), 10
+    when 'string' then (cadr element)
+    when 'symbol' then lookup scope, (cadr element)
+    when 'list'
+      proc = lispeval (caadr element), scope
+      args = cdadr element
+      proc args, scope
+    else throw new Error ("Unrecognized type in parse: #{(car element)}")
+
+module.exports = lispeval
+

src/fn.coffee

@@ -0,0 +1,43 @@
+lispeval = require './eval'
+{cons, nil, nilp, car, cdr, listToVector} = require './lists'
+
+module.exports = 
+  create_vm_expression_evaluator: (defining_scope, params, body) ->
+    (cells, scope) ->
+      args = (amap = (cells, accum) ->
+        return accum if nilp cells
+        amap((cdr cells), accum.concat(lispeval (car cells), scope)))(cells, [])
+      body.apply null, args
+
+  create_lisp_expression_evaluator: (defining_scope, params, body) ->
+    (cells, scope) ->
+
+      # Takes the current scope, which has been passed in during the
+      # execution phase, and evaluate the contents of the parameters
+      # in the context in which this call is made (i.e. when the
+      # function is *called*, rather than defined.
+
+      new_scope = (cmap = (cells, params, nscope) ->
+        return nscope if (nilp cells) or (nilp params)
+        nscope[(car params)] = lispeval (car cells), scope
+        cmap((cdr cells), (cdr params), nscope))(cells, params, {})
+
+      # Execute and evaluate the body, creating an inner scope that
+      # consists of: (1) the bound variables (the parameters)
+      # evaluated in the context of the function call, because that's
+      # where they were encountered (2) the free variables evaluated
+      # in the context of the defining scope, because that's where
+      # *they* were encountered.
+      #
+      # While this inspiration comes from Coglan, the clearest
+      # explanation is from Lisperator's 'make_lambda' paragraph at
+      # http://lisperator.net/pltut/eval1/
+
+      inner_scope = cons(new_scope, defining_scope)
+      (nval = (body, memo) ->
+        return memo if nilp body
+        nval((cdr body), lispeval((car body), inner_scope)))(body)
+
+  create_special_form_evaluator: (defining_scope, params, body) ->
+    (cells, scope) -> body(cells, scope)
+

src/lisp_ch1.coffee

@@ -0,0 +1,152 @@
+{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
+
+ntype = (node) -> car node
+nvalu = (node) -> cadr node
+
+definitial = (name, value = nil) ->
+  env_global = (cons (cons name, value), env_global)
+  name
+
+defprimitive = (name, nativ, arity) ->
+  definitial name, ((args) ->
+    vmargs = listToVector(args)
+    if (vmargs.length == arity)
+      nativ.apply null, vmargs
+    else
+      throw "Incorrect arity")
+
+the_false_value = (cons "false", "boolean")
+
+definitial "#t", true
+definitial "#f", the_false_value
+definitial "nil", nil
+definitial "foo"
+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
+defprimitive "+", ((a, b) -> a + b), 2
+defprimitive "*", ((a, b) -> a * b), 2
+defprimitive "-", ((a, b) -> a - b), 2
+defprimitive "/", ((a, b) -> a / b), 2
+defpredicate "lt", ((a, b) -> a < b), 2
+defpredicate "eq?", ((a, b) -> a == b), 2
+
+extend = (env, variables, values) ->
+  if (pairp variables)
+    if (pairp values)
+      (cons (cons (car variables), (car values)),
+        (extend env, (cdr variables), (cdr values)))
+    else
+      throw "Too few values"
+  else if (nilp variables)
+    if (nilp values) then env else throw "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 "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) ->
+  [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 Error("Can't handle a #{type}")
+
+module.exports = (c) -> evaluate c, env_global

src/print.coffee

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

src/reader.coffee

@@ -1,12 +1,10 @@
-{car, cdr, cons, nil, nilp, pairp, vectorToList, list} = require 'cons-lists/lists'
+{car, cdr, cons, nil, nilp, pairp, vectorToList} = require 'cons-lists/lists'
-{inspect} = require "util"
-{Node, Comment} = require "./reader_types"
 
 NEWLINES   = ["\n", "\r", "\x0B", "\x0C"]
 WHITESPACE = [" ", "\t"].concat(NEWLINES)
 
-EOF = new (class Eof)()
+EOF = new (class)
-EOO = new (class Eoo)()
+EOO = new (class)
 
 class Source
   constructor: (@inStream) ->
@@ -32,9 +30,13 @@ class Source
 skipWS = (inStream) -> 
   while inStream.peek() in WHITESPACE then inStream.next()
 
+# (type, value, line, column) -> (node {type, value, line, column)}
+makeObj = (type, value, line, column) ->
+  cons(type, cons(value, cons(line, cons(column, nil))))
+
 # msg -> (IO -> Node => Error)
 handleError = (message) ->
-  (line, column) -> new Node('error', message, line, column)
+  (line, column) -> makeObj('error', message, line, column)
 
 # IO -> Node => Comment
 readComment = (inStream) ->
@@ -43,7 +45,7 @@ readComment = (inStream) ->
     inStream.next()).join("")
   if not inStream.done()
     inStream.next()
-  new Node 'comment', (new Comment r), line, column
+  makeObj 'comment', r, line, column
 
 # IO -> (Node => Literal => String) | Error
 readString = (inStream) ->
@@ -56,7 +58,7 @@ readString = (inStream) ->
   if inStream.done()
     return handleError("end of file seen before end of string.")(line, column)
   inStream.next()
-  new Node 'string', (string.join ''), line, column
+  makeObj 'string', (string.join ''), line, column
 
 # (String) -> (Node => Literal => Number) | Nothing
 readMaybeNumber = (symbol) ->
@@ -82,8 +84,8 @@ readSymbol = (inStream, tableKeys) ->
     inStream.next()).join ''
   number = readMaybeNumber symbol
   if number?
-    return new Node 'number', number, line, column
+    return makeObj 'number', number, line, column
-  new Node 'symbol', symbol, line, column
+  makeObj 'symbol', symbol, line, column
   
 
 # (Delim, TypeName) -> IO -> (IO, node) | Error
@@ -95,25 +97,18 @@ makeReadPair = (delim, type) ->
     [line, column] = inStream.position()
     if inStream.peek() == delim
       inStream.next()
-      return new Node type, nil, line, column
+      return makeObj(type, nil, line, column)
 
     # IO -> (IO, Node) | Error
-    dotted = false
     readEachPair = (inStream) ->
       [line, column] = inStream.position()
       obj = read inStream, true, null, true
-      if inStream.peek() == delim
+      if inStream.peek() == delim then return cons obj, nil
-        if dotted then return obj
-        return cons obj, nil
       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'
-      return obj if obj.type == 'error'
+      cons obj, readEachPair(inStream)
-      if obj.type == 'symbol' and obj.value == '.'
-        dotted = true
-        return readEachPair inStream
-      cons obj, readEachPair inStream
 
-    ret = new Node type, readEachPair(inStream), line, column
+    ret = makeObj type, readEachPair(inStream), line, column
     inStream.next()
     ret
 
@@ -125,8 +120,8 @@ prefixReader = (type) ->
     inStream.next()
     [line1, column1] = inStream.position()
     obj = read inStream, true, null, true
-    return obj if obj.type == 'error'
+    return obj if (car obj) == 'error'
-    new Node "list", cons((new Node("symbol", type, line1, column1)), cons(obj)), line, column
+    makeObj "list", cons((makeObj("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
@@ -139,7 +134,7 @@ readMacros =
   '[': makeReadPair ']', 'vector'
   ']': handleError "Closing bracket encountered"
   '{': makeReadPair('}', 'record', (res) ->
-    res.length % 2 == 0 and true or mkerr "record key without value")
+      res.length % 2 == 0 and true or mkerr "record key without value")
   '}': handleError "Closing curly without corresponding opening."
   "`": prefixReader 'back-quote'
   "'": prefixReader 'quote'
@@ -173,7 +168,7 @@ read = (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, inReadM
 
   while true
     form = matcher inStream, c
-    skip = (not nilp form) and (form.type == 'comment') and not keepComments
+    skip = (not nilp form) and (car form == 'comment') and not keepComments
     break if (not skip and not nilp form) or inStream.done()
     c = inStream.peek()
     null
@@ -184,21 +179,19 @@ read = (inStream, eofErrorP = false, eofError = EOF, recursiveP = false, inReadM
 
 # IO -> (Form* | Error)
 readForms = (inStream) ->
-  inStream = if inStream instanceof Source then inStream else new Source inStream
+    inStream = if inStream instanceof Source then inStream else new Source inStream
-  return nil if inStream.done()
+    return nil if inStream.done()
 
-  # IO -> (FORM*, IO) | Error
+    # IO -> (FORM*, IO) | Error
-  [line, column] = inStream.position()
+    [line, column] = inStream.position()
-  readEach = (inStream) ->
+    readEach = (inStream) ->
-    obj = read inStream, true, null, false
+      obj = read inStream, true, null, false
-    return nil if (nilp obj)
+      return nil if (nilp obj)
-    return obj if obj.type == 'error'
+      return obj if (car obj) == 'error'
-    cons obj, readEach inStream
+      cons obj, readEach inStream
 
-  obj = readEach inStream
+    obj = readEach inStream
-  if obj.type == 'error' then obj else new Node "list", obj, line, column
+    if (car obj) == 'error' then obj else makeObj "list", obj, line, column
 
 exports.read = read
 exports.readForms = readForms
-exports.Node = Node
-exports.Symbol = Symbol

src/scope.coffee

@@ -0,0 +1,31 @@
+lispeval = require './eval'
+{cons, car, cdr, nilp, nil, cadar, cadr, caddr} = require './lists'
+{create_lisp_expression_evaluator, create_vm_expression_evaluator, create_special_form_evaluator} = require './fn'
+
+scope = cons
+  '+': create_vm_expression_evaluator scope, [], (a, b) -> a + b
+  '-': create_vm_expression_evaluator scope, [], (a, b) -> a - b
+  '*': create_vm_expression_evaluator scope, [], (a, b) -> a * b
+  '/': create_vm_expression_evaluator scope, [], (a, b) -> a / b
+  '==': create_vm_expression_evaluator scope, [], (a, b) -> a == b
+  '#t': true
+  '#f': false
+
+  'define': create_special_form_evaluator scope, [], (nodes, scope) ->
+    current = (car scope)
+    current[(cadar nodes)] = lispeval((cadr nodes), scope)
+
+  'lambda': create_special_form_evaluator scope, [], (nodes, scope) ->
+    param_nodes = cadar nodes
+    reducer = (l) ->
+      if (nilp l) then nil else cons (cadar l), reducer(cdr l)
+    param_names = reducer(param_nodes)
+    create_lisp_expression_evaluator scope, param_names, (cdr nodes)
+        
+  'if': create_special_form_evaluator scope, [], (nodes, scope) ->
+    if lispeval (car nodes), scope
+      lispeval (cadr nodes), scope
+    else
+      lispeval (caddr nodes), scope
+
+module.exports = scope

src/test_chap1.coffee

@@ -0,0 +1,13 @@
+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 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))")
+
+console.log "Result:",  (lisp ast)

test/reader5_samples.coffee

@@ -1,25 +0,0 @@
-{cons, nil} = require "cons-lists/lists"
-exports.samples = [
-  ['nil', nil]
-  ['0', 0]
-  ['1', 1]
-  ['500', 500]
-  ['0xdeadbeef', 3735928559]
-  ['"Foo"', 'Foo']
-  ['(1)', cons(1)]
-  ['(1 2)', cons(1, (cons 2))]
-  ['(1 2 )', cons(1, (cons 2))]
-  ['( 1 2 )', cons(1, (cons 2))]
-  ['(1 (2 3) 4)', cons(1, cons(cons(2, cons(3)), cons(4)))]
-  ['(   1   2   )', cons(1, (cons 2))]
-  ['("a" "b")', cons("a", (cons "b"))]
-  ['("a" . "b")', cons("a", "b")]
-  ['[]', []]
-  ['{}', {}]
-  ['{"a" [1 2 3] "b" {"c" "d"} "c" ("a" "b" . "c")}', {"a": [1,2,3], "b":{"c": "d"}, "c": cons("a", cons("b", "c"))}]
-  ['[1 2 3]', [1, 2, 3]]
-  ['[1 2 [3 4] 5]', [1, 2, [3, 4], 5]]
-  # ['(1 2 3', 'error']
-  ['{"foo" "bar"}', {foo: "bar"}]
-]
-

test/test_chapter-lambda-1.coffee

@@ -1,54 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons} = require "cons-lists/lists"
-olisp = require '../chapter-lambda-1/interpreter'
-{read, readForms} = require '../chapter1/reader'
-
-the_false_value = (cons "false", "boolean")
-
-lisp = (ast) ->
-  ret = undefined
-  olisp ast, (i) -> ret = i
-  return ret
-
-
-describe "Core interpreter #3", ->
-  it "Should handle true statements", ->
-    expect(lisp read "(begin (if (lt 0 1) #t #f))").to.equal(true)
-  it "Should handle false statements", ->
-    expect(lisp read "(begin (if (lt 1 0) #t #f))").to.deep.equal(the_false_value)
-  it "Should handle return strings", ->
-    expect(lisp read '(begin (if (lt 0 1) "y" "n"))').to.equal("y")
-  it "Should handle return strings when false", ->
-    expect(lisp read '(begin (if (lt 1 0) "y" "n"))').to.equal("n")
-  it "Should handle equivalent objects that are not intrinsically truthy", ->
-    expect(lisp read '(begin (if (eq? "y" "y") "y" "n"))').to.equal("y")
-  it "Should handle inequivalent objects that are not intrinsically truthy", ->
-    expect(lisp read '(begin (if (eq? "y" "x") "y" "n"))').to.equal("n")
-
-  it "Should handle basic arithmetic", ->
-    expect(lisp read '(begin (+ 5 5))').to.equal(10)
-    expect(lisp read '(begin (* 5 5))').to.equal(25)
-    expect(lisp read '(begin (/ 5 5))').to.equal(1)
-    expect(lisp read '(begin (- 9 5))').to.equal(4)
-
-  it "Should handle some algebra", ->
-    expect(lisp read '(begin (* (+ 5 5) (* 2 3)))').to.equal(60)
-
-  it "Should handle a basic setting", ->
-    expect(lisp read '(begin (set! fact 4) fact)').to.equal(4)
-
-  it "Should handle a zero arity thunk", ->
-    expect(lisp read '(begin (set! fact (lambda () (+ 5 5))) (fact))').to.equal(10)
-
-  it "Should handle a two arity thunk", ->
-    expect(lisp read '(begin (set! fact (lambda (a b) (+ a b))) (fact 4 6))').to.equal(10)
-
-  it "Should handle a recursive function", ->
-    expect(lisp read '(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5))').to.equal(120)
-
-  it "Should handle an IIFE", ->
-    expect(lisp read '(begin ((lambda () (+ 5 5))))').to.equal(10)
-

test/test_chapter1.coffee

@@ -1,48 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons} = require "cons-lists/lists"
-lisp = require '../chapter1/interpreter'
-{read, readForms} = require '../chapter1/reader'
-
-the_false_value = (cons "false", "boolean")
-
-describe "Core interpreter #1", ->
-  it "Should handle true statements", ->
-    expect(lisp read "(begin (if (lt 0 1) #t #f))").to.equal(true)
-  it "Should handle false statements", ->
-    expect(lisp read "(begin (if (lt 1 0) #t #f))").to.deep.equal(the_false_value)
-  it "Should handle return strings", ->
-    expect(lisp read '(begin (if (lt 0 1) "y" "n"))').to.equal("y")
-  it "Should handle return strings when false", ->
-    expect(lisp read '(begin (if (lt 1 0) "y" "n"))').to.equal("n")
-  it "Should handle equivalent objects that are not intrinsically truthy", ->
-    expect(lisp read '(begin (if (eq? "y" "y") "y" "n"))').to.equal("y")
-  it "Should handle inequivalent objects that are not intrinsically truthy", ->
-    expect(lisp read '(begin (if (eq? "y" "x") "y" "n"))').to.equal("n")
-
-  it "Should handle basic arithmetic", ->
-    expect(lisp read '(begin (+ 5 5))').to.equal(10)
-    expect(lisp read '(begin (* 5 5))').to.equal(25)
-    expect(lisp read '(begin (/ 5 5))').to.equal(1)
-    expect(lisp read '(begin (- 9 5))').to.equal(4)
-
-  it "Should handle some algebra", ->
-    expect(lisp read '(begin (* (+ 5 5) (* 2 3)))').to.equal(60)
-
-  it "Should handle a basic setting", ->
-    expect(lisp read '(begin (set! fact 4) fact)').to.equal(4)
-
-  it "Should handle a zero arity thunk", ->
-    expect(lisp read '(begin (set! fact (lambda () (+ 5 5))) (fact))').to.equal(10)
-
-  it "Should handle a two arity thunk", ->
-    expect(lisp read '(begin (set! fact (lambda (a b) (+ a b))) (fact 4 6))').to.equal(10)
-
-  it "Should handle a recursive function", ->
-    expect(lisp read '(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5))').to.equal(120)
-
-  it "Should handle an IIFE", ->
-    expect(lisp read '(begin ((lambda () (+ 5 5))))').to.equal(10)
-

test/test_chapter3-cont.coffee

@@ -1,96 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons} = require "cons-lists/lists"
-olisp = require '../chapter3/interpreter'
-{read, readForms} = require '../chapter1/reader'
-
-the_false_value = (cons "false", "boolean")
-
-lisp = (ast) ->
-  ret = undefined
-  olisp ast, (i) -> ret = i
-  return ret
-
-describe "Core interpreter #3: Blocks", ->
-  it "Should handle simple blocks", ->
-    expect(lisp read "(block foo 33)").to.equal(33)
-  it "Should handle the last blocks", ->
-    expect(lisp read "(block foo 1 2 3)").to.equal(3)
-  it "Should handle expressive blocks", ->
-    expect(lisp read "(block foo (+ 5 5))").to.equal(10)
-  it "Should handle basic returns blocks", ->
-    expect(lisp read "(block foo (+ 1 (return-from foo 2)))").to.equal(2)
-  it "Should handle complex returns blocks", ->
-    code = "(block foo ((lambda (exit)(* 2 (block foo (* 3 (exit 5)) )) ) (lambda (x) (return-from foo x)) ) )"
-    expect(lisp read code).to.equal(5)
-  it "Expects an uninitialized return-from to fail", ->
-    expect(-> lisp read "(return-from foo 3)").to.throw("Unknown block label foo")
-  it "Expects to see an obsolete block when called late", ->
-    expect(-> lisp read "((block foo (lambda (x) (return-from foo x))) 3 )")
-      .to.throw("Obsolete continuation")
-  it "Expects to see an obsolete block when called late", ->
-    blocka = "((block a  (* 2 (block b (return-from a (lambda (x) (return-from b x))))) )3 )"
-    expect(-> lisp read blocka).to.throw("Obsolete continuation")
-  it "Expects to see an obsolete block when called late", ->
-    blockb = "((block a (* 2 (block b (return-from a (lambda (x) (return-from a x))))) ) 3 )"
-    expect(-> lisp read blockb).to.throw("Obsolete continuation")
-
-describe "Core interpreter #3: Try/Catch", ->
-  it "doesn't change a simple value", ->
-    expect(lisp read "(catch 'bar 1)").to.equal(1)
-  it "doesn't interfere with standard behavior", ->
-    expect(lisp read "(catch 'bar 1 2 3)").to.equal(3)
-  it "bails at the top level when no catch", ->
-    expect(-> lisp read "(throw 'bar 33)").to.throw("No associated catch")
-  it "catches the throws value", ->
-    expect(lisp read "(catch 'bar (throw 'bar 11))").to.equal(11)
-  it "catches before the evaluation happens", ->
-    expect(lisp read "(catch 'bar (* 2 (throw 'bar 5)))").to.equal(5)
-  it "unrolls through multiple layers of the stack", ->
-    expect(lisp read "((lambda (f) (catch 'bar (* 2 (f 5))) ) (lambda (x) (throw 'bar x)))").to.equal(5)
-  it "continues at the right location", ->
-    expect(lisp read "((lambda (f) (catch 'bar (* 2 (catch 'bar (* 3 (f 5))))) ) (lambda (x) (throw 'bar x)))").to.equal(10)
-  it "throw/catch happens with literalally catches", ->
-    expect(lisp read "(catch 2 (* 7 (catch 1 (* 3 (catch 2 (throw 1 (throw 2 5)) )) )))").to.equal(105)
-  it "bails at top level when there aren't enough catches", ->
-    expect(-> lisp read "(catch 2 (* 7 (throw 1 (throw 2 3))))").to.throw("No associated catch")
-
-#describe "Core interpreter #3: Unwind-Protect", ->
-#  it "protects the value correctly", ->
-#    expect(lisp read "(unwind-protect 1 2").to.equal(1)
-#   it "", ->
-#     expect(lisp read "((lambda (c) (unwind-protect 1 (set! c 2)) c ) 0 ").to.equal(2)
-#   it "", ->
-#     expect(lisp read "((lambda (c) (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) (set! c 1) ))) ) 0 ").to.equal(5)
-#   it "", ->
-#     expect(lisp read "((lambda (c) (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) (set! c 1) ))) c ) 0 ").to.equal(1)
-#   it "", ->
-#     expect(lisp read "((lambda (c) (block A (* 2 (unwind-protect (* 3 (return-from A 5)) (set! c 1) ))) ) 0 ").to.equal(5)
-#   it "", ->
-#     expect(lisp read "((lambda (c) (block A (* 2 (unwind-protect (* 3 (return-from A 5)) (set! c 1) ))) c ) 0 ").to.equal(1)
-# 
-# 
-# describe "Core interpreter #3: Try/Catch with Throw as a function", ->
-#   contain = (fcall) ->
-#     return "(begin ((lambda () (begin (set! funcall (lambda (g . args) (apply g args))) #{fcall}))))"
-# 
-#   it "", ->
-#     expect(-> lisp read "(funcall throw 'bar 33").to.throw("bar")
-#   it "", ->
-#     expect(lisp read "(catch 'bar (funcall throw 'bar 11))").to.equal(11)
-#   it "", ->
-#     expect(lisp read "(catch 'bar (* 2 (funcall throw 'bar 5)))").to.equal(5)
-#   it "", ->in
-#     expect(lisp read "((lambda (f) (catch 'bar (* 2 (f 5))) ) (lambda (x) (funcall throw 'bar x))) ").to.equal(5)
-#   it "", ->
-#     expect(lisp read "((lambda (f) (catch 'bar (* 2 (catch 'bar (* 3 (f 5))))) ) (lambda (x) (funcall throw 'bar x)))) ").to.equal(10)
-#   it "", ->
-#     expect(lisp read "(catch 2 (* 7 (catch 1 (* 3 (catch 2 (funcall throw 1 (funcall throw 2 5)) )) ))) ").to.equal(105)
-#   it "", ->
-#     expect(lisp read "(catch 2 (* 7 (funcall throw 1 (funcall throw 2 3))))").to.equal(3)
-#  
-# 
-#  
-# 

test/test_chapter3.coffee

@@ -1,55 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons} = require "cons-lists/lists"
-olisp = require '../chapter3/interpreter'
-{read, readForms} = require '../chapter1/reader'
-
-the_false_value = (cons "false", "boolean")
-
-lisp = (ast) ->
-  ret = undefined
-  olisp ast, (i) -> ret = i
-  return ret
-
-
-describe "Core interpreter #3", ->
-  it "Should handle true statements", ->
-    expect(lisp read "(begin (if (lt 0 1) #t #f))").to.equal(true)
-  it "Should handle false statements", ->
-    expect(lisp read "(begin (if (lt 1 0) #t #f))").to.deep.equal(the_false_value)
-  it "Should handle return strings", ->
-    expect(lisp read '(begin (if (lt 0 1) "y" "n"))').to.equal("y")
-  it "Should handle return strings when false", ->
-    expect(lisp read '(begin (if (lt 1 0) "y" "n"))').to.equal("n")
-  it "Should handle equivalent objects that are not intrinsically truthy", ->
-    expect(lisp read '(begin (if (eq? "y" "y") "y" "n"))').to.equal("y")
-  it "Should handle inequivalent objects that are not intrinsically truthy", ->
-    expect(lisp read '(begin (if (eq? "y" "x") "y" "n"))').to.equal("n")
-
-  it "Should handle basic arithmetic", ->
-    expect(lisp read '(begin (+ 5 5))').to.equal(10)
-    expect(lisp read '(begin (* 5 5))').to.equal(25)
-    expect(lisp read '(begin (/ 5 5))').to.equal(1)
-    expect(lisp read '(begin (- 9 5))').to.equal(4)
-
-  it "Should handle some algebra", ->
-    expect(lisp read '(begin (* (+ 5 5) (* 2 3)))').to.equal(60)
-
-  it "Should handle a basic setting", ->
-    expect(lisp read '(begin (set! fact 4) fact)').to.equal(4)
-
-  it "Should handle a zero arity thunk", ->
-    expect(lisp read '(begin (set! fact (lambda () (+ 5 5))) (fact))').to.equal(10)
-
-  it "Should handle a two arity thunk", ->
-    expect(lisp read '(begin (set! fact (lambda (a b) (+ a b))) (fact 4 6))').to.equal(10)
-
-  it "Should handle a recursive function", ->
-    expect(lisp read '(begin (set! fact (lambda (x) (if (eq? x 0) 1 (* x (fact (- x 1)))))) (fact 5))').to.equal(120)
-
-  it "Should handle an IIFE", ->
-    expect(lisp read '(begin ((lambda () (+ 5 5))))').to.equal(10)
-
-

test/test_chapter3g.coffee

@@ -1,50 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons} = require "cons-lists/lists"
-olisp = require '../chapter3g/interpreter'
-{read, readForms} = require '../chapter1/reader'
-
-the_false_value = (cons "false", "boolean")
-
-lisp = (ast) ->
-  ret = undefined
-  olisp ast, (i) -> ret = i
-  return ret
-  
-describe "Core interpreter #3: Protect", ->
-  it "unwinds but returns the value of the form", ->
-    expect(lisp read "(protect 1 2").to.equal(1)
-   it "unwinds within an iffe to correctly evaluate the side-effect", ->
-     expect(lisp read "((lambda (c) (protect 1 (set! c 2)) c ) 0 ").to.equal(2)
-   it "Unwinds inside an unevaluated definition", ->
-     expect(lisp read "((lambda (c) (catch 111 (* 2 (protect (* 3 (throw 111 5)) (set! c 1) ))) ) 0)").to.equal(5)
-   it "Unwinds inside the evaluated definition, triggering the side effect", ->
-     expect(lisp read "((lambda (c) (catch 111 (* 2 (protect (* 3 (throw 111 5)) (set! c 1) ))) c ) 0)").to.equal(1)
-   it "Same story, using block/return", ->
-     expect(lisp read "((lambda (c) (block A (* 2 (protect (* 3 (return A 5)) (set! c 1) ))) ) 0)").to.equal(5)
-   it "Same story, using block/return with a triggered side-effect", ->
-     expect(lisp read "((lambda (c) (block A (* 2 (protect (* 3 (return A 5)) (set! c 1) ))) c ) 0)").to.equal(1)
- 
- 
-#describe "Core interpreter #3: Try/Catch with Throw as a function", ->
-#  contain = (fcall) ->
-#    return "(begin ((lambda () (begin (set! funcall (lambda (g . args) (apply g args))) #{fcall}))))"
-#
-#  it "", ->
-#    expect(-> lisp read "(funcall throw 'bar 33").to.throw("bar")
-#  it "", ->
-#    expect(lisp read "(catch 'bar (funcall throw 'bar 11))").to.equal(11)
-#  it "", ->
-#    expect(lisp read "(catch 'bar (* 2 (funcall throw 'bar 5)))").to.equal(5)
-#  it "", ->
-#    expect(lisp read "((lambda (f) (catch 'bar (* 2 (f 5))) ) (lambda (x) (funcall throw 'bar x))) ").to.equal(5)
-#  it "", ->
-#    expect(lisp read "((lambda (f) (catch 'bar (* 2 (catch 'bar (* 3 (f 5))))) ) (lambda (x) (funcall throw 'bar x)))) ").to.equal(10)
-#  it "", ->
-#    expect(lisp read "(catch 2 (* 7 (catch 1 (* 3 (catch 2 (funcall throw 1 (funcall throw 2 5)) )) ))) ").to.equal(105)
-#  it "", ->
-#    expect(lisp read "(catch 2 (* 7 (funcall throw 1 (funcall throw 2 3))))").to.equal(3)
- 
-

test/test_chapter4.coffee

@@ -1,43 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons} = require "cons-lists/lists"
-olisp = require '../chapter4/interpreter'
-{read, readForms} = require '../chapter4/reader'
-
-the_false_value = (cons "false", "boolean")
-
-lisp = (ast) ->
-  ret = undefined
-  olisp ast, (i) -> ret = i
-  return ret
-
-describe "Core interpreter #4: Pure Lambda Memory", ->
-  it "Understands symbol equality", ->
-    expect(lisp read "(eq? 'a 'b)").to.equal(false)
-    expect(lisp read "(eq? 'a 'a)").to.equal(true)
-  it "Understands separate allocation inequality", ->
-    expect(lisp read "(eq? (cons 1 2) (cons 1 2))").to.equal(false)
-  it "Understands address equality", ->
-    expect(lisp read "((lambda (a) (eq? a a)) (cons 1 2))").to.equal(true)
-    expect(lisp read "((lambda (a) (eq? a a)) (lambda (x) x))").to.equal(true)
-  it "Understands function inequality", ->
-    expect(lisp read "(eq? (lambda (x) 1) (lambda (x y) 2))").to.equal(false)
-
-  it "Understands equivalence", ->
-    expect(lisp read "(eqv? '1 '2)").to.equal(false)
-    expect(lisp read "(eqv? 1 1)").to.equal(true)
-    expect(lisp read "(eqv? 'a 'b)").to.equal(false)
-    expect(lisp read "(eqv? 'a 'a)").to.equal(true)
-    expect(lisp read "(eqv? (cons 1 2) (cons 1 2))").to.equal(false)
-    expect(lisp read "((lambda (a) (eqv? a a)) (cons 1 2))").to.equal(true)
-    expect(lisp read "((lambda (a) (eqv? a a)) (lambda (x) x))").to.equal(true)
-    expect(lisp read "(eqv? (lambda (x) 1) (lambda (x y) 2))").to.equal(false)
-
-  it "Does special OR (backtracking without side-effect)", ->
-    expr1 = "((lambda (x) (or (begin (set! x (+ x 1)) #f) (if (= x 1) \"OK\" \"KO\"))) 1)"
-    expect(lisp read expr1).to.equal("OK")
-    expr2 = "((lambda (x) (or (begin (set! x (+ x 1)) #f) (if (= x 1) (begin (set! x 3) x) \"KO\"))) 1)"
-    expect(lisp read expr2).to.equal(3)
-

test/test_chapter5a.coffee

@@ -1,27 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-olisp = require '../chapter5/interpreter5a'
-{read} = require '../chapter5/reader'
-
-lisp = (ast) ->
-  ret = undefined
-  olisp ast, (i) -> ret = i
-  return ret
-
-describe "Core interpreter #5: Now with more λ!", ->
-  it "Understands symbol inequality", ->
-    expect(lisp read "(eq? 'a 'b)").to.equal(false)
-  it "Understands symbol equality", ->
-    expect(lisp read "(eq? 'a 'a)").to.equal(true)
-  it "Understands separate allocation inequality", ->
-    expect(lisp read "(eq? (cons 1 2) (cons 1 2))").to.equal(false)
-  it "Understands address equality of values", ->
-    expect(lisp read "((lambda (a) (eq? a a)) (cons 1 2))").to.equal(true)
-  it "Understands address equality of functions", ->
-    expect(lisp read "((lambda (a) (eq? a a)) (lambda (x) x))").to.equal(true)
-  it "Understands function inequality", ->
-    expect(lisp read "(eq? (lambda (x) 1) (lambda (x y) 2))").to.equal(false)
-
-

test/test_reader.coffee

@@ -1,35 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons, nil, nilp} = require "cons-lists/lists"
-{read, readForms} = require '../chapter1/reader'
-{normalizeForm} = require '../chapter1/astToList'
-
-describe "Core reader functions", ->
-  samples = [
-    ['nil', nil]
-    ['0', 0]
-    ['1', 1]
-    ['500', 500]
-    ['0xdeadbeef', 3735928559]
-    ['"Foo"', 'Foo']
-    ['(1)', cons(1)]
-    ['(1 2)', cons(1, (cons 2))]
-    ['(1 2 )', cons(1, (cons 2))]
-    ['( 1 2 )', cons(1, (cons 2))]
-    ['(   1   2   )', cons(1, (cons 2))]
-    ['("a" "b")', cons("a", (cons "b"))]
-    ['("a" . "b")', cons("a", "b")]
-    ['[]', []]
-    ['{}', {}]
-    ['[1 2 3]', [1, 2, 3]]
-    # ['(1 2 3', 'error']
-    ['{"foo" "bar"}', {foo: "bar"}]
-  ]
-
-  for [t, v] in samples
-    do (t, v) ->
-      it "should interpret #{t} as #{v}", ->
-        res = normalizeForm read t
-        expect(res).to.deep.equal(v)

test/test_reader5a.coffee

@@ -1,15 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons, nil, nilp} = require "cons-lists/lists"
-{read} = require '../chapter5/reader'
-{normalize} = require '../chapter5/reader_rawtoform'
-{samples} = require './reader5_samples'
-
-describe "Lisp reader functions", ->
-  for [t, v] in samples
-    do (t, v) ->
-      it "should interpret #{t} as #{v}", ->
-        res = normalize read t
-        expect(res).to.deep.equal(v)

test/test_reader5b.coffee

@@ -1,15 +0,0 @@
-chai = require 'chai'
-chai.should()
-expect = chai.expect
-
-{cons, nil, nilp} = require "cons-lists/lists"
-{read} = require '../chapter5/tracking_reader'
-{normalize} = require '../chapter5/reader_tracktoform'
-{samples} = require './reader5_samples'
-
-describe "Tracker reader functions", ->
-  for [t, v] in samples
-    do (t, v) ->
-      it "should interpret #{t} as #{v}", ->
-        res = normalize read t
-        expect(res).to.deep.equal(v)