X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcompiler.lisp;h=25ad560c3222a52660d40d9b4bf73291a7495ce5;hb=e8992591d4100811ac125bf97c5b153ddecb0250;hp=d5f0b556b7b883ddd7b2c5b4b94cbb21005ab1fa;hpb=c482b4547542853e71a3af2870c87ea366069913;p=jscl.git

diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp
index d5f0b55..25ad560 100644
--- a/src/compiler/compiler.lisp
+++ b/src/compiler/compiler.lisp
@@ -773,8 +773,7 @@
              (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")))
@@ -793,34 +792,27 @@
     ;; 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)
-  `(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)))
@@ -868,26 +860,19 @@
                           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)
-  (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
-      (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
@@ -1033,6 +1018,9 @@
 (define-builtin expt (x y)
   `(method-call |Math| "pow" ,x ,y))
 
+(define-builtin sqrt (x)
+  `(method-call |Math| "sqrt" ,x))
+
 (define-builtin float-to-string (x)
   `(call |make_lisp_string| (method-call ,x |toString|)))