aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--luxc/src/lux/analyser/proc/common.clj19
-rw-r--r--luxc/src/lux/compiler/js/proc/common.clj8
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj23
-rw-r--r--stdlib/source/lux/test.lux15
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