diff options
| -rw-r--r-- | luxc/src/lux/analyser/proc/common.clj | 19 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/js/proc/common.clj | 8 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 23 | ||||
| -rw-r--r-- | stdlib/source/lux/test.lux | 15 |
4 files changed, 49 insertions, 16 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj index 7703aa8a6..c91074676 100644 --- a/luxc/src/lux/analyser/proc/common.clj +++ b/luxc/src/lux/analyser/proc/common.clj @@ -291,10 +291,18 @@ ^:private analyse-deg-to-real &type/Deg &type/Real ["deg" "to-real"] ^:private analyse-real-to-deg &type/Real &type/Deg ["real" "to-deg"] - ^:private analyse-lux-log &type/Text &/$UnitT ["io" "log"] - ^:private analyse-lux-error &type/Text &type/Bottom ["io" "error"] + ^:private analyse-io-log &type/Text &/$UnitT ["io" "log"] + ^:private analyse-io-error &type/Text &type/Bottom ["io" "error"] + ^:private analyse-io-exit &type/Int &type/Bottom ["io" "exit"] ) +(defn ^:private analyse-io-current-time [analyse exo-type ?values] + (|do [:let [(&/$Nil) ?values] + _ (&type/check exo-type &type/Int) + _cursor &/cursor] + (return (&/|list (&&/|meta exo-type _cursor + (&&/$proc (&/T ["io" "current-time"]) (&/|list) (&/|list))))))) + (defn ^:private analyse-array-new [analyse exo-type ?values] (|do [:let [(&/$Cons length (&/$Nil)) ?values] =length (&&/analyse-1 analyse &type/Nat length) @@ -468,8 +476,11 @@ "io" (case proc - "log" (analyse-lux-log analyse exo-type ?values) - "error" (analyse-lux-error analyse exo-type ?values)) + "log" (analyse-io-log analyse exo-type ?values) + "error" (analyse-io-error analyse exo-type ?values) + "exit" (analyse-io-exit analyse exo-type ?values) + "current-time" (analyse-io-current-time analyse exo-type ?values) + ) "text" (case proc diff --git a/luxc/src/lux/compiler/js/proc/common.clj b/luxc/src/lux/compiler/js/proc/common.clj index 11fb9fd95..284139248 100644 --- a/luxc/src/lux/compiler/js/proc/common.clj +++ b/luxc/src/lux/compiler/js/proc/common.clj @@ -402,12 +402,12 @@ ")") "}")))) -(defn ^:private compile-lux-log [compile ?values special-args] +(defn ^:private compile-io-log [compile ?values special-args] (|do [:let [(&/$Cons ?message (&/$Nil)) ?values] =message (compile ?message)] (return (str "LuxRT.log(" =message ")")))) -(defn ^:private compile-lux-error [compile ?values special-args] +(defn ^:private compile-io-error [compile ?values special-args] (|do [:let [(&/$Cons ?message (&/$Nil)) ?values] =message (compile ?message)] (return (str "LuxRT.error(" =message ")")))) @@ -420,8 +420,8 @@ "io" (case proc-name - "log" (compile-lux-log compile ?values special-args) - "error" (compile-lux-error compile ?values special-args)) + "log" (compile-io-log compile ?values special-args) + "error" (compile-io-error compile ?values special-args)) "text" (case proc-name diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index 0afcdc9e0..6a952e6d3 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -719,6 +719,24 @@ (.visitInsn Opcodes/ATHROW))]] (return nil))) +(defn ^:private compile-io-exit [compile ?values special-args] + (|do [:let [(&/$Cons ?code (&/$Nil)) ?values] + ^MethodVisitor *writer* &/get-writer + _ (compile ?code) + :let [_ (doto *writer* + &&/unwrap-long + (.visitInsn Opcodes/L2I) + (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/System" "exit" "(I)V"))]] + (return nil))) + +(defn ^:private compile-io-current-time [compile ?values special-args] + (|do [:let [(&/$Nil) ?values] + ^MethodVisitor *writer* &/get-writer + :let [_ (doto *writer* + (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/System" "currentTimeMillis" "()J") + &&/wrap-long)]] + (return nil))) + (do-template [<name> <field>] (defn <name> [compile ?values special-args] (|do [:let [(&/$Nil) ?values] @@ -867,7 +885,10 @@ "io" (case proc "log" (compile-io-log compile ?values special-args) - "error" (compile-io-error compile ?values special-args)) + "error" (compile-io-error compile ?values special-args) + "exit" (compile-io-exit compile ?values special-args) + "current-time" (compile-io-current-time compile ?values special-args) + ) "text" (case proc diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 82fcabed9..bab513cc4 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -17,12 +17,13 @@ [host #- try])) ## [Host] -(jvm-import java.lang.System - (#static exit [int] #io void) - (#static currentTimeMillis [] #io long)) +(def: now + (IO Int) + (io (_lux_proc ["io" "current-time"] []))) (do-template [<name> <signal>] - [(def: #hidden <name> (IO Unit) (System.exit <signal>))] + [(def: #hidden <name> (IO Bottom) + (io (_lux_proc ["io" "exit"] [<signal>])))] [exit 0] [die 1] @@ -51,9 +52,9 @@ [#let [test-runs (List/map (: (-> [Text (IO Test) Text] (Promise Nat)) (lambda [[module test description]] (do @ - [#let [pre (io;run (System.currentTimeMillis []))] + [#let [pre (io;run now)] outcome (io;run test) - #let [post (io;run (System.currentTimeMillis [])) + #let [post (io;run now) description+ (:: text;Codec<Text,Text> encode description)]] (case outcome (#;Left error) @@ -107,7 +108,7 @@ (def: #hidden (repeat ?seed times random-test) (-> (Maybe Nat) Nat (R;Random Test) Test) - (repeat' (default (int-to-nat (io;run (System.currentTimeMillis []))) + (repeat' (default (int-to-nat (io;run now)) ?seed) (case ?seed #;None times |