[feat] Chapter 5, first compiler. Not doing the rest...

chapter5/interpreter5a.coffee

@@ -6,10 +6,14 @@
 {Node, Comment, Symbol} = require '../chapter5/reader_types'
 {inspect} = require 'util'
 
-itap = (a) -> return inspect a, true, null, false
+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)
@@ -27,6 +31,9 @@ eq = (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
@@ -147,8 +154,8 @@ ValueToNumber = (e) ->
 ValueToPrimitive = (e) ->
   return e.v
 
-store_init = (a) -> throw new LispInterpreterError "No such address"
+store_init = (a) -> throw new LispInterpreterError "No such address: #{a}"
-env_init = (a) -> throw new LispInterpreterError "No such variable"  
+env_init = (a) -> throw new LispInterpreterError "No such variable: #{a}"  
 
 class Interpreter
   constructor: ->
@@ -156,7 +163,7 @@ class Interpreter
       (values, kont, store) =>
         if not eq (length values), arity
           throw new LispInterpreterError "Incorrect Arity for #{name}"
-        fn.call(@, values, kont, store)
+        fn(values, kont, store)
 
     @definitial "cons", inValue arity_check "cons", 2, (values, kont, store) =>
       allocate store, 2, (store, addrs) =>
@@ -208,38 +215,60 @@ class Interpreter
     @definitial '#f', (inValue false)
     @definitial 'nil', (inValue cons())
 
-    @definitial "x", null
+    @definitial "x", inValue (new Object(null))
-    @definitial "y", null
+    @definitial "y", inValue (new Object(null))
-    @definitial "z", null
+    @definitial "z", inValue (new Object(null))
-    @definitial "a", null
+    @definitial "a", inValue (new Object(null))
-    @definitial "b", null
+    @definitial "b", inValue (new Object(null))
-    @definitial "c", null
+    @definitial "c", inValue (new Object(null))
-    @definitial "foo", null
+    @definitial "foo", inValue (new Object(null))
-    @definitial "bar", null
+    @definitial "bar", inValue (new Object(null))
-    @definitial "hux", null
+    @definitial "hux", inValue (new Object(null))
-    @definitial "fib", null
+    @definitial "fib", inValue (new Object(null))
-    @definitial "fact", null
+    @definitial "fact", inValue (new Object(null))
-    @definitial "visit", null
+    @definitial "visit", inValue (new Object(null))
-    @definitial "length", null
+    @definitial "length", inValue (new Object(null))
-    @definitial "primes", null
+    @definitial "filter", inValue (new Object(null))
+    @definitial "primes", inValue (new Object(null))
 
   meaning: (e) ->
     meaningTable =
-      "quote":      ((e) => @meaningQuotation (cadr e))
+      "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 e.name) else (@meaningQuotation e)
+      return if (symbolp e) then (@meaningReference gsym(e)) else (@meaningQuotation e)
-
+    n = gsym(car e)
-    n = if symbolp (car e) then (car e).name else (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)
@@ -265,11 +294,12 @@ class Interpreter
   # Assignment
 
   meaningAssignment: (name, exp) ->
+    name = if name instanceof Symbol then name.name else name
+    console.log(name)
     (env, kont, store) =>
       hkont = (val, store1) ->
-        kont value, (extend store1, (env name), val)
+        kont val, (extend store1, (env name), val)
-
+      (@meaning exp) env, hkont, store
-      (@meaning exp)(env, hkont, store)
 
   # Abstraction (keeps a lambda)
 
@@ -278,10 +308,10 @@ class Interpreter
       funcrep = (vals, kont1, store1) =>
         if not (eq (length vals), (length names))
           throw new LispInterpreterError("Incorrect Arity.")
-        functostore = (store2, addrs) =>
+        argnamestostore = (store2, addrs) =>
           (@meaningsSequence exps) (lextends env, names, addrs), kont1, (lextends store2, addrs, vals)
-        allocate store1, (length names), functostore
+        allocate store1, (length names), argnamestostore
-      kont inValue, funcrep
+      kont (inValue funcrep), store
 
   meaningVariable: (name) ->
     (m) ->
@@ -298,25 +328,6 @@ class Interpreter
         (@meanings exps) env, kont2, store1
       (@meaning exp) env, hkont, store
 
-  meaningSequence: (exps) ->
-    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
-
-    (env, kont, store) ->
-      if not (pairp exps)
-        throw new LispInterpreterError("Illegal Syntax")
-      if pairp cdr exps
-        meaningsMultipleSequence (car exps), (cdr exps)
-      else
-        meaningSingleSequence (car exps)
-
   meanings: (exps) =>
     meaningSomeArguments = (exp, exps) =>
       (env, kont, store) =>

chapter5/reader.coffee

@@ -90,7 +90,7 @@ class Reader
       inStream.next()
       obj = @read inStream, true, null, true
       return obj if obj instanceof ReadError
-      cons((new Symbol type), obj)
+      list((new Symbol type), obj)
 
   "acc": (obj) -> obj
 

test/test_chapter5_benchmark.coffee

@@ -1,37 +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
-
-benchmark = [
-  "(begin",
-  "  (set! primes",
-  "        (lambda (n f max)",
-  "          ((lambda (filter)",
-  "             (begin",
-  "               (set! filter (lambda (p)",
-  "                              (lambda (n) (= 0 (remainder n p))) ))",
-  "               (if (> n max)",
-  "                   '()",
-  "                   (if (f n)",
-  "                       (primes (+ n 1) f max)",
-  "                       (cons n",
-  "                             ((lambda (ff)",
-  "                                (primes (+ n 1)",
-  "                                        (lambda (p) (if (f p) t (ff p)))",
-  "                                        max ) )",
-  "                              (filter n) ) ) ) ) ) )",
-  "           'wait ) ) )",
-  "  (primes 2 (lambda (x) f) 50) )"].join('')
-
-  
-describe "Chapter 5: It runs.", ->
-  it "Runs the primes search example", ->
-    expect(lisp read benchmark).to.equal(true)

test/test_chapter5a.coffee

@@ -0,0 +1,27 @@
+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)
+
+