From: David Vázquez <davazp@gmail.com>
Date: Sat, 22 Feb 2014 01:42:11 +0000 (+0100)
Subject: throw/catch uses CatchNLX object instead of plain object
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e1301bcded5eed2d9259d7688edf03892468fe2b;p=jscl.git

throw/catch uses CatchNLX object instead of plain object
---

diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp
index d5f0b55..c5c69bd 100644
--- a/src/compiler/compiler.lisp
+++ b/src/compiler/compiler.lisp
@@ -801,26 +801,21 @@
            "message" ,(concat "Return from unknown block '" (symbol-name name) "'."))))))
 
 (define-compilation catch (id &rest body)
-  `(selfcall
-    (var (id ,(convert id)))
-    (try
-     ,(convert-block body t))
-    (catch (|cf|)
-      (if (and (== (get |cf| "type") "catch")
-               (== (get |cf| "id") id))
-          ,(if *multiple-value-p*
-               `(return (method-call |values| "apply" this (call |forcemv| (get |cf| "values"))))
-               `(return (method-call |pv|     "apply" this (call |forcemv| (get |cf| "values")))))
-          (throw |cf|)))))
+  (let ((values (if *multiple-value-p* '|values| '|pv|)))
+    `(selfcall
+      (var (id ,(convert id)))
+      (try
+       ,(convert-block body t))
+      (catch (cf)
+        (if (and (instanceof cf |CatchNLX|) (== (get cf "id") id))
+            (return (method-call ,values "apply" this (call |forcemv| (get cf "values"))))
+            (throw cf))))))
 
 (define-compilation throw (id value)
   `(selfcall
     (var (|values| |mv|))
-    (throw (object
-            "type" "catch"
-            "id" ,(convert id)
-            "values" ,(convert value t)
-            "message" "Throw uncatched."))))
+    (throw (new (call |CatchNLX| ,(convert id) ,(convert value t))))))
+
 
 (defun go-tag-p (x)
   (or (integerp x) (symbolp x)))
diff --git a/src/prelude.js b/src/prelude.js
index 8f2c1b2..d9df2da 100644
--- a/src/prelude.js
+++ b/src/prelude.js
@@ -151,3 +151,17 @@ function js_to_lisp (x) {
     });
   } else return x;
 }
+
+
+// Non-local exits
+
+function BlockNLX (id, values, name){
+  this.id = id;
+  this.values = values;
+  this.name = name;
+}
+
+function CatchNLX (id, values){
+  this.id = id;
+  this.values = values;
+}