[refactor] Got throw/catch working with self-evaluating expressions

This was a pain point.  I had hacked the "names" of symbols into the
throw/catch representation, never appreciating how badly I was screwing
up my understanding of LiSP.  The symbols are supposed to evaluate
to something.  When they're self-evaluating expressions (strings and
numbers), those become the keys in the block stack that matter.  Getting
SEE's right, whether they're quoted or not, was really signficant.

This is cool.  Now, on to rewind/protect!
This commit is contained in:
Elf M. Sternberg 2015-07-31 07:34:12 -07:00
parent 675577431d
commit 3e17e69746
3 changed files with 20 additions and 14 deletions

View File

@ -6,7 +6,6 @@
# RICH_AST -> LISP_AST
normalizeForm = (form) ->
console.log(form)
listToRecord1 = (l) ->
o = Object.create(null)
@ -27,7 +26,7 @@ normalizeForm = (form) ->
'record': (atom) -> listToRecord1(atom)
# Basic native types. Meh.
'symbol': new Symbol(id)
'symbol': (id) -> new Symbol(id)
'number': id
'string': id
'nil': (atom) -> nil

View File

@ -2,7 +2,7 @@
cadr, caadr, cadar, caddr, nilp, nil, setcdr,
metacadr, setcar} = require "cons-lists/lists"
{normalizeForms, normalizeForm} = require "../chapter1/astToList"
{Node} = require '../chapter1/reader_types'
{Node, Symbol} = require '../chapter1/reader_types'
class LispInterpreterError extends Error
name: 'LispInterpreterError'
@ -13,6 +13,11 @@ 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
@ -262,15 +267,14 @@ evaluateCatch = (tag, body, env, kont) ->
class CatchCont extends Continuation
constructor: (@kont, @body, @env) ->
resume: (value) ->
evaluateBegin @body, @env, (new LabeledCont @kont, normalizeForm car value)
evaluateBegin @body, @env, (new LabeledCont @kont, value)
class LabeledCont extends Continuation
constructor: (@kont, @tag) ->
resume: (value) ->
@kont.resume value
catchLookup: (tag, kk) ->
if tag == @tag
console.log tag, @tag
if eq tag, @tag
evaluate kk.form, kk.env, (new ThrowingCont kk, tag, this)
else
@kont.catchLookup tag, kk
@ -278,7 +282,7 @@ class LabeledCont extends Continuation
class ThrowCont extends Continuation
constructor: (@kont, @form, @env) ->
resume: (value) ->
@catchLookup (normalizeForm car value), @
@catchLookup value, @
evaluateThrow = (tag, form, env, kont) ->
evaluate tag, env, (new ThrowCont kont, form, env)
@ -322,6 +326,9 @@ defpredicate = (name, nativ, 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"]
@ -413,7 +420,7 @@ makeEvaluator = (ix = straight_evaluation, ty="straight") ->
head = car body
if ix.symbolp head
switch (ix.nvalu head)
when "quote" then evaluateQuote (cdr body), env, kont
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

View File

@ -44,7 +44,7 @@ describe "Core interpreter #3: Try/Catch", ->
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 right thing", ->
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)
@ -52,14 +52,14 @@ describe "Core interpreter #3: Try/Catch", ->
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 unlabled catches", ->
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 test")
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)
#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 "", ->