aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser.clj7
-rw-r--r--src/lux/analyser/base.clj1
-rw-r--r--src/lux/analyser/host.clj62
-rw-r--r--src/lux/analyser/parser.clj18
-rw-r--r--src/lux/compiler.clj3
-rw-r--r--src/lux/compiler/host.clj77
-rw-r--r--src/lux/optimizer.clj4
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))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 03:21:19 +0000