aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2020-08-28 00:06:26 -0400
committerEduardo Julian2020-08-28 00:06:26 -0400
commita5a15c191c43a660bb0c8e78e93d097e27966177 (patch)
tree5dfc517fa34e1bacfbfed426b0ead3bc74c50731 /stdlib
parentc8f9f42a258f1f2f961c7f8c5571cce843e97a0a (diff)
Build programs.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/data/number/frac.lux95
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux3
-rw-r--r--stdlib/source/program/aedifex.lux7
-rw-r--r--stdlib/source/program/aedifex/action.lux15
-rw-r--r--stdlib/source/program/aedifex/build.lux144
-rw-r--r--stdlib/source/program/aedifex/cli.lux4
-rw-r--r--stdlib/source/program/aedifex/local.lux6
-rw-r--r--stdlib/source/program/aedifex/parser.lux26
-rw-r--r--stdlib/source/program/aedifex/project.lux14
-rw-r--r--stdlib/source/program/aedifex/shell.lux104
-rw-r--r--stdlib/source/test/lux.lux29
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux6
-rw-r--r--stdlib/source/test/lux/macro.lux18
-rw-r--r--stdlib/source/test/lux/macro/poly.lux18
-rw-r--r--stdlib/source/test/lux/macro/template.lux63
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)))))
+ )))
+ ))