aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/test/program.lux5
-rw-r--r--new-luxc/test/test/luxc/common.lux120
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux352
3 files changed, 3 insertions, 474 deletions
diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux
index 48cbd3aef..5600c323d 100644
--- a/new-luxc/source/test/program.lux
+++ b/new-luxc/source/test/program.lux
@@ -18,14 +18,14 @@
["." structure]
["." reference]
["." case]
- ["." function]]]]
+ ["." function]
+ ["." common]]]]
{1
["." /]}
## [test
## [luxc
## [lang
## [translation
- ## ## ["_.T" common]
## ## ["_.T" jvm]
## ## ["_.T" js]
## ## ["_.T" lua]
@@ -46,6 +46,7 @@
(reference.spec runner definer)
(case.spec runner)
(function.spec runner)
+ (common.spec runner)
))
(program: args
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
deleted file mode 100644
index a68e2824c..000000000
--- a/new-luxc/test/test/luxc/common.lux
+++ /dev/null
@@ -1,120 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]]
- ["." io (#+ IO)]
- [data
- [error (#+ Error)]]
- [compiler
- [default
- ["." reference]
- ["." phase
- ["." synthesis (#+ Synthesis)]
- ["." translation]
- [extension
- ["." bundle]]]]]]
- [luxc
- [lang
- [host
- [jvm (#+ Inst State Operation Phase Bundle)]]
- [translation
- ["." jvm
- ["._jvm" runtime]
- ["._jvm" expression]
- [procedure
- ["._jvm" common]]]
- ## [js]
- ## (js ["._js" expression]
- ## ["._js" runtime])
- ## [lua]
- ## (lua ["._lua" expression]
- ## ["._lua" runtime])
- ## [ruby]
- ## (ruby ["._ruby" expression]
- ## ["._ruby" runtime])
- ## [python]
- ## (python ["._python" expression]
- ## ["._python" runtime])
- ## [r]
- ## (r ["._r" expression]
- ## ["._r" runtime])
- ## [scheme]
- ## (scheme ["._scheme" expression]
- ## ["._scheme" runtime])
- ## [common-lisp]
- ## (common-lisp ["._common-lisp" expression]
- ## ["._common-lisp" runtime])
- ## [php]
- ## (php ["._php" expression]
- ## ["._php" runtime])
- ]]])
-
-(type: #export Runner (-> Synthesis (Error Any)))
-(type: #export Definer (-> Name Synthesis (Error Any)))
-
-(template [<name> <host>]
- [(def: #export <name>
- (IO State)
- (:: io.Monad<IO> map translation.state <host>))]
-
- [init-jvm jvm.init]
- ## [init-js js.init]
- ## [init-lua lua.init]
- ## [init-ruby ruby.init]
- ## [init-python python.init]
- ## [init-r r.init]
- ## [init-scheme scheme.init]
- ## [init-common-lisp common-lisp.init]
- ## [init-php php.init]
- )
-
-(def: (runner generate-runtime translate bundle state)
- (-> (Operation Any) Phase Bundle (IO State)
- Runner)
- (function (_ valueS)
- (|> (do phase.Monad<Operation>
- [_ generate-runtime
- program (translate valueS)]
- (translation.evaluate! "runner" program))
- translation.with-buffer
- (phase.run [bundle (io.run state)]))))
-
-(def: (definer generate-runtime translate bundle state)
- (-> (Operation Any) Phase Bundle (IO State) Definer)
- (function (_ lux-name valueS)
- (|> (do phase.Monad<Operation>
- [_ generate-runtime
- valueH (translate valueS)
- [host-name host-value] (translation.define! lux-name valueH)
- _ (translation.learn lux-name host-name)
- program (translate (synthesis.constant lux-name))]
- (translation.evaluate! "definer" program))
- translation.with-buffer
- (phase.run [bundle (io.run state)]))))
-
-(def: #export run-jvm (runner runtime_jvm.translate expression_jvm.translate common_jvm.bundle init-jvm))
-(def: #export def-jvm (definer runtime_jvm.translate expression_jvm.translate common_jvm.bundle init-jvm))
-
-## (def: #export run-js (runner runtime_js.translate expression_js.translate bundle.empty init-js))
-## (def: #export def-js (definer runtime_js.translate expression_js.translate bundle.empty init-js))
-
-## (def: #export run-lua (runner runtime_lua.translate expression_lua.translate bundle.empty init-lua))
-## (def: #export def-lua (definer runtime_lua.translate expression_lua.translate bundle.empty init-lua))
-
-## (def: #export run-ruby (runner runtime_ruby.translate expression_ruby.translate bundle.empty init-ruby))
-## (def: #export def-ruby (definer runtime_ruby.translate expression_ruby.translate bundle.empty init-ruby))
-
-## (def: #export run-python (runner runtime_python.translate expression_python.translate bundle.empty init-python))
-## (def: #export def-python (definer runtime_python.translate expression_python.translate bundle.empty init-python))
-
-## (def: #export run-r (runner runtime_r.translate expression_r.translate bundle.empty init-r))
-## (def: #export def-r (definer runtime_r.translate expression_r.translate bundle.empty init-r))
-
-## (def: #export run-scheme (runner runtime_scheme.translate expression_scheme.translate bundle.empty init-scheme))
-## (def: #export def-scheme (definer runtime_scheme.translate expression_scheme.translate bundle.empty init-scheme))
-
-## (def: #export run-common-lisp (runner runtime_common-lisp.translate expression_common-lisp.translate bundle.empty init-common-lisp))
-## (def: #export def-common-lisp (definer runtime_common-lisp.translate expression_common-lisp.translate bundle.empty init-common-lisp))
-
-## (def: #export run-php (runner runtime_php.translate expression_php.translate bundle.empty init-php))
-## (def: #export def-php (definer runtime_php.translate expression_php.translate bundle.empty init-php))
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
deleted file mode 100644
index 1e671aa96..000000000
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ /dev/null
@@ -1,352 +0,0 @@
-(.module:
- [lux #*
- [control
- [monad (#+ do)]
- pipe]
- [data
- ["." error (#+ Error)]
- [bit ("bit/." Equivalence<Bit>)]
- [number ("frac/." Number<Frac> Interval<Frac>)
- ["." i64]]
- ["." text ("text/." Equivalence<Text>)
- format]
- [collection
- ["." list]]]
- [math
- ["r" random (#+ Random)]]
- [compiler
- [default
- ["." reference]
- [phase
- ["." synthesis]]]]
- test]
- [test
- [luxc
- ["." common (#+ Runner)]]]
- [//
- ["&" function]])
-
-(def: (bit-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param r.i64
- subject r.i64]
- (with-expansions [<binary> (template [<name> <reference> <param-expr>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject)
- (synthesis.i64 param))))
- (case> (#error.Success valueT)
- (n/= (<reference> param subject) (:coerce Nat valueT))
-
- (#error.Error error)
- #0)
- (let [param <param-expr>])))]
-
- ["lux bit and" i64.and param]
- ["lux bit or" i64.or param]
- ["lux bit xor" i64.xor param]
- ["lux bit left-shift" i64.left-shift (n/% 64 param)]
- ["lux bit logical-right-shift" i64.logical-right-shift (n/% 64 param)]
- )]
- ($_ seq
- <binary>
- (test "lux bit arithmetic-right-shift"
- (|> (run (#synthesis.Extension "lux bit arithmetic-right-shift"
- (list (synthesis.i64 subject)
- (synthesis.i64 param))))
- (case> (#error.Success valueT)
- ("lux i64 ="
- (i64.arithmetic-right-shift param subject)
- (:coerce I64 valueT))
-
- (#error.Error error)
- #0)
- (let [param (n/% 64 param)])))
- ))))
-
-(def: (i64-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not)))
- subject r.i64]
- (`` ($_ seq
- (~~ (template [<name> <type> <prepare> <comp> <subject-expr>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject))))
- (case> (#error.Success valueT)
- (<comp> (<prepare> subject) (:coerce <type> valueT))
-
- (#error.Error error)
- #0)
- (let [subject <subject-expr>])))]
-
- ["lux i64 to-f64" Frac int-to-frac f/= subject]
- ["lux i64 char" Text (|>> (:coerce Nat) text.from-code) text/= (|> subject
- (:coerce Nat)
- (n/% (i64.left-shift 8 1))
- (:coerce Int))]
- ))
- (~~ (template [<name> <reference> <outputT> <comp>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject)
- (synthesis.i64 param))))
- (case> (#error.Success valueT)
- (<comp> (<reference> param subject) (:coerce <outputT> valueT))
-
- (#error.Error error)
- #0)))]
-
- ["lux i64 +" i/+ Int i/=]
- ["lux i64 -" i/- Int i/=]
- ["lux i64 *" i/* Int i/=]
- ["lux i64 /" i// Int i/=]
- ["lux i64 %" i/% Int i/=]
- ["lux i64 =" i/= Bit bit/=]
- ["lux i64 <" i/< Bit bit/=]
- ))
- ))))
-
-(def: simple-frac
- (Random Frac)
- (|> r.nat (:: r.Monad<Random> map (|>> (n/% 1000) .int int-to-frac))))
-
-(def: (f64-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param (|> ..simple-frac (r.filter (|>> (f/= +0.0) not)))
- subject ..simple-frac]
- (`` ($_ seq
- (~~ (template [<name> <reference> <comp>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
- (synthesis.f64 param))))
- (&.check (<reference> param subject))))]
-
- ["lux f64 +" f/+ f/=]
- ["lux f64 -" f/- f/=]
- ["lux f64 *" f/* f/=]
- ["lux f64 /" f// f/=]
- ["lux f64 %" f/% f/=]
- ))
- (~~ (template [<name> <text>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject)
- (synthesis.f64 param))))
- (case> (#error.Success valueV)
- (bit/= (<text> param subject)
- (:coerce Bit valueV))
-
- _
- #0)))]
-
- ["lux f64 =" f/=]
- ["lux f64 <" f/<]
- ))
- (~~ (template [<name> <reference>]
- [(test <name>
- (|> (run (#synthesis.Extension <name> (list)))
- (&.check <reference>)))]
-
- ["lux f64 min" frac/bottom]
- ["lux f64 max" frac/top]
- ["lux f64 smallest" ("lux frac smallest")]
- ))
- (test "\"lux f64 to-i64\" && \"lux i64 to-f64\""
- (|> (run (|> subject synthesis.f64
- (list) (#synthesis.Extension "lux f64 to-i64")
- (list) (#synthesis.Extension "lux i64 to-f64")))
- (&.check subject)))
- ))))
-
-(def: (text-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [sample-size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))
- sample-lower (r.ascii/lower-alpha sample-size)
- sample-upper (r.ascii/upper-alpha sample-size)
- sample-alpha (|> (r.ascii/alpha sample-size)
- (r.filter (|>> (text/= sample-upper) not)))
- char-idx (|> r.nat (:: @ map (n/% sample-size)))
- #let [sample-lowerS (synthesis.text sample-lower)
- sample-upperS (synthesis.text sample-upper)
- sample-alphaS (synthesis.text sample-alpha)
- concatenatedS (#synthesis.Extension "lux text concat" (list sample-lowerS sample-upperS))
- pre-rep-once (format sample-lower sample-upper)
- post-rep-once (format sample-lower sample-alpha)
- pre-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-upper))
- post-rep-all (|> (list.repeat sample-size sample-lower) (text.join-with sample-alpha))]]
- ($_ seq
- (test "Can compare texts for equality."
- (and (|> (run (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS)))
- (case> (#error.Success valueV)
- (:coerce Bit valueV)
-
- _
- #0))
- (|> (run (#synthesis.Extension "lux text =" (list sample-lowerS sample-upperS)))
- (case> (#error.Success valueV)
- (not (:coerce Bit valueV))
-
- _
- #0))))
- (test "Can compare texts for order."
- (|> (run (#synthesis.Extension "lux text <" (list sample-upperS sample-lowerS)))
- (case> (#error.Success valueV)
- (:coerce Bit valueV)
-
- (#error.Error error)
- #0)))
- (test "Can get length of text."
- (|> (run (#synthesis.Extension "lux text size" (list sample-lowerS)))
- (case> (#error.Success valueV)
- (n/= sample-size (:coerce Nat valueV))
-
- _
- #0)))
- (test "Can concatenate text."
- (|> (run (#synthesis.Extension "lux text size" (list concatenatedS)))
- (case> (#error.Success valueV)
- (n/= (n/* 2 sample-size) (:coerce Nat valueV))
-
- _
- #0)))
- (test "Can find index of sub-text."
- (and (|> (run (#synthesis.Extension "lux text index"
- (list concatenatedS sample-lowerS
- (synthesis.i64 +0))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Nat) valueV) (#.Some valueV)])
- (n/= 0 valueV)
-
- _
- #0))
- (|> (run (#synthesis.Extension "lux text index"
- (list concatenatedS sample-upperS
- (synthesis.i64 +0))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Nat) valueV) (#.Some valueV)])
- (n/= sample-size valueV)
-
- _
- #0))))
- (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit)
- (function (_ from to expected)
- (|> (run (#synthesis.Extension "lux text clip"
- (list concatenatedS
- (synthesis.i64 from)
- (synthesis.i64 to))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Text) valueV) (#.Some valueV)])
- (text/= expected valueV)
-
- _
- #0))))]
- (test "Can clip text to extract sub-text."
- (and (test-clip 0 sample-size sample-lower)
- (test-clip sample-size (n/* 2 sample-size) sample-upper))))
- (test "Can extract individual characters from text."
- (|> (run (#synthesis.Extension "lux text char"
- (list sample-lowerS
- (synthesis.i64 char-idx))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Maybe Int) valueV) (#.Some valueV)])
- (text.contains? ("lux int char" valueV)
- sample-lower)
-
- _
- #0)))
- )))
-
-(def: (io-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [message (r.ascii/alpha 5)]
- ($_ seq
- (test "Can log messages."
- (|> (run (#synthesis.Extension "lux io log"
- (list (synthesis.text (format "LOG: " message)))))
- (case> (#error.Success valueV)
- #1
-
- (#error.Error error)
- #0)))
- (test "Can throw runtime errors."
- (and (|> (run (#synthesis.Extension "lux try"
- (list (synthesis.function/abstraction
- {#synthesis.environment (list)
- #synthesis.arity 1
- #synthesis.body (#synthesis.Extension "lux io error"
- (list (synthesis.text message)))}))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Error Text) valueV) (#error.Error error)])
- (text.contains? message error)
-
- _
- #0))
- (|> (run (#synthesis.Extension "lux try"
- (list (synthesis.function/abstraction
- {#synthesis.environment (list)
- #synthesis.arity 1
- #synthesis.body (synthesis.text message)}))))
- (case> (^multi (#error.Success valueV)
- [(:coerce (Error Text) valueV) (#error.Success valueV)])
- (text/= message valueV)
-
- _
- #0))))
- (test "Can obtain current time in milli-seconds."
- (|> (run (synthesis.tuple (list (#synthesis.Extension "lux io current-time" (list))
- (#synthesis.Extension "lux io current-time" (list)))))
- (case> (#error.Success valueV)
- (let [[pre post] (:coerce [Nat Nat] valueV)]
- (n/>= pre post))
-
- (#error.Error error)
- #0)))
- )))
-
-(def: (all-specs run)
- (-> Runner Test)
- ($_ seq
- (bit-spec run)
- (i64-spec run)
- (f64-spec run)
- (text-spec run)
- (io-spec run)
- ))
-
-(context: "[JVM] Common extensions."
- (<| (times 100)
- (all-specs common.run-jvm)))
-
-## (context: "[JS] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-js)))
-
-## (context: "[Lua] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-lua)))
-
-## (context: "[Ruby] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-ruby)))
-
-## (context: "[Python] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-python)))
-
-## (context: "[R] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-r)))
-
-## (context: "[Scheme] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-scheme)))
-
-## (context: "[Common Lisp] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-common-lisp)))
-
-## (context: "[PHP] Common extensions."
-## (<| (times 100)
-## (all-specs common.run-php)))