diff options
| -rw-r--r-- | new-luxc/source/test/program.lux | 5 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/common.lux | 120 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/common.lux | 352 | ||||
| -rw-r--r-- | stdlib/source/spec/compositor/generation/common.lux | 339 |
4 files changed, 342 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))) diff --git a/stdlib/source/spec/compositor/generation/common.lux b/stdlib/source/spec/compositor/generation/common.lux new file mode 100644 index 000000000..16ff5aab8 --- /dev/null +++ b/stdlib/source/spec/compositor/generation/common.lux @@ -0,0 +1,339 @@ +(.module: + [lux (#- i64) + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)]] + [data + ["." error (#+ Error)] + ["." bit ("#@." equivalence)] + [number + ["." i64]] + ["." text ("#@." equivalence) + format] + [collection + ["." list]]] + [math + ["r" random (#+ Random)]] + [tool + [compiler + ["." reference] + ["." synthesis]]]] + ["." // #_ + ["#." case] + ["/#" // (#+ Runner)]]) + +(def: sanitize + (-> Text Text) + (text.replace-all " " "_")) + +(def: (bit run) + (-> Runner Test) + (do r.monad + [param r.i64 + subject r.i64] + (with-expansions [<binary> (template [<extension> <reference> <param-expr>] + [(_.test <extension> + (|> (#synthesis.Extension <extension> (list (synthesis.i64 param) + (synthesis.i64 subject))) + (run (..sanitize <extension>)) + (case> (#error.Success valueT) + (n/= (<reference> param subject) (:coerce Nat valueT)) + + (#error.Failure error) + false) + (let [param <param-expr>])))] + + ["lux i64 and" i64.and param] + ["lux i64 or" i64.or param] + ["lux i64 xor" i64.xor param] + ["lux i64 left-shift" i64.left-shift (n/% 64 param)] + ["lux i64 logical-right-shift" i64.logic-right-shift (n/% 64 param)] + )] + ($_ _.and + <binary> + (_.test "lux i64 arithmetic-right-shift" + (|> (#synthesis.Extension "lux i64 arithmetic-right-shift" + (list (synthesis.i64 subject) + (synthesis.i64 param))) + (run (..sanitize "lux i64 arithmetic-right-shift")) + (case> (#error.Success valueT) + ("lux i64 =" + (i64.arithmetic-right-shift param subject) + (:coerce I64 valueT)) + + (#error.Failure error) + false) + (let [param (n/% 64 param)]))) + )))) + +(def: (i64 run) + (-> Runner Test) + (do r.monad + [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not))) + subject r.i64] + (`` ($_ _.and + (~~ (template [<extension> <type> <prepare> <comp> <subject-expr>] + [(_.test <extension> + (|> (#synthesis.Extension <extension> (list (synthesis.i64 subject))) + (run (..sanitize <extension>)) + (case> (#error.Success valueT) + (<comp> (<prepare> subject) (:coerce <type> valueT)) + + (#error.Failure error) + false) + (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 [<extension> <reference> <outputT> <comp>] + [(_.test <extension> + (|> (#synthesis.Extension <extension> (list (synthesis.i64 param) + (synthesis.i64 subject))) + (run (..sanitize <extension>)) + (case> (#error.Success valueT) + (<comp> (<reference> param subject) (:coerce <outputT> valueT)) + + (#error.Failure error) + false)))] + + ["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 map (|>> (n/% 1000) .int int-to-frac)))) + +(def: (f64 run) + (-> Runner Test) + (do r.monad + [param (|> ..simple-frac (r.filter (|>> (f/= +0.0) not))) + subject ..simple-frac] + (`` ($_ _.and + (~~ (template [<extension> <reference> <comp>] + [(_.test <extension> + (|> (#synthesis.Extension <extension> (list (synthesis.f64 param) + (synthesis.f64 subject))) + (run (..sanitize <extension>)) + (//case.verify (<reference> param subject))))] + + ["lux f64 +" f/+ f/=] + ["lux f64 -" f/- f/=] + ["lux f64 *" f/* f/=] + ["lux f64 /" f// f/=] + ["lux f64 %" f/% f/=] + )) + (~~ (template [<extension> <text>] + [(_.test <extension> + (|> (#synthesis.Extension <extension> (list (synthesis.f64 param) + (synthesis.f64 subject))) + (run (..sanitize <extension>)) + (case> (#error.Success valueV) + (bit@= (<text> param subject) + (:coerce Bit valueV)) + + _ + false)))] + + ["lux f64 =" f/=] + ["lux f64 <" f/<] + )) + (~~ (template [<extension> <reference>] + [(_.test <extension> + (|> (#synthesis.Extension <extension> (list)) + (run (..sanitize <extension>)) + (//case.verify <reference>)))] + + ["lux f64 min" ("lux frac min")] + ["lux f64 max" ("lux frac max")] + ["lux f64 smallest" ("lux frac smallest")] + )) + (_.test "'lux f64 to-i64' && 'lux i64 to-f64'" + (|> (run (..sanitize "lux f64 to-i64") + (|> subject synthesis.f64 + (list) (#synthesis.Extension "lux f64 to-i64") + (list) (#synthesis.Extension "lux i64 to-f64"))) + (//case.verify subject))) + )))) + +(def: (text run) + (-> Runner Test) + (do r.monad + [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))]] + ($_ _.and + (_.test "Can compare texts for equality." + (and (|> (#synthesis.Extension "lux text =" (list sample-lowerS sample-lowerS)) + (run (..sanitize "lux text =")) + (case> (#error.Success valueV) + (:coerce Bit valueV) + + _ + false)) + (|> (#synthesis.Extension "lux text =" (list sample-upperS sample-lowerS)) + (run (..sanitize "lux text =")) + (case> (#error.Success valueV) + (not (:coerce Bit valueV)) + + _ + false)))) + (_.test "Can compare texts for order." + (|> (#synthesis.Extension "lux text <" (list sample-lowerS sample-upperS)) + (run (..sanitize "lux text <")) + (case> (#error.Success valueV) + (:coerce Bit valueV) + + (#error.Failure error) + false))) + (_.test "Can get length of text." + (|> (#synthesis.Extension "lux text size" (list sample-lowerS)) + (run (..sanitize "lux text size")) + (case> (#error.Success valueV) + (n/= sample-size (:coerce Nat valueV)) + + _ + false))) + (_.test "Can concatenate text." + (|> (#synthesis.Extension "lux text size" (list concatenatedS)) + (run (..sanitize "lux text size")) + (case> (#error.Success valueV) + (n/= (n/* 2 sample-size) (:coerce Nat valueV)) + + _ + false))) + (_.test "Can find index of sub-text." + (and (|> (#synthesis.Extension "lux text index" + (list concatenatedS sample-lowerS + (synthesis.i64 +0))) + (run (..sanitize "lux text index")) + (case> (^multi (#error.Success valueV) + [(:coerce (Maybe Nat) valueV) (#.Some valueV)]) + (n/= 0 valueV) + + _ + false)) + (|> (#synthesis.Extension "lux text index" + (list concatenatedS sample-upperS + (synthesis.i64 +0))) + (run (..sanitize "lux text index")) + (case> (^multi (#error.Success valueV) + [(:coerce (Maybe Nat) valueV) (#.Some valueV)]) + (n/= sample-size valueV) + + _ + false)))) + (let [test-clip (: (-> (I64 Any) (I64 Any) Text Bit) + (function (_ from to expected) + (|> (#synthesis.Extension "lux text clip" + (list concatenatedS + (synthesis.i64 from) + (synthesis.i64 to))) + (run (..sanitize "lux text clip")) + (case> (^multi (#error.Success valueV) + [(:coerce (Maybe Text) valueV) (#.Some valueV)]) + (text@= expected valueV) + + _ + false))))] + (_.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." + (|> (#synthesis.Extension "lux text char" + (list sample-lowerS + (synthesis.i64 char-idx))) + (run (..sanitize "lux text char")) + (case> (^multi (#error.Success valueV) + [(:coerce (Maybe Int) valueV) (#.Some valueV)]) + (text.contains? ("lux int char" valueV) + sample-lower) + + _ + false))) + ))) + +(def: (io run) + (-> Runner Test) + (do r.monad + [message (r.ascii/alpha 5)] + ($_ _.and + (_.test "Can log messages." + (|> (#synthesis.Extension "lux io log" + (list (synthesis.text (format "LOG: " message)))) + (run (..sanitize "lux io log")) + (case> (#error.Success valueV) + true + + (#error.Failure error) + false))) + (_.test "Can throw runtime errors." + (and (|> (#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)))}))) + (run (..sanitize "lux try")) + (case> (^multi (#error.Success valueV) + [(:coerce (Error Text) valueV) (#error.Failure error)]) + (text.contains? message error) + + _ + false)) + (|> (#synthesis.Extension "lux try" + (list (synthesis.function/abstraction + {#synthesis.environment (list) + #synthesis.arity 1 + #synthesis.body (synthesis.text message)}))) + (run (..sanitize "lux try")) + (case> (^multi (#error.Success valueV) + [(:coerce (Error Text) valueV) (#error.Success valueV)]) + (text@= message valueV) + + _ + false)))) + (_.test "Can obtain current time in milli-seconds." + (|> (synthesis.tuple (list (#synthesis.Extension "lux io current-time" (list)) + (#synthesis.Extension "lux io current-time" (list)))) + (run (..sanitize "lux io current-time")) + (case> (#error.Success valueV) + (let [[pre post] (:coerce [Nat Nat] valueV)] + (n/>= pre post)) + + (#error.Failure error) + false))) + ))) + +(def: #export (spec runner) + (-> Runner Test) + ($_ _.and + (..bit runner) + (..i64 runner) + (..f64 runner) + (..text runner) + (..io runner) + )) |