- Removed _jvm_try from the list of special forms.

- Fixed a bug when compiling method bodies where the list of thrown exceptions did not get excluded from the safety-check when analysing the bodies.

7 files changed, 50 insertions, 122 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index f2c238833..7e71ad922 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -117,13 +117,6 @@
                                          (&/$Nil)))))
     (&&host/analyse-jvm-instanceof analyse exo-type ?class ?object)
     
-    ;; Exceptions
-    (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_try")]
-                       (&/$Cons ?body
-                                ?handlers)))
-    (|do [catches+finally (&/fold% &&a-parser/parse-handler (&/T [&/$Nil &/$None]) ?handlers)]
-      (&&host/analyse-jvm-try analyse exo-type ?body catches+finally))
-
     _
     (aba4 analyse eval! compile-module compile-statement exo-type token)))
 
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 9f53e6843..651fb4cea 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -30,7 +30,6 @@
   ("jvm-instanceof" 1)
   ("jvm-class" 1)
   ("jvm-interface" 1)
-  ("jvm-try" 1)
   ("jvm-program" 1)
   )
 
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 1bee0739c..f80ae1266 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -12,6 +12,7 @@
                  [type :as &type]
                  [host :as &host])
             [lux.type.host :as &host-type]
+            [lux.host.generics :as &host-generics]
             (lux.analyser [base :as &&]
                           [lambda :as &&lambda]
                           [env :as &&env]
@@ -319,9 +320,10 @@
                                ?ctor-args)
             =body (&/with-type-env full-env
                     (&&env/with-local &&/jvm-this class-type
-                      (&/fold (method-input-folder full-env)
-                              (&&/analyse-1 analyse output-type ?body)
-                              (&/|reverse ?inputs))))]
+                      (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+                        (&/fold (method-input-folder full-env)
+                                (&&/analyse-1 analyse output-type ?body)
+                                (&/|reverse ?inputs)))))]
         (return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
       
       (&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -330,9 +332,10 @@
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
                     (&&env/with-local &&/jvm-this class-type
-                      (&/fold (method-input-folder full-env)
-                              (&&/analyse-1 analyse output-type ?body)
-                              (&/|reverse ?inputs))))]
+                      (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+                        (&/fold (method-input-folder full-env)
+                                (&&/analyse-1 analyse output-type ?body)
+                                (&/|reverse ?inputs)))))]
         (return (&/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
       
       (&/$OverridenMethodSyntax ?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -342,9 +345,10 @@
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
                     (&&env/with-local &&/jvm-this class-type
-                      (&/fold (method-input-folder full-env)
-                              (&&/analyse-1 analyse output-type ?body)
-                              (&/|reverse ?inputs))))]
+                      (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+                        (&/fold (method-input-folder full-env)
+                                (&&/analyse-1 analyse output-type ?body)
+                                (&/|reverse ?inputs)))))]
         (return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
 
       (&/$StaticMethodSyntax ?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
@@ -352,9 +356,10 @@
             :let [full-env method-env]
             output-type (generic-class->type full-env ?output)
             =body (&/with-type-env full-env
-                    (&/fold (method-input-folder full-env)
-                            (&&/analyse-1 analyse output-type ?body)
-                            (&/|reverse ?inputs)))]
+                    (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
+                      (&/fold (method-input-folder full-env)
+                              (&&/analyse-1 analyse output-type ?body)
+                              (&/|reverse ?inputs))))]
         (return (&/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
 
       (&/$AbstractMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output)
@@ -501,29 +506,6 @@
                                    )))
         ))))
 
