diff options
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 15 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 12 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/rt.clj | 23 | ||||
| -rw-r--r-- | stdlib/source/lux/test.lux | 5 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/char.lux | 3 |
5 files changed, 51 insertions, 7 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 050877ed5..9a295b1eb 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -17,6 +17,18 @@ (return (&/|list (&&/|meta exo-type _cursor (&&/$proc (&/T ["lux" "is"]) (&/|list =left =right) (&/|list))))))))) +(defn ^:private analyse-lux-try [analyse exo-type ?values] + (&type/with-var + (fn [$var] + (|do [:let [(&/$Cons op (&/$Nil)) ?values] + =op (&&/analyse-1 analyse (&/$AppT &type/IO $var) op) + _ (&type/check exo-type (&/$SumT &type/Text ;; lux;Left + $var ;; lux;Right + )) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["lux" "try"]) (&/|list =op) (&/|list))))))))) + (do-template [<name> <proc> <input-type> <output-type>] (defn <name> [analyse exo-type ?values] (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values] @@ -470,7 +482,8 @@ (case category "lux" (case proc - "is" (analyse-lux-is analyse exo-type ?values)) + "is" (analyse-lux-is analyse exo-type ?values) + "try" (analyse-lux-try analyse exo-type ?values)) "io" (case proc diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index b7e80dd2e..d434e0365 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -179,6 +179,15 @@ (.visitLabel $end))]] (return nil))) +(defn ^:private compile-lux-try [compile ?values special-args] + (|do [:let [(&/$Cons ?op (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?op) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST "lux/Function") + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "runTry" "(Llux/Function;)[Ljava/lang/Object;"))]] + (return nil))) + (do-template [<name> <opcode> <unwrap> <wrap>] (defn <name> [compile ?values special-args] (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values] @@ -878,7 +887,8 @@ (case category "lux" (case proc - "is" (compile-lux-is compile ?values special-args)) + "is" (compile-lux-is compile ?values special-args) + "try" (compile-lux-try compile ?values special-args)) "io" (case proc diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj index 0f86325f2..97c7d849c 100644 --- a/luxc/src/lux/compiler/jvm/rt.clj +++ b/luxc/src/lux/compiler/jvm/rt.clj @@ -1440,6 +1440,29 @@ (.visitInsn Opcodes/ARETURN) (.visitMaxs 0 0) (.visitEnd)) + _ (let [$from (new Label) + $to (new Label) + $handler (new Label)] + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "runTry" "(Llux/Function;)[Ljava/lang/Object;" nil nil) + (.visitCode) + (.visitTryCatchBlock $from $to $handler "java/lang/Throwable") + (.visitLabel $from) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitInsn Opcodes/ACONST_NULL) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "lux/Function" &&/apply-method (&&/apply-signature 1)) + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;") + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitLabel $to) + (.visitLabel $handler) ;; T + (.visitLdcInsn (->> #'&/$None meta ::&/idx int)) ;; TI + (.visitInsn Opcodes/ACONST_NULL) ;; TI? + swap2x1 ;; I?T + (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "toString" "()Ljava/lang/String;") ;; I?S + (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;") + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd))) _ (doto =class (compile-LuxRT-pm-methods) (compile-LuxRT-adt-methods) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index bab513cc4..d953b7d65 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -13,8 +13,7 @@ text/format [error #- fail "Error/" Monad<Error>]) [io #- run] - ["R" random] - [host #- try])) + ["R" random])) ## [Host] (def: now @@ -156,7 +155,7 @@ (def: #hidden (try-body lazy-body) (-> (IO Test) Test) - (case (host;try (io;run lazy-body)) + (case (_lux_proc ["lux" "try"] [lazy-body]) (#;Right output) output diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux index 67332f282..88a5d86ae 100644 --- a/stdlib/test/test/lux/data/char.lux +++ b/stdlib/test/test/lux/data/char.lux @@ -6,8 +6,7 @@ [text] text/format) ["R" random] - pipe - [host #- try]) + pipe) lux/test) (test: "Char operations" |