aboutsummaryrefslogtreecommitdiff
path: root/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'luxc')
-rw-r--r--luxc/src/lux/analyser/lux.clj3
-rw-r--r--luxc/src/lux/analyser/proc/jvm.clj90
-rw-r--r--luxc/src/lux/base.clj14
-rw-r--r--luxc/src/lux/compiler/js/rt.clj5
-rw-r--r--luxc/src/lux/compiler/jvm/proc/host.clj51
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj38
6 files changed, 47 insertions, 154 deletions
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 (= "<init>" 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 [<name> <op> <unwrap> <wrap>]
(defn <name> [compile _?value special-args]
(|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
@@ -996,31 +971,6 @@
(.visitMethodInsn Opcodes/INVOKESPECIAL class* "<init>" 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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 13:12:50 +0000