From 38fa5ae125eb69cead1bc40d39bfcff0027e6eec Mon Sep 17 00:00:00 2001 From: "Elf M. Sternberg" Date: Mon, 3 Aug 2015 07:31:22 -0700 Subject: [PATCH] [feat] The interpreter works and all the tests run without crashing. --- chapter-lambda-1/interpreter.coffee | 2 +- chapter1/astAccessors.coffee | 2 +- chapter1/interpreter.coffee | 2 +- chapter3/interpreter.coffee | 14 ++++---- chapter3g/interpreter.coffee | 17 +++++++-- chapter3g/test.coffee | 6 ++-- docs/new.md | 12 +++++++ pending/test_chapter3g.coffee | 53 ----------------------------- test/test_chapter3g.coffee | 50 +++++++++++++++++++++++++++ 9 files changed, 88 insertions(+), 70 deletions(-) create mode 100644 docs/new.md delete mode 100644 pending/test_chapter3g.coffee create mode 100644 test/test_chapter3g.coffee diff --git a/chapter-lambda-1/interpreter.coffee b/chapter-lambda-1/interpreter.coffee index 6bb8944..2081bba 100644 --- a/chapter-lambda-1/interpreter.coffee +++ b/chapter-lambda-1/interpreter.coffee @@ -138,7 +138,7 @@ metadata_evaluation = nvalu: (node) -> node.value mksymbols: (list) -> astSymbolsToLispSymbols(list) -straight_evaluation = +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] == ";" diff --git a/chapter1/astAccessors.coffee b/chapter1/astAccessors.coffee index 147b29b..e953b79 100644 --- a/chapter1/astAccessors.coffee +++ b/chapter1/astAccessors.coffee @@ -1,7 +1,7 @@ {car, cdr, listp} = require 'cons-lists/lists' {Node, Symbol} = require "./reader_types" -module.exports = ops = +module.exports = ops = astObject: (form) -> form instanceof Node aValue: (form) -> form.value aSymbol: (form) -> form.value diff --git a/chapter1/interpreter.coffee b/chapter1/interpreter.coffee index 9363084..0bcc33e 100644 --- a/chapter1/interpreter.coffee +++ b/chapter1/interpreter.coffee @@ -133,7 +133,7 @@ metadata_evaluation = nvalu: (node) -> node.value mksymbols: (list) -> astSymbolsToLispSymbols(list) -straight_evaluation = +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] == ";" diff --git a/chapter3/interpreter.coffee b/chapter3/interpreter.coffee index e5c9e83..b1513d5 100644 --- a/chapter3/interpreter.coffee +++ b/chapter3/interpreter.coffee @@ -317,8 +317,8 @@ defprimitive = (name, nativ, arity) -> vmargs = listToVector(args) if (vmargs.length == arity) kont.resume (nativ.apply null, vmargs) - else - throw new LispInterpreterError "Incorrect arity" + 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 @@ -367,10 +367,10 @@ definitial "apply", new Primitive "apply", (values, env, kont) -> 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" + 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) @@ -394,7 +394,7 @@ metadata_evaluation = nvalu: (node) -> node.value mksymbols: (list) -> astSymbolsToLispSymbols(list) -straight_evaluation = +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] == ";" diff --git a/chapter3g/interpreter.coffee b/chapter3g/interpreter.coffee index d20c6b2..367f25a 100644 --- a/chapter3g/interpreter.coffee +++ b/chapter3g/interpreter.coffee @@ -32,9 +32,11 @@ class Continuation else throw new LispInterpreterError "Continuations expect one argument" unwind: (value, ktarget) -> - if (@kont == ktarget) then (@kont.resume value) else (@kont.unwind value, ktarget) + if (@ == ktarget) then (@kont.resume value) else (@kont.unwind value, ktarget) catchLookup: (tag, kk) -> @kont.catchLookup tag, kk + resume: (value) -> + throw new LispInterpreterError "Wrong continuation for #{@_type}" # Abstract class representing the environment @@ -258,6 +260,7 @@ evaluateReturnFrom = (label, form, env, kont) -> class ReturnFromCont extends Continuation constructor: (@kont, @env, @label) -> + @_type = "ReturnFromCont" resume: (v) -> @env.blockLookup @label, @kont, v @@ -266,11 +269,13 @@ evaluateCatch = (tag, body, env, kont) -> class CatchCont extends Continuation constructor: (@kont, @body, @env) -> + @_type = "CatchFromCont" resume: (value) -> evaluateBegin @body, @env, (new LabeledCont @kont, value) class LabeledCont extends Continuation constructor: (@kont, @tag) -> + @_type = "LabeledFromCont" resume: (value) -> @kont.resume value catchLookup: (tag, kk) -> @@ -281,6 +286,7 @@ class LabeledCont extends Continuation class ThrowCont extends Continuation constructor: (@kont, @form, @env) -> + @_type = "ThrowCont" resume: (value) -> @catchLookup value, @ @@ -289,17 +295,21 @@ evaluateThrow = (tag, form, env, kont) -> class UnwindCont extends Continuation constructor: (@kont, @value, @target) -> - + resume: (value) -> + @kont.unwind @value, @target + class ThrowingCont extends Continuation constructor: (@kont, @tag, @resumecont) -> + @_type = "ThrowingCont" resume: (value) -> - @kont.unwind @resumecont.resume value + @kont.unwind value, @resumecont evaluateUnwindProtect = (form, cleanup, env, kont) -> evaluate form, env, (new UnwindProtectCont kont, cleanup, env) class UnwindProtectCont extends Continuation constructor: (@kont, @cleanup, @env) -> + @_type = "UnwindProtectCont" resume: (value) -> evaluateBegin @cleanup, @env, (new ProtectReturnCont @kont, value) unwind: (value, target) -> @@ -307,6 +317,7 @@ class UnwindProtectCont extends Continuation class ProtectReturnCont extends Continuation constructor: (@kont, @value) -> + @_type = "ProtectReturnCont" resume: (value) -> @kont.resume @value diff --git a/chapter3g/test.coffee b/chapter3g/test.coffee index 8cdfb05..d59fc78 100644 --- a/chapter3g/test.coffee +++ b/chapter3g/test.coffee @@ -1,4 +1,4 @@ -olisp = require '../chapter3/interpreter' +olisp = require '../chapter3g/interpreter' {read, readForms} = require '../chapter1/reader' {inspect} = require 'util' @@ -9,6 +9,4 @@ lisp = (ast) -> # console.log lisp read "(catch 2 (* 7 (catch 1 (* 3 (catch 2 (throw 1 (throw 2 5)) )) )))" -console.log lisp read "(catch foo (throw foo 33))" -console.log lisp read "(catch 'bar (throw 'bar 3))" -console.log lisp read "(catch 1 (throw 1 7))" +console.log lisp read "((lambda (c) (catch 111 (* 2 (unwind-protect (* 3 (throw 111 5)) (set! c 1) ))) ) 0)" diff --git a/docs/new.md b/docs/new.md new file mode 100644 index 0000000..2a0eddb --- /dev/null +++ b/docs/new.md @@ -0,0 +1,12 @@ +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. + + diff --git a/pending/test_chapter3g.coffee b/pending/test_chapter3g.coffee deleted file mode 100644 index e540685..0000000 --- a/pending/test_chapter3g.coffee +++ /dev/null @@ -1,53 +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: 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 "", -> - 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) - - - - - diff --git a/test/test_chapter3g.coffee b/test/test_chapter3g.coffee new file mode 100644 index 0000000..05a6c6f --- /dev/null +++ b/test/test_chapter3g.coffee @@ -0,0 +1,50 @@ +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: Unwind-Protect", -> + it "unwinds but returns the value of the form", -> + expect(lisp read "(unwind-protect 1 2").to.equal(1) + it "unwinds within an iffe to correctly evaluate the side-effect", -> + expect(lisp read "((lambda (c) (unwind-protect 1 (set! c 2)) c ) 0 ").to.equal(2) + it "Unwinds inside an unevaluated definition", -> + expect(lisp read "((lambda (c) (catch 111 (* 2 (unwind-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 (unwind-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 (unwind-protect (* 3 (return-from 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 (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 "", -> +# 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) + +