[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:
parent
675577431d
commit
3e17e69746
|
@ -6,7 +6,6 @@
|
||||||
# RICH_AST -> LISP_AST
|
# RICH_AST -> LISP_AST
|
||||||
|
|
||||||
normalizeForm = (form) ->
|
normalizeForm = (form) ->
|
||||||
console.log(form)
|
|
||||||
|
|
||||||
listToRecord1 = (l) ->
|
listToRecord1 = (l) ->
|
||||||
o = Object.create(null)
|
o = Object.create(null)
|
||||||
|
@ -27,7 +26,7 @@ normalizeForm = (form) ->
|
||||||
'record': (atom) -> listToRecord1(atom)
|
'record': (atom) -> listToRecord1(atom)
|
||||||
|
|
||||||
# Basic native types. Meh.
|
# Basic native types. Meh.
|
||||||
'symbol': new Symbol(id)
|
'symbol': (id) -> new Symbol(id)
|
||||||
'number': id
|
'number': id
|
||||||
'string': id
|
'string': id
|
||||||
'nil': (atom) -> nil
|
'nil': (atom) -> nil
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
cadr, caadr, cadar, caddr, nilp, nil, setcdr,
|
cadr, caadr, cadar, caddr, nilp, nil, setcdr,
|
||||||
metacadr, setcar} = require "cons-lists/lists"
|
metacadr, setcar} = require "cons-lists/lists"
|
||||||
{normalizeForms, normalizeForm} = require "../chapter1/astToList"
|
{normalizeForms, normalizeForm} = require "../chapter1/astToList"
|
||||||
{Node} = require '../chapter1/reader_types'
|
{Node, Symbol} = require '../chapter1/reader_types'
|
||||||
|
|
||||||
class LispInterpreterError extends Error
|
class LispInterpreterError extends Error
|
||||||
name: 'LispInterpreterError'
|
name: 'LispInterpreterError'
|
||||||
|
@ -13,6 +13,11 @@ the_false_value = (cons "false", "boolean")
|
||||||
# Base class that represents a value. Base class representing a LiSP
|
# Base class that represents a value. Base class representing a LiSP
|
||||||
# value, a primitive, or a function
|
# 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
|
class Value
|
||||||
|
|
||||||
# Represents the base class of a continuation. Calls to invoke resume
|
# Represents the base class of a continuation. Calls to invoke resume
|
||||||
|
@ -262,15 +267,14 @@ evaluateCatch = (tag, body, env, kont) ->
|
||||||
class CatchCont extends Continuation
|
class CatchCont extends Continuation
|
||||||
constructor: (@kont, @body, @env) ->
|
constructor: (@kont, @body, @env) ->
|
||||||
resume: (value) ->
|
resume: (value) ->
|
||||||
evaluateBegin @body, @env, (new LabeledCont @kont, normalizeForm car value)
|
evaluateBegin @body, @env, (new LabeledCont @kont, value)
|
||||||
|
|
||||||
class LabeledCont extends Continuation
|
class LabeledCont extends Continuation
|
||||||
constructor: (@kont, @tag) ->
|
constructor: (@kont, @tag) ->
|
||||||
resume: (value) ->
|
resume: (value) ->
|
||||||
@kont.resume value
|
@kont.resume value
|
||||||
catchLookup: (tag, kk) ->
|
catchLookup: (tag, kk) ->
|
||||||
if tag == @tag
|
if eq tag, @tag
|
||||||
console.log tag, @tag
|
|
||||||
evaluate kk.form, kk.env, (new ThrowingCont kk, tag, this)
|
evaluate kk.form, kk.env, (new ThrowingCont kk, tag, this)
|
||||||
else
|
else
|
||||||
@kont.catchLookup tag, kk
|
@kont.catchLookup tag, kk
|
||||||
|
@ -278,7 +282,7 @@ class LabeledCont extends Continuation
|
||||||
class ThrowCont extends Continuation
|
class ThrowCont extends Continuation
|
||||||
constructor: (@kont, @form, @env) ->
|
constructor: (@kont, @form, @env) ->
|
||||||
resume: (value) ->
|
resume: (value) ->
|
||||||
@catchLookup (normalizeForm car value), @
|
@catchLookup value, @
|
||||||
|
|
||||||
evaluateThrow = (tag, form, env, kont) ->
|
evaluateThrow = (tag, form, env, kont) ->
|
||||||
evaluate tag, env, (new ThrowCont kont, form, env)
|
evaluate tag, env, (new ThrowCont kont, form, env)
|
||||||
|
@ -322,6 +326,9 @@ defpredicate = (name, nativ, arity) ->
|
||||||
definitial "#t", true
|
definitial "#t", true
|
||||||
definitial "#f", the_false_value
|
definitial "#f", the_false_value
|
||||||
definitial "nil", nil
|
definitial "nil", nil
|
||||||
|
|
||||||
|
# FIXME: All of these things dereference to the same value!!!!
|
||||||
|
|
||||||
for i in [
|
for i in [
|
||||||
"x", "y", "z", "a", "b", "c", "foo", "bar", "hux",
|
"x", "y", "z", "a", "b", "c", "foo", "bar", "hux",
|
||||||
"fib", "fact", "visit", "primes", "length"]
|
"fib", "fact", "visit", "primes", "length"]
|
||||||
|
@ -413,7 +420,7 @@ makeEvaluator = (ix = straight_evaluation, ty="straight") ->
|
||||||
head = car body
|
head = car body
|
||||||
if ix.symbolp head
|
if ix.symbolp head
|
||||||
switch (ix.nvalu 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 "if" then evaluateIf (cdr body), env, kont
|
||||||
when "begin" then evaluateBegin (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 "set!" then evaluateSet (ix.nvalu cadr body), (caddr body), env, kont
|
||||||
|
|
|
@ -44,7 +44,7 @@ describe "Core interpreter #3: Try/Catch", ->
|
||||||
expect(lisp read "(catch 'bar 1 2 3)").to.equal(3)
|
expect(lisp read "(catch 'bar 1 2 3)").to.equal(3)
|
||||||
it "bails at the top level when no catch", ->
|
it "bails at the top level when no catch", ->
|
||||||
expect(-> lisp read "(throw 'bar 33)").to.throw("No associated 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)
|
expect(lisp read "(catch 'bar (throw 'bar 11))").to.equal(11)
|
||||||
it "catches before the evaluation happens", ->
|
it "catches before the evaluation happens", ->
|
||||||
expect(lisp read "(catch 'bar (* 2 (throw 'bar 5)))").to.equal(5)
|
expect(lisp read "(catch 'bar (* 2 (throw 'bar 5)))").to.equal(5)
|
||||||
|
@ -52,10 +52,10 @@ describe "Core interpreter #3: Try/Catch", ->
|
||||||
expect(lisp read "((lambda (f) (catch 'bar (* 2 (f 5))) ) (lambda (x) (throw 'bar x)))").to.equal(5)
|
expect(lisp read "((lambda (f) (catch 'bar (* 2 (f 5))) ) (lambda (x) (throw 'bar x)))").to.equal(5)
|
||||||
it "continues at the right location", ->
|
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)
|
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)
|
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", ->
|
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", ->
|
#describe "Core interpreter #3: Unwind-Protect", ->
|
||||||
# it "protects the value correctly", ->
|
# it "protects the value correctly", ->
|
||||||
|
|
Loading…
Reference in New Issue