-(defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally]
-  (|do [:let [[?catches ?finally] ?catches+?finally]
-        =catches (&/map% (fn [_catch_]
-                           (|do [:let [[?ex-class ?ex-arg ?catch-body] _catch_]
-                                 =catch-body (&&env/with-local ?ex-arg (&/$DataT ?ex-class &/$Nil)
-                                               (&&/analyse-1 analyse exo-type ?catch-body))
-                                 idx &&env/next-local-idx]
-                             (return (&/T [?ex-class idx =catch-body]))))
-                         ?catches)
-        :let [catched-exceptions (&/|map (fn [=catch]
-                                           (|let [[_c-class _ _] =catch]
-                                             _c-class))
-                                         =catches)]
-        =body (with-catches catched-exceptions
-                (&&/analyse-1 analyse exo-type ?body))
-        =finally (|case ?finally
-                   (&/$None)           (return &/$None)
-                   (&/$Some ?finally*) (|do [=finally (&&/analyse-1+ analyse ?finally*)]
-                                         (return (&/$Some =finally))))
-        _cursor &/cursor]
-    (return (&/|list (&&/|meta exo-type _cursor
-                               (&&/$jvm-try (&/T [=body =catches =finally])))))))
-
 (do-template [<name> <proc> <from-class> <to-class>]
   (let [output-type (&/$DataT <to-class> &/$Nil)]
     (defn <name> [analyse exo-type _?value]
@@ -926,10 +908,20 @@
     (return (&/|list (&&/|meta exo-type _cursor
                                (&&/$host (&/T ["jvm" "new"]) (&/|list class classes =args)))))))
 
+(defn ^:private analyse-jvm-try [analyse exo-type ?values]
+  (|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values]
+        =body (with-catches (&/|list "java.lang.Exception")
+                (&&/analyse-1 analyse exo-type ?body))
+        =catch (&&/analyse-1 analyse (&/$LambdaT (&/$DataT "java.lang.Exception" &/$Nil) exo-type) ?catch)
+        _cursor &/cursor]
+    (return (&/|list (&&/|meta exo-type _cursor
+                               (&&/$host (&/T ["jvm" "try"]) (&/|list =body =catch)))))))
+
 (defn analyse-host [analyse exo-type category proc ?values]
   (case category
     "jvm"
     (case proc
+      "try"          (analyse-jvm-try analyse exo-type ?values)
       "throw"        (analyse-jvm-throw analyse exo-type ?values)
       "monitorenter" (analyse-jvm-monitorenter analyse exo-type ?values)
       "monitorexit"  (analyse-jvm-monitorexit analyse exo-type ?values)
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index c1b8e2368..db41b5edb 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -99,24 +99,6 @@
     _
     (fail (str "[Analyser Error] Not constructor argument: " (&/show-ast ast)))))
 
-(defn parse-handler [catch+&finally+ token]
-  (|let [[catch+ finally+] catch+&finally+]
-    (|case token
-      [meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_catch")]
-                               (&/$Cons [_ (&/$TextS ?ex-class)]
-                                        (&/$Cons [_ (&/$SymbolS "" ?ex-arg)]
-                                                 (&/$Cons ?catch-body
-                                                          (&/$Nil))))))]
-      (return (&/T [(&/|++ catch+ (&/|list (&/T [?ex-class ?ex-arg ?catch-body]))) finally+]))
-
-      [meta (&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_finally")]
-                               (&/$Cons ?finally-body
-                                        (&/$Nil))))]
-      (return (&/T [catch+ (&/$Some ?finally-body)]))
-
-      _
-      (fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token))))))
-
 (let [failure (fail (str "[Analyser Error] Invalid annotation parameter."))]
   (defn ^:private parse-ann-param [param]
     (|case param
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 1015fdf9f..4ee8c0bf3 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -95,9 +95,6 @@
         (&&host/compile-host compile-expression ?proc-category ?proc-name ?args)
         
         ;; JVM
-        (&o/$jvm-try ?body ?catches ?finally)
-        (&&host/compile-jvm-try compile-expression ?body ?catches ?finally)
-
         (&o/$jvm-instanceof ?class ?object)
         (&&host/compile-jvm-instanceof compile-expression ?class ?object)
 
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 1178199c8..9b120c831 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -731,60 +731,6 @@
     (&&/save-class! (second (string/split &&/lux-utils-class #"/"))
                     (.toByteArray (doto =class .visitEnd)))))
 
-(defn compile-jvm-try [compile ?body ?catches ?finally]
-  (|do [^MethodVisitor *writer* &/get-writer
-        :let [$from (new Label)
-              $to (new Label)
-              $end (new Label)
-              $catch-finally (new Label)
-              compile-finally (|case ?finally
-                                (&/$Some ?finally*) (|do [_ (return nil)
-                                                          _ (compile ?finally*)
-                                                          :let [_ (doto *writer*
-                                                                    (.visitInsn Opcodes/POP)
-                                                                    (.visitJumpInsn Opcodes/GOTO $end))]]
-                                                      (return nil))
-                                (&/$None) (|do [_ (return nil)
-                                                :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]]
-                                            (return nil)))
-              catch-boundaries (&/|map (fn [_catch_]
-                                         (|let [[?ex-class ?ex-idx ?catch-body] _catch_]
-                                           (&/T [?ex-class (new Label) (new Label)])))
-                                       ?catches)
-              _ (doseq [catch-boundary (&/->seq catch-boundaries)]
-                  (|let [[?ex-class $handler-start $handler-end] catch-boundary]
-                    (doto *writer*
-                      (.visitTryCatchBlock $from $to $handler-start (&host-generics/->bytecode-class-name ?ex-class))
-                      (.visitTryCatchBlock $handler-start $handler-end $catch-finally nil))))
-              _ (.visitTryCatchBlock *writer* $from $to $catch-finally nil)]
-        :let [_ (.visitLabel *writer* $from)]
-        _ (compile ?body)
-        :let [_ (.visitLabel *writer* $to)]
-        _ compile-finally
-        handlers (&/map2% (fn [_catch_ _boundary_]
-                            (|do [:let [[?ex-class ?ex-idx ?catch-body] _catch_
-                                        [_ $handler-start $handler-end] _boundary_
-                                        _ (doto *writer*
-                                            (.visitLabel $handler-start)
-                                            (.visitVarInsn Opcodes/ASTORE ?ex-idx))]
-                                  _ (compile ?catch-body)
-                                  :let [_ (.visitLabel *writer* $handler-end)]]
-                              compile-finally))
-                          ?catches
-                          catch-boundaries)
-        :let [_ (.visitLabel *writer* $catch-finally)]
-        _ (|case ?finally
-            (&/$Some ?finally*) (|do [_ (compile ?finally*)
-                                      :let [_ (.visitInsn *writer* Opcodes/POP)]
-                                      :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
-                                  (return nil))
-            (&/$None) (|do [_ (return nil)
-                            :let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
-                        (return nil)))
-        :let [_ (.visitJumpInsn *writer* Opcodes/GOTO $end)]
-        :let [_ (.visitLabel *writer* $end)]]
-    (return nil)))
-
 (do-template [<name> <op> <from-class> <from-method> <from-sig> <to-class> <to-sig>]
   (defn <name> [compile _?value]
     (|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
@@ -1223,10 +1169,33 @@
                   (.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" init-sig))]]
     (return nil)))
 
+(defn ^:private compile-jvm-try [compile ?values]
+  (|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values]
+        ^MethodVisitor *writer* &/get-writer
+        :let [$from (new Label)
+              $to (new Label)
+              $handler (new Label)
+              $end (new Label)]
+        :let [_ (doto *writer*
+                  (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
+                  (.visitLabel $from))]
+        _ (compile ?body)
+        :let [_ (doto *writer*
+                  (.visitJumpInsn Opcodes/GOTO $end)
+                  (.visitLabel $to)
+                  (.visitLabel $handler))]
+        _ (compile ?catch)
+        :let [_ (doto *writer*
+                  (.visitInsn Opcodes/SWAP)
+                  (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))]
+        :let [_ (.visitLabel *writer* $end)]]
+    (return nil)))
+
 (defn compile-host [compile proc-category proc-name ?values]
   (case proc-category
     "jvm"
     (case proc-name
+      "try"             (compile-jvm-try compile ?values)
       "new"             (compile-jvm-new compile ?values)
       "invokestatic"    (compile-jvm-invokestatic compile ?values)
       "invokevirtual"   (compile-jvm-invokevirtual compile ?values)
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index 51e1c7f8a..c0aad5203 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -29,7 +29,6 @@
   ("jvm-instanceof" 1)
   ("jvm-class" 1)
   ("jvm-interface" 1)
-  ("jvm-try" 1)
   ("jvm-program" 1)
   )
 
@@ -91,9 +90,6 @@
     (&-base/$jvm-interface value)
     (return ($jvm-interface value))
     
-    (&-base/$jvm-try value)
-    (return ($jvm-try value))
-    
     (&-base/$jvm-program value)
     (return ($jvm-program value))