From 3e17e697462b097ec7f7d5d3700166056a84312e Mon Sep 17 00:00:00 2001
From: "Elf M. Sternberg" <elf.sternberg@gmail.com>
Date: Fri, 31 Jul 2015 07:34:12 -0700
Subject: [PATCH] [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!
---
 chapter1/astToList.coffee      |  3 +--
 chapter3/interpreter.coffee    | 19 +++++++++++++------
 test/test_chapter3-cont.coffee | 12 ++++++------
 3 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/chapter1/astToList.coffee b/chapter1/astToList.coffee
index 459c5a7..c7dbfd2 100644
--- a/chapter1/astToList.coffee
+++ b/chapter1/astToList.coffee
@@ -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
diff --git a/chapter3/interpreter.coffee b/chapter3/interpreter.coffee
index 05fa410..e5c9e83 100644
--- a/chapter3/interpreter.coffee
+++ b/chapter3/interpreter.coffee
@@ -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
diff --git a/test/test_chapter3-cont.coffee b/test/test_chapter3-cont.coffee
index b6c4510..c8f5eb1 100644
--- a/test/test_chapter3-cont.coffee
+++ b/test/test_chapter3-cont.coffee
@@ -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 "", ->