From 77bdb17e48f5eaab34178db8765e41073d91c7ad Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 28 Mar 2017 20:49:00 -0400 Subject: - Removed the ["jvm" "try"] procedure. - No longer checking for catched exceptions (this is now the programmer's sole responsibility). - Now handling a new corner-case when patten-matching against sums. --- luxc/src/lux/analyser/lux.clj | 3 +- luxc/src/lux/analyser/proc/jvm.clj | 90 +++++---------------------------- luxc/src/lux/base.clj | 14 ----- luxc/src/lux/compiler/js/rt.clj | 5 +- luxc/src/lux/compiler/jvm/proc/host.clj | 51 ------------------- luxc/src/lux/compiler/jvm/rt.clj | 38 +++++++++++--- 6 files changed, 47 insertions(+), 154 deletions(-) (limited to 'luxc/src') diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 304705331..1eecaf577 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -542,8 +542,7 @@ )) (defn analyse-lambda [analyse exo-type ?self ?arg ?body] - (|do [output (&/with-no-catches - (analyse-lambda** analyse exo-type ?self ?arg ?body))] + (|do [output (analyse-lambda** analyse exo-type ?self ?arg ?body)] (return (&/|list output)))) (defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta] diff --git a/luxc/src/lux/analyser/proc/jvm.clj b/luxc/src/lux/analyser/proc/jvm.clj index 72b871686..1d6075136 100644 --- a/luxc/src/lux/analyser/proc/jvm.clj +++ b/luxc/src/lux/analyser/proc/jvm.clj @@ -19,50 +19,6 @@ (:import (java.lang.reflect Type TypeVariable))) ;; [Utils] -(defn ^:private ensure-catching [exceptions*] - "(-> (List Text) (Lux Null))" - (|do [class-loader &/loader] - (fn [state] - (|let [exceptions (&/|map #(Class/forName % true class-loader) exceptions*) - catching (->> state - (&/get$ &/$catching) - (&/|map #(Class/forName % true class-loader)))] - (if-let [missing-ex (&/fold (fn [prev ^Class now] - (or prev - (cond (or (.isAssignableFrom java.lang.RuntimeException now) - (.isAssignableFrom java.lang.Error now)) - nil - - (&/fold (fn [found? ^Class ex-catch] - (or found? - (.isAssignableFrom ex-catch now))) - false - catching) - nil - - :else - now))) - nil - exceptions)] - ((&/fail-with-loc (str "[Analyser Error] Unhandled exception: " missing-ex)) - state) - (&/return* state nil))) - ))) - -(defn ^:private with-catches [catches body] - "(All [a] (-> (List Text) (Lux a) (Lux a)))" - (fn [state] - (let [old-catches (&/get$ &/$catching state) - state* (&/update$ &/$catching (partial &/|++ catches) state)] - (|case (&/run-state body state*) - (&/$Left msg) - (&/$Left msg) - - (&/$Right state** output) - (&/$Right (&/T [(&/set$ &/$catching old-catches state**) - output])))) - )) - (defn ^:private ensure-object [type] "(-> Type (Lux (, Text (List Type))))" (|case type @@ -317,11 +273,9 @@ ?ctor-args) =body (&/with-type-env full-env (&&env/with-local &&/jvm-this class-type - (&/with-no-catches - (with-catches (&/|map &host-generics/gclass->class-name ?exceptions) - (&/fold (method-input-folder full-env) - (&&/analyse-1 analyse output-type ?body) - (&/|reverse ?inputs))))))] + (&/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,11 +284,9 @@ output-type (generic-class->type full-env ?output) =body (&/with-type-env full-env (&&env/with-local &&/jvm-this class-type - (&/with-no-catches - (with-catches (&/|map &host-generics/gclass->class-name ?exceptions) - (&/fold (method-input-folder full-env) - (&&/analyse-1 analyse output-type ?body) - (&/|reverse ?inputs))))))] + (&/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) @@ -344,11 +296,9 @@ output-type (generic-class->type full-env ?output) =body (&/with-type-env full-env (&&env/with-local &&/jvm-this class-type - (&/with-no-catches - (with-catches (&/|map &host-generics/gclass->class-name ?exceptions) - (&/fold (method-input-folder full-env) - (&&/analyse-1 analyse output-type ?body) - (&/|reverse ?inputs))))))] + (&/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) @@ -356,11 +306,9 @@ :let [full-env method-env] output-type (generic-class->type full-env ?output) =body (&/with-type-env full-env - (&/with-no-catches - (with-catches (&/|map &host-generics/gclass->class-name ?exceptions) - (&/fold (method-input-folder full-env) - (&&/analyse-1 analyse output-type ?body) - (&/|reverse ?inputs)))))] + (&/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) @@ -685,7 +633,6 @@ =ex (&&/analyse-1+ analyse ?ex) _ (&type/check (&/$HostT "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex)) [throw-class throw-params] (ensure-object (&&/expr-type* =ex)) - _ (ensure-catching (&/|list throw-class)) _cursor &/cursor _ (&type/check exo-type &type/Bottom)] (return (&/|list (&&/|meta exo-type _cursor @@ -785,7 +732,6 @@ [gret exceptions parent-gvars gvars gargs] (if (= "" method) (return (&/T [Void/TYPE &/$Nil &/$Nil &/$Nil &/$Nil])) (&host/lookup-virtual-method class-loader !class! method classes)) - _ (ensure-catching exceptions) =object (&&/analyse-1+ analyse object) [sub-class sub-params] (ensure-object (&&/expr-type* =object)) (&/$HostT super-class* super-params*) (&host-type/->super-type &type/existential class-loader !class! (if (= sub-class class) @@ -811,7 +757,6 @@ :let [args ?values] class-loader &/loader [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader !class! method classes) - _ (ensure-catching exceptions) :let [gtype-env (&/|table)] [output-type =args] (analyse-method-call-helper analyse exo-type gret gtype-env gvars gargs args) _cursor &/cursor] @@ -842,22 +787,12 @@ :let [args ?values] class-loader &/loader [exceptions gvars gargs] (&host/lookup-constructor class-loader !class! classes) - _ (ensure-catching exceptions) [output-type =args] (analyse-jvm-new-helper analyse class (&/|table) gvars gargs args) _ (&type/check exo-type output-type) _cursor &/cursor] (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["jvm" "new"]) =args (&/|list class classes))))))) -(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 (&/$HostT "java.lang.Exception" &/$Nil) exo-type) ?catch) - _cursor &/cursor] - (return (&/|list (&&/|meta exo-type _cursor - (&&/$proc (&/T ["jvm" "try"]) (&/|list =body =catch) (&/|list))))))) - (defn ^:private analyse-jvm-instanceof [analyse exo-type class ?values] (|do [:let [(&/$Cons object (&/$Nil)) ?values] =object (&&/analyse-1+ analyse object) @@ -966,7 +901,6 @@ (case proc "synchronized" (analyse-jvm-synchronized analyse exo-type ?values) "load-class" (analyse-jvm-load-class analyse exo-type ?values) - "try" (analyse-jvm-try analyse exo-type ?values) "throw" (analyse-jvm-throw analyse exo-type ?values) "null?" (analyse-jvm-null? analyse exo-type ?values) "null" (analyse-jvm-null analyse exo-type ?values) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 27de43765..582e2c96f 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -152,7 +152,6 @@ "expected" "seed" "scope-type-vars" - "catching" "host"]) ;; Compiler @@ -803,17 +802,6 @@ _ class-name)))) -(defn with-no-catches [body] - "(All [a] (-> (Lux a) (Lux a)))" - (fn [state] - (let [old-catching (->> state (get$ $catching))] - (|case (body (set$ $catching $Nil state)) - ($Right state* output) - (return* (set$ $catching old-catching state*) output) - - ($Left msg) - (fail* msg))))) - (defn default-compiler-info [mode] (T [;; compiler-version compiler-version @@ -840,8 +828,6 @@ 0 ;; scope-type-vars $Nil - ;; catching - $Nil ;; "lux;host" host-data] )) diff --git a/luxc/src/lux/compiler/js/rt.clj b/luxc/src/lux/compiler/js/rt.clj index b2104cb1b..889ced291 100644 --- a/luxc/src/lux/compiler/js/rt.clj +++ b/luxc/src/lux/compiler/js/rt.clj @@ -57,7 +57,10 @@ (str "if(sum[1] === wantsLast) {" extact-match "}" "else {" recursion-test "}") "}" - "else if(wantedTag > sum[0]) {" recursion-test "}" + (str "else if(wantedTag > sum[0]) {" recursion-test "}") + (str "else if(wantedTag < sum[0] && wantsLast === '') {" + "return [(sum[0]-wantedTag),sum[1],sum[2]];" + "}") "else { " no-match " }" "})")) }) diff --git a/luxc/src/lux/compiler/jvm/proc/host.clj b/luxc/src/lux/compiler/jvm/proc/host.clj index 365a26937..2c5bbc6cd 100644 --- a/luxc/src/lux/compiler/jvm/proc/host.clj +++ b/luxc/src/lux/compiler/jvm/proc/host.clj @@ -507,31 +507,6 @@ (.visitEnd =interface))]] (&&/save-class! interface-name (.toByteArray =interface)))) -(defn ^:private compile-jvm-try [compile ?values special-args] - (|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values - ;; (&/$Nil) special-args - ] - ^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* - (.visitTypeInsn Opcodes/CHECKCAST &&/function-class) - (.visitInsn Opcodes/SWAP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))] - :let [_ (.visitLabel *writer* $end)]] - (return nil))) - (do-template [ ] (defn [compile _?value special-args] (|do [:let [(&/$Cons ?value (&/$Nil)) _?value] @@ -996,31 +971,6 @@ (.visitMethodInsn Opcodes/INVOKESPECIAL class* "" init-sig))]] (return nil))) -(defn ^:private compile-jvm-try [compile ?values special-args] - (|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values - ;; (&/$Nil) special-args - ] - ^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* - (.visitTypeInsn Opcodes/CHECKCAST &&/function-class) - (.visitInsn Opcodes/SWAP) - (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))] - :let [_ (.visitLabel *writer* $end)]] - (return nil))) - (defn ^:private compile-jvm-load-class [compile ?values special-args] (|do [:let [(&/$Cons _class-name (&/$Cons ?output-type (&/$Nil))) special-args] ^MethodVisitor *writer* &/get-writer @@ -1046,7 +996,6 @@ "synchronized" (compile-jvm-synchronized compile ?values special-args) "load-class" (compile-jvm-load-class compile ?values special-args) "instanceof" (compile-jvm-instanceof compile ?values special-args) - "try" (compile-jvm-try compile ?values special-args) "new" (compile-jvm-new compile ?values special-args) "invokestatic" (compile-jvm-invokestatic compile ?values special-args) "invokeinterface" (compile-jvm-invokeinterface compile ?values special-args) diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 97c7d849c..a98cf5b20 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -180,7 +180,25 @@ $just-return (new Label) $then (new Label) $further (new Label) - $not-right (new Label)] + $shorten (new Label) + $not-right (new Label) + failure (fn [^MethodVisitor writer] + (doto writer + (.visitInsn Opcodes/POP2) + (.visitInsn Opcodes/ACONST_NULL) + (.visitInsn Opcodes/ARETURN))) + shortened (fn [^MethodVisitor writer] + (doto writer + ;; Get Tag + (.visitVarInsn Opcodes/ALOAD 0) (.visitLdcInsn (int 0)) (.visitInsn Opcodes/AALOAD) + ;; Shorten tag + &&/unwrap-int (.visitVarInsn Opcodes/ILOAD 1) (.visitInsn Opcodes/ISUB) + ;; Get flag + (.visitVarInsn Opcodes/ALOAD 0) (.visitLdcInsn (int 1)) (.visitInsn Opcodes/AALOAD) + ;; Get value + (.visitVarInsn Opcodes/ALOAD 0) (.visitLdcInsn (int 2)) (.visitInsn Opcodes/AALOAD) + ;; Build sum + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")))] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_get" "([Ljava/lang/Object;ILjava/lang/Object;)Ljava/lang/Object;" nil nil) (.visitCode) (.visitLabel $begin) @@ -193,9 +211,9 @@ (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; tag, sum-tag (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag (.visitJumpInsn Opcodes/IF_ICMPGT $further) ;; tag, sum-tag - (.visitInsn Opcodes/POP2) - (.visitInsn Opcodes/ACONST_NULL) - (.visitInsn Opcodes/ARETURN) + (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag + (.visitJumpInsn Opcodes/IF_ICMPLT $shorten) ;; tag, sum-tag + failure (.visitLabel $then) ;; tag, sum-tag (.visitVarInsn Opcodes/ALOAD 2) ;; tag, sum-tag, wants-last? (.visitVarInsn Opcodes/ALOAD 0) @@ -209,6 +227,12 @@ (.visitLdcInsn (int 2)) (.visitInsn Opcodes/AALOAD) (.visitInsn Opcodes/ARETURN) + (.visitLabel $shorten) + (.visitVarInsn Opcodes/ALOAD 2) + (.visitJumpInsn Opcodes/IFNULL $not-right) + (.visitInsn Opcodes/POP2) + shortened + (.visitInsn Opcodes/ARETURN) (.visitLabel $further) ;; tag, sum-tag (.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum-tag, sum (.visitLdcInsn (int 1)) ;; tag, sum-tag, sum, last-index? @@ -223,9 +247,7 @@ (.visitVarInsn Opcodes/ISTORE 1) ;; (.visitJumpInsn Opcodes/GOTO $begin) (.visitLabel $not-right) ;; tag, sum-tag - (.visitInsn Opcodes/POP2) - (.visitInsn Opcodes/ACONST_NULL) - (.visitInsn Opcodes/ARETURN) + failure (.visitMaxs 0 0) (.visitEnd))) ;; I commented-out some parts because a null-check was @@ -1455,7 +1477,7 @@ (.visitInsn Opcodes/ARETURN) (.visitLabel $to) (.visitLabel $handler) ;; T - (.visitLdcInsn (->> #'&/$None meta ::&/idx int)) ;; TI + (.visitLdcInsn (->> #'&/$Left meta ::&/idx int)) ;; TI (.visitInsn Opcodes/ACONST_NULL) ;; TI? swap2x1 ;; I?T (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "toString" "()Ljava/lang/String;") ;; I?S -- cgit v1.2.3