From 4d14d395d4861ee6a82d4ef9ee54e946cf3c46bc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 2 May 2016 21:36:56 -0400 Subject: - 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. --- src/lux/analyser.clj | 7 ----- src/lux/analyser/base.clj | 1 - src/lux/analyser/host.clj | 62 ++++++++++++++++-------------------- src/lux/analyser/parser.clj | 18 ----------- src/lux/compiler.clj | 3 -- src/lux/compiler/host.clj | 77 ++++++++++++++------------------------------- src/lux/optimizer.clj | 4 --- 7 files changed, 50 insertions(+), 122 deletions(-) (limited to 'src') 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 [ ] (let [output-type (&/$DataT &/$Nil)] (defn [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 [ ] (defn [compile _?value] (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] @@ -1223,10 +1169,33 @@ (.visitMethodInsn Opcodes/INVOKESPECIAL class* "" 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)) -- cgit v1.2.3