block/return-from uses BlockNLX instead of plain object
authorDavid Vázquez <davazp@gmail.com>
Sat, 22 Feb 2014 01:46:05 +0000 (02:46 +0100)
committerDavid Vázquez <davazp@gmail.com>
Sat, 22 Feb 2014 01:46:05 +0000 (02:46 +0100)
src/compiler/compiler.lisp

index c5c69bd..6773974 100644 (file)
              (var (,idvar #()))
              ,cbody)
             (catch (cf)
              (var (,idvar #()))
              ,cbody)
             (catch (cf)
-              (if (and (== (get cf "type") "block")
-                       (== (get cf "id") ,idvar))
+              (if (and (instanceof cf |BlockNLX|) (== (get cf "id") ,idvar))
                   ,(if *multiple-value-p*
                        `(return (method-call |values| "apply" this (call |forcemv| (get cf "values"))))
                        `(return (get cf "values")))
                   ,(if *multiple-value-p*
                        `(return (method-call |values| "apply" this (call |forcemv| (get cf "values"))))
                        `(return (get cf "values")))
     ;; capture it in a closure.
     `(selfcall
       ,(when multiple-value-p `(var (|values| |mv|)))
     ;; capture it in a closure.
     `(selfcall
       ,(when multiple-value-p `(var (|values| |mv|)))
-      (throw
-          (object
-           "type" "block"
-           "id" ,(binding-value b)
-           "values" ,(convert value multiple-value-p)
-           "message" ,(concat "Return from unknown block '" (symbol-name name) "'."))))))
+      (throw (new (call |BlockNLX|
+                        ,(binding-value b)
+                        ,(convert value multiple-value-p)
+                        ,(symbol-name name)))))))
 
 (define-compilation catch (id &rest body)
   (let ((values (if *multiple-value-p* '|values| '|pv|)))
 
 (define-compilation catch (id &rest body)
   (let ((values (if *multiple-value-p* '|values| '|pv|)))