TAGBODY uses TagNLX object instead of plain object
authorDavid Vázquez <davazp@gmail.com>
Sat, 22 Feb 2014 01:50:58 +0000 (02:50 +0100)
committerDavid Vázquez <davazp@gmail.com>
Sat, 22 Feb 2014 01:52:08 +0000 (02:52 +0100)
src/compiler/compiler.lisp
src/prelude.js

index 6773974..e3bac18 100644 (file)
                           default
                           (break tbloop)))
                  (catch (jump)
                           default
                           (break tbloop)))
                  (catch (jump)
-                   (if (and (== (get jump "type") "tagbody")
-                            (== (get jump "id") ,tbidx))
+                   (if (and (instanceof jump |TagNLX|) (== (get jump "id") ,tbidx))
                        (= ,branch (get jump "label"))
                        (throw jump)))))
         (return ,(convert nil))))))
 
 (define-compilation go (label)
                        (= ,branch (get jump "label"))
                        (throw jump)))))
         (return ,(convert nil))))))
 
 (define-compilation go (label)
-  (let ((b (lookup-in-lexenv label *environment* 'gotag))
-        (n (cond
-             ((symbolp label) (symbol-name label))
-             ((integerp label) (integer-to-string label)))))
+  (let ((b (lookup-in-lexenv label *environment* 'gotag)))
     (when (null b)
       (error "Unknown tag `~S'" label))
     `(selfcall
     (when (null b)
       (error "Unknown tag `~S'" label))
     `(selfcall
-      (throw
-          (object
-           "type" "tagbody"
-           "id" ,(first (binding-value b))
-           "label" ,(second (binding-value b))
-           "message" ,(concat "Attempt to GO to non-existing tag " n))))))
+      (throw (new (call |TagNLX|
+                        ,(first (binding-value b))
+                        ,(second (binding-value b))))))))
 
 (define-compilation unwind-protect (form &rest clean-up)
   `(selfcall
 
 (define-compilation unwind-protect (form &rest clean-up)
   `(selfcall
index d9df2da..1c0bf5b 100644 (file)
@@ -165,3 +165,8 @@ function CatchNLX (id, values){
   this.id = id;
   this.values = values;
 }
   this.id = id;
   this.values = values;
 }
+
+function TagNLX (id, label){
+  this.id = id;
+  this.label = label;
+}