diff options
Diffstat (limited to 'stdlib/source')
| -rw-r--r-- | stdlib/source/lux/data/number/frac.lux | 95 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/action.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/build.lux | 144 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/cli.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/local.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/parser.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/project.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/shell.lux | 104 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/number/frac.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/poly.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/template.lux | 63 |
15 files changed, 468 insertions, 84 deletions
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index 0cd8fe897..22a8e5372 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -110,15 +110,21 @@ "lux f64 i64" ("lux i64 left-shift" 11))) -(structure: #export equivalence (Equivalence Frac) +(structure: #export equivalence + (Equivalence Frac) + (def: = ..=)) -(structure: #export order (Order Frac) +(structure: #export order + (Order Frac) + (def: &equivalence ..equivalence) (def: < ..<)) (template [<name> <compose> <identity>] - [(structure: #export <name> (Monoid Frac) + [(structure: #export <name> + (Monoid Frac) + (def: identity <identity>) (def: compose <compose>))] @@ -150,7 +156,9 @@ (..= positive-infinity value) (..= negative-infinity value)))) -(structure: #export decimal (Codec Text Frac) +(structure: #export decimal + (Codec Text Frac) + (def: (encode x) (if (..< +0.0 x) ("lux f64 encode" x) @@ -165,7 +173,9 @@ (#try.Failure "Could not decode Frac")))) (template [<struct> <int> <base> <char-set> <error>] - [(structure: #export <struct> (Codec Text Frac) + [(structure: #export <struct> + (Codec Text Frac) + (def: (encode value) (let [whole (..int value) whole-part (:: <int> encode whole) @@ -354,7 +364,9 @@ ) (template [<struct> <error> <from> <to>] - [(structure: #export <struct> (Codec Text Frac) + [(structure: #export <struct> + (Codec Text Frac) + (def: (encode value) (let [sign (..signum value) raw-bin (:: ..binary encode value) @@ -405,6 +417,7 @@ (def: mantissa-size Nat 52) (def: exponent-size Nat 11) +(def: sign-offset (//nat.+ ..exponent-size ..mantissa-size)) (template [<hex> <name>] [(def: <name> (|> <hex> (:: //nat.hex decode) try.assume .i64))] @@ -437,66 +450,68 @@ ..negative-zero-bits)) ## else - (let [input (..abs input) + (let [sign-bit (if (..= -1.0 (..signum input)) + 1 + 0) + input (..abs input) exponent (math.floor (log2 input)) - exponent-mask (|> 1 (//i64.left-shift exponent-size) dec) + exponent-mask (|> 1 (//i64.left-shift ..exponent-size) dec) mantissa (|> input ## Normalize (../ (math.pow exponent +2.0)) ## Make it int-equivalent (..* (math.pow +52.0 +2.0))) - sign-bit (if (..= -1.0 (..signum input)) - 1 - 0) - exponent-bits (|> exponent ..int .nat (//nat.+ double-bias) (//i64.and exponent-mask)) + exponent-bits (|> exponent ..int .nat (//nat.+ ..double-bias) (//i64.and exponent-mask)) mantissa-bits (|> mantissa ..int .nat)] ($_ //i64.or - (//i64.left-shift 63 sign-bit) - (//i64.left-shift mantissa-size exponent-bits) - (//i64.clear mantissa-size mantissa-bits))) + (//i64.left-shift ..sign-offset sign-bit) + (//i64.left-shift ..mantissa-size exponent-bits) + (//i64.clear ..mantissa-size mantissa-bits))) ))) -(template [<getter> <mask> <size> <offset>] - [(def: <mask> (|> 1 (//i64.left-shift <size>) dec (//i64.left-shift <offset>))) - (def: (<getter> input) +(template [<getter> <size> <offset>] + [(def: <getter> (-> (I64 Any) I64) - (|> input (//i64.and <mask>) (//i64.logic-right-shift <offset>) i64))] + (let [mask (|> 1 (//i64.left-shift <size>) dec (//i64.left-shift <offset>))] + (|>> (//i64.and mask) (//i64.logic-right-shift <offset>) .i64)))] - [mantissa mantissa-mask mantissa-size 0] - [exponent exponent-mask exponent-size mantissa-size] - [sign sign-mask 1 (//nat.+ exponent-size mantissa-size)] + [mantissa ..mantissa-size 0] + [exponent ..exponent-size ..mantissa-size] + [sign 1 ..sign-offset] ) (def: #export (from-bits input) (-> I64 Frac) - (let [S (sign input) - E (exponent input) - M (mantissa input)] + (let [S (..sign input) + positive? (//nat.= 0 S) + E (..exponent input) + M (..mantissa input)] (cond (//nat.= ..special-exponent-bits E) (if (//nat.= 0 M) - (if (//nat.= 0 S) + (if positive? ..positive-infinity ..negative-infinity) ..not-a-number) (and (//nat.= 0 E) (//nat.= 0 M)) - (if (//nat.= 0 S) + (if positive? +0.0 (..* -1.0 +0.0)) ## else - (let [normalized (|> M (//i64.set mantissa-size) - .int //int.frac - (../ (math.pow +52.0 +2.0))) - power (math.pow (|> E (//nat.- double-bias) - .int //int.frac) - +2.0) - shifted (..* power - normalized)] - (if (//nat.= 0 S) - shifted - (..* -1.0 shifted)))))) - -(structure: #export hash (Hash Frac) + (let [numerator (|> M (//i64.set ..mantissa-size) + .int (//int.* (if positive? + +1 + -1))) + denominator (math.pow +52.0 +2.0) + power (math.pow (|> E (//nat.- ..double-bias) .int //int.frac) + +2.0)] + (|> (//int.frac numerator) + (../ denominator) + (..* power)))))) + +(structure: #export hash + (Hash Frac) + (def: &equivalence ..equivalence) (def: hash ..to-bits)) diff --git a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux index 24562367a..987aa5fbf 100644 --- a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux @@ -14,7 +14,8 @@ [// ["." artifact (#+ Registry)]]) -(type: #export Module Text) +(type: #export Module + Text) (type: #export Descriptor {#name Module diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 0ca614be1..70cccaaf2 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -33,7 +33,8 @@ ["#." pom] ["#." cli] ["#." local] - ["#." dependency]]) + ["#." dependency] + ["#." build]]) (def: (read-file! path) (-> Path (IO (Try Binary))) @@ -134,6 +135,10 @@ #/cli.Dependencies (exec (..fetch-dependencies! project) + (wrap [])) + + #/cli.Buikd + (exec (/build.do! project) (wrap []))) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/action.lux b/stdlib/source/program/aedifex/action.lux new file mode 100644 index 000000000..e8a88facd --- /dev/null +++ b/stdlib/source/program/aedifex/action.lux @@ -0,0 +1,15 @@ +(.module: + [lux #* + [abstract + [monad (#+ Monad)]] + [control + ["." try (#+ Try)] + [concurrency + ["." promise (#+ Promise)]]]]) + +(type: #export (Action a) + (Promise (Try a))) + +(def: #export monad + (Monad Action) + (:assume (try.with promise.monad))) diff --git a/stdlib/source/program/aedifex/build.lux b/stdlib/source/program/aedifex/build.lux new file mode 100644 index 000000000..74f64cb59 --- /dev/null +++ b/stdlib/source/program/aedifex/build.lux @@ -0,0 +1,144 @@ +(.module: + [lux (#- Name) + ["." host (#+ import:)] + [abstract + [monad (#+ Monad do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise) ("#@." monad)]]] + [data + ["." product] + ["." maybe] + ["." text ("#@." equivalence) + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor)] + ["." dictionary]]] + [world + ["." file (#+ Path)]]] + ["." // #_ + ["#" project] + ["#." action (#+ Action)] + ["#." local] + ["#." artifact (#+ Group Name Artifact)] + ["#." dependency (#+ Dependency Resolution)] + ["#." shell]]) + +(type: #export (Command a) + (-> //.Project (Action a))) + +(type: Finder + (-> Resolution (Maybe Dependency))) + +(def: (dependency-finder group name) + (-> Group Name Finder) + (|>> dictionary.entries + (list.search (function (_ [dependency package]) + (if (and (text@= group (get@ [#//dependency.artifact #//artifact.group] dependency)) + (text@= name (get@ [#//dependency.artifact #//artifact.name] dependency))) + (#.Some dependency) + #.None))))) + +(def: lux-group + Group + "com.github.luxlang") + +(template [<name> <finder>] + [(def: <finder> + Finder + (..dependency-finder ..lux-group <name>))] + + ["lux-jvm" jvm-compiler] + ["lux-js" js-compiler] + ) + +(exception: #export no-available-compiler) +(exception: #export no-specified-program) + +(type: Compiler + (#JVM Artifact) + (#JS Artifact)) + +(def: (remove-dependency dependency) + (-> Dependency (-> Resolution Resolution)) + (|>> dictionary.entries + (list.filter (|>> product.left (is? dependency) not)) + (dictionary.from-list //dependency.hash))) + +(def: (compiler resolution) + (-> Resolution (Try [Resolution Compiler])) + (case [(..jvm-compiler resolution) + (..js-compiler resolution)] + [(#.Some dependency) _] + (#try.Success [(..remove-dependency dependency resolution) + (#JVM (get@ #//dependency.artifact dependency))]) + + [_ (#.Some dependency)] + (#try.Success [(..remove-dependency dependency resolution) + (#JS (get@ #//dependency.artifact dependency))]) + + _ + (exception.throw ..no-available-compiler []))) + +(def: libraries + (-> Resolution (List Path)) + (|>> dictionary.keys + (list.filter (|>> (get@ #//dependency.type) (text@= //dependency.lux-library))) + (list@map (|>> (get@ #//dependency.artifact) (//local.path file.system))))) + +(import: #long java/lang/String) + +## https://docs.oracle.com/javase/tutorial/essential/environment/sysprop.html +(import: #long java/lang/System + (#static getProperty [java/lang/String] #io #? java/lang/String)) + +(def: working-directory + (IO (Try Text)) + (do io.monad + [?value (java/lang/System::getProperty "user.dir")] + (wrap (#try.Success (maybe.default "~" ?value))))) + +(def: (singular-parameter name value) + (-> Text Text Text) + (format name " " value)) + +(def: (plural-parameter name values) + (-> Text (List Text) Text) + (|> values (list@map (|>> (format name " "))) (text.join-with " "))) + +(def: #export (do! project) + (Command Any) + (case (get@ #//.program project) + (#.Some program) + (do //action.monad + [cache (//local.all-cached (file.async file.system) + (get@ #//.dependencies project) + //dependency.empty) + resolution (promise.future + (//dependency.resolve-all (get@ #//.repositories project) + (get@ #//.dependencies project) + cache)) + _ (//local.cache-all (file.async file.system) + resolution) + [resolution compiler] (promise@wrap (..compiler resolution)) + working-directory (promise.future ..working-directory) + #let [libraries (..libraries resolution) + prefix (case compiler + (#JVM artifact) (format "java -jar " (//local.path file.system artifact)) + (#JS artifact) (format "node --stack_size=8192 " (//local.path file.system artifact))) + cache-directory (format working-directory (:: file.system separator) (get@ #//.target project)) + command (format prefix " build" + " " (..plural-parameter "--library" libraries) + " " (..plural-parameter "--source" (get@ #//.sources project)) + " " (..singular-parameter "--target" cache-directory) + " " (..singular-parameter "--module" program))] + #let [_ (log! "[BUILD STARTED]")] + outcome (//shell.execute command working-directory) + #let [_ (log! "[BUILD END]")]] + (wrap [])) + + #.None + (promise@wrap (exception.throw ..no-specified-program [])))) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index 4ff56ac53..3b5a33fb1 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -7,7 +7,8 @@ (type: #export Command #POM #Install - #Dependencies) + #Dependencies + #Buikd) (def: #export command (Parser Command) @@ -15,4 +16,5 @@ (cli.this "pom") (cli.this "install") (cli.this "deps") + (cli.this "buikd") )) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index 8761b573a..0a429fdc2 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -160,3 +160,9 @@ (#try.Failure error) <next>))))) + +(def: #export (path system artifact) + (All [a] (-> (file.System a) Artifact Path)) + (format (..repository system) + (:: system separator) + (//artifact.identity artifact))) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 78f6dbb60..508550a2a 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -89,7 +89,11 @@ #/.developers (list) #/.contributors (list)}) -(def: (bundle tag parser) +(def: (singular tag parser) + (All [a] (-> Code (Parser a) (Parser a))) + (<c>.form (<>.after (<c>.this! tag) parser))) + +(def: (plural tag parser) (All [a] (-> Code (Parser a) (Parser (List a)))) (<c>.form (<>.after (<c>.this! tag) (<>.some parser)))) @@ -100,10 +104,10 @@ (<>.maybe ..url) (<>.maybe ..scm) (<>.maybe <c>.text) - (<>.default (list) (..bundle (' #licenses) ..license)) + (<>.default (list) (..plural (' #licenses) ..license)) (<>.maybe ..organization) - (<>.default (list) (..bundle (' #developers) ..developer)) - (<>.default (list) (..bundle (' #contributors) ..contributor)) + (<>.default (list) (..plural (' #developers) ..developer)) + (<>.default (list) (..plural (' #contributors) ..contributor)) )) (def: repository @@ -133,16 +137,18 @@ (`` ($_ <>.and ..artifact (<| (<>.default ..no-info) - <c>.form - (<>.after (<c>.this! (' #info))) - ..info) + (..singular (' #info) ..info)) (<| (<>.default (list)) - (..bundle (' #repositories)) + (..plural (' #repositories)) ..repository) (<| (<>.default (list)) - (..bundle (' #dependencies)) + (..plural (' #dependencies)) ..dependency) (<| (<>.default (list "source")) - (..bundle (' #sources)) + (..plural (' #sources)) ..source) + (<| (<>.default "target") + (..singular (' #target) <c>.text)) + (<>.maybe (..singular (' #program) <c>.text)) + (<>.maybe (..singular (' #test) <c>.text)) )))) diff --git a/stdlib/source/program/aedifex/project.lux b/stdlib/source/program/aedifex/project.lux index 385ef8919..ebd689760 100644 --- a/stdlib/source/program/aedifex/project.lux +++ b/stdlib/source/program/aedifex/project.lux @@ -1,10 +1,15 @@ (.module: - [lux (#- Info Source) + [lux (#- Info Source Module) [data ["." text]] [world [net (#+ URL)] - [file (#+ Path)]]] + [file (#+ Path)]] + [tool + [compiler + [meta + [archive + [descriptor (#+ Module)]]]]]] [// [artifact (#+ Artifact)] ["." dependency]]) @@ -56,4 +61,7 @@ #info Info #repositories (List dependency.Repository) #dependencies (List dependency.Dependency) - #sources (List Source)}) + #sources (List Source) + #target Path + #program (Maybe Module) + #test (Maybe Module)}) diff --git a/stdlib/source/program/aedifex/shell.lux b/stdlib/source/program/aedifex/shell.lux new file mode 100644 index 000000000..373f9b739 --- /dev/null +++ b/stdlib/source/program/aedifex/shell.lux @@ -0,0 +1,104 @@ +(.module: + [lux #* + ["." host (#+ import:)] + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + ["." exception (#+ exception:)] + [concurrency + ["." promise]]] + [data + [text + ["%" format (#+ format)]] + [number + ["." int]]] + [world + [file (#+ Path)]]] + ["." // #_ + ["#." action (#+ Action)]]) + +(import: #long java/lang/String) + +(import: #long java/io/InputStream) + +(import: #long java/io/Reader) + +(import: #long java/io/InputStreamReader + (new [java/io/InputStream])) + +(import: #long java/io/BufferedReader + (new [java/io/Reader]) + (readLine [] #io #try java/lang/String)) + +(import: #long java/lang/Process + (getInputStream [] java/io/InputStream) + (getErrorStream [] java/io/InputStream) + (waitFor [] #io #try int)) + +(import: #long java/io/File + (new [java/lang/String])) + +(import: #long java/lang/Runtime + (#static getRuntime [] #io java/lang/Runtime) + (exec [java/lang/String #? [java/lang/String] java/io/File] #io #try java/lang/Process)) + +(exception: #export (failure-to-execute-command {working-directory Text} {command Text} {error Text}) + (exception.report + ["Working Directory" (%.text working-directory)] + ["Command" (%.text command)] + ["Error" (%.text error)])) + +(exception: #export (failure-during-command-execution {working-directory Text} {command Text} {error Text}) + (exception.report + ["Working Directory" (%.text working-directory)] + ["Command" (%.text command)] + ["Error" (%.text error)])) + +(exception: #export (abnormal-exit {working-directory Text} {command Text} {code Int}) + (exception.report + ["Working Directory" (%.text working-directory)] + ["Command" (%.text command)] + ["Code" (%.int code)])) + +(def: (consume-stream working-directory command stream) + (-> Text Path java/io/InputStream (IO (Try Any))) + (let [reader (|> stream java/io/InputStreamReader::new java/io/BufferedReader::new)] + (loop [_ []] + (do io.monad + [?line (java/io/BufferedReader::readLine reader)] + (case ?line + (#try.Success line) + (exec (log! line) + (recur [])) + + (#try.Failure error) + (wrap (exception.throw ..failure-during-command-execution [working-directory command error]))))))) + +(def: normal-exit + +0) + +(def: #export (execute command working-directory) + (-> Text Path (Action Any)) + (promise.future + (do {@ io.monad} + [runtime (java/lang/Runtime::getRuntime) + ?process (java/lang/Runtime::exec command #.None (java/io/File::new working-directory) runtime)] + (case ?process + (#try.Success process) + (do @ + [_ (..consume-stream working-directory command (java/lang/Process::getInputStream process)) + _ (..consume-stream working-directory command (java/lang/Process::getErrorStream process)) + ?exit-code (java/lang/Process::waitFor process)] + (case ?exit-code + (#try.Success exit-code) + (if (int.= ..normal-exit exit-code) + (wrap (#try.Success [])) + (wrap (exception.throw ..abnormal-exit [working-directory command exit-code]))) + + (#try.Failure error) + (wrap (exception.throw ..failure-to-execute-command [working-directory command error])))) + + (#try.Failure error) + (wrap (exception.throw ..failure-to-execute-command [working-directory command error])))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index d41c295c4..d3107c0e5 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -313,20 +313,21 @@ (def: sub-tests Test - (_.in-parallel (list /abstract.test - /control.test - /data.test - /locale.test - /macro.test - /math.test - /time.test - ## /tool.test - /type.test - /world.test - /host.test - /extension.test - /target/jvm.test - ))) + (_.in-parallel (list& /abstract.test + /control.test + /data.test + /locale.test + /macro.test + /math.test + /time.test + ## /tool.test + /type.test + /world.test + /host.test + /target/jvm.test + (for {@.old (list)} + (list /extension.test)) + ))) (def: test (<| (_.context (name.module (name-of /._))) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index ab6ceaa52..365bf9e7f 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -11,7 +11,7 @@ ["$." monoid] ["$." codec]]}] [math - ["r" random]]] + ["." random]]] {1 ["." / [// #* @@ -19,7 +19,7 @@ (def: #export test Test - (let [gen-frac (:: r.monad map (|>> (i.% +100) i.frac) r.int)] + (let [gen-frac (:: random.monad map (|>> (i.% +100) i.frac) random.int)] (<| (_.context (%.name (name-of /._))) (`` ($_ _.and ($equivalence.spec /.equivalence gen-frac) @@ -45,7 +45,7 @@ (oct "-615,2.43")) (/.= (hex "+deadBE.EF") (hex "+dead,BE.EF")))) - (do r.monad + (do random.monad [sample gen-frac] (_.test (format (%.name (name-of /.to-bits)) " & " (%.name (name-of /.from-bits))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 1851fb4a4..14189ca35 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,26 +1,22 @@ (.module: [lux #* - ["_" test (#+ Test)] - ["%" data/text/format]] + ["_" test (#+ Test)]] {1 ["." /]} ["." / #_ ["#." code] + ["#." template] + ["#." poly] ["#." syntax - ["#/." common]] - ["#." poly #_ - ["#/." equivalence] - ["#/." functor] - ["#/." json]]]) + ["#/." common]]]) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.covering /._) ($_ _.and /code.test + /template.test /syntax.test /syntax/common.test - /poly/equivalence.test - /poly/functor.test - /poly/json.test + /poly.test ))) diff --git a/stdlib/source/test/lux/macro/poly.lux b/stdlib/source/test/lux/macro/poly.lux new file mode 100644 index 000000000..9a42c450a --- /dev/null +++ b/stdlib/source/test/lux/macro/poly.lux @@ -0,0 +1,18 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + {1 + ["." /]} + ["." / #_ + ["#." equivalence] + ["#." functor] + ["#." json]]) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + /equivalence.test + /functor.test + /json.test + ))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux new file mode 100644 index 000000000..6e90ac1bb --- /dev/null +++ b/stdlib/source/test/lux/macro/template.lux @@ -0,0 +1,63 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [math + ["." random (#+ Random)]] + [abstract + [monad (#+ do)]] + [data + [collection + ["." list]] + [number + ["." nat]]]] + {1 + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {@ random.monad} + [left random.nat + mid random.nat + right random.nat] + (with-expansions [<module> (as-is [-8.9 +6.7 .5 -4 +3 2 #1 #0 #c b "a"]) + <module>' "-8.9+6.7.5-4+32#1#0cba" + <short> (as-is ["a" b #c #0 #1 2 +3 -4 .5 +6.7 -8.9]) + <short>' "abc#0#12+3-4.5+6.7-8.9"] + ($_ _.and + (_.cover [/.splice] + (:: (list.equivalence nat.equivalence) = + (list left mid right) + (`` (list (~~ (/.splice [left mid right])))))) + (_.cover [/.count] + (case (/.count [left mid right]) + 3 true + _ false)) + (_.cover [/.text] + (case (/.text <short>) + <short>' true + _ false)) + (_.cover [/.identifier] + (and (case (`` (name-of (~~ (/.identifier <short>)))) + ["" <short>'] true + _ false) + (case (`` (name-of (~~ (/.identifier <module> <short>)))) + [<module>' <short>'] true + _ false) + )) + (_.cover [/.tag] + (and (case (`` (name-of (~~ (/.tag <short>)))) + ["" <short>'] true + _ false) + (case (`` (name-of (~~ (/.tag <module> <short>)))) + [<module>' <short>'] true + _ false) + )) + (_.cover [/.with-locals] + (/.with-locals [var0 var1] + (let [var0 left + var1 right] + (and (nat.= left var0) + (nat.= right var1))))) + ))) + )) |