From ec9cdfb4a174446a4075493f378fcf58f5b40ebf Mon Sep 17 00:00:00 2001 From: "Elf M. Sternberg" Date: Tue, 1 Sep 2015 16:50:04 -0700 Subject: [PATCH] [feat] Chapter 5, first compiler. Not doing the rest... --- chapter5/interpreter5a.coffee | 105 +++++++++++++++------------- chapter5/reader.coffee | 2 +- test/test_chapter5_benchmark.coffee | 37 ---------- test/test_chapter5a.coffee | 27 +++++++ 4 files changed, 86 insertions(+), 85 deletions(-) delete mode 100644 test/test_chapter5_benchmark.coffee create mode 100644 test/test_chapter5a.coffee diff --git a/chapter5/interpreter5a.coffee b/chapter5/interpreter5a.coffee index efa742f..59a1c09 100644 --- a/chapter5/interpreter5a.coffee +++ b/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" -env_init = (a) -> throw new LispInterpreterError "No such variable" +store_init = (a) -> throw new LispInterpreterError "No such address: #{a}" +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 "y", null - @definitial "z", null - @definitial "a", null - @definitial "b", null - @definitial "c", null - @definitial "foo", null - @definitial "bar", null - @definitial "hux", null - @definitial "fib", null - @definitial "fact", null - @definitial "visit", null - @definitial "length", null - @definitial "primes", null + @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)) + "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) - - n = if symbolp (car e) then (car e).name else (car 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) @@ -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) - - (@meaning exp)(env, hkont, store) + kont val, (extend store1, (env name), val) + (@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 - kont inValue, funcrep + allocate store1, (length names), argnamestostore + 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) => diff --git a/chapter5/reader.coffee b/chapter5/reader.coffee index ac784a8..9af2446 100644 --- a/chapter5/reader.coffee +++ b/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 diff --git a/test/test_chapter5_benchmark.coffee b/test/test_chapter5_benchmark.coffee deleted file mode 100644 index ec4b3f2..0000000 --- a/test/test_chapter5_benchmark.coffee +++ /dev/null @@ -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) diff --git a/test/test_chapter5a.coffee b/test/test_chapter5a.coffee new file mode 100644 index 0000000..a81b74e --- /dev/null +++ b/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) + +