aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/macro/poly/functor.lux2
-rw-r--r--stdlib/source/test/lux.lux14
-rw-r--r--stdlib/source/test/lux/data/format/json.lux65
-rw-r--r--stdlib/source/test/lux/macro.lux27
-rw-r--r--stdlib/source/test/lux/macro/code.lux59
-rw-r--r--stdlib/source/test/lux/macro/poly/equivalence.lux35
-rw-r--r--stdlib/source/test/lux/macro/poly/functor.lux31
-rw-r--r--stdlib/source/test/lux/macro/poly/json.lux114
-rw-r--r--stdlib/source/test/lux/macro/syntax.lux201
9 files changed, 311 insertions, 237 deletions
diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux
index 837c36fde..6252378eb 100644
--- a/stdlib/source/lux/macro/poly/functor.lux
+++ b/stdlib/source/lux/macro/poly/functor.lux
@@ -17,7 +17,7 @@
["." poly (#+ poly:)]]
["." type]])
-(poly: #export Functor<?>
+(poly: #export functor
(do @
[#let [type-funcC (code.local-identifier "____________type-funcC")
funcC (code.local-identifier "____________funcC")
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 196213c54..f50cdf48a 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -115,20 +115,15 @@
["#." io]
["#." control]
["#." data]
- ["#." time]
+ ["#." macro]
["#." math]
+ ["#." time]
["#." host
["#/." jvm]]]
## [control
## [concurrency
## ## [semaphore (#+)]
## ]]
- ## [macro
- ## [code (#+)]
- ## [syntax (#+)]
- ## [poly
- ## ["poly_." equivalence]
- ## ["poly_." functor]]]
## [type ## (#+)
## ## [check (#+)]
## ## [implicit (#+)] ## TODO: FIX Specially troublesome...
@@ -376,10 +371,11 @@
/control.test)
(<| (_.context "/data")
/data.test)
- (<| (_.context "/time")
- /time.test)
+ /macro.test
(<| (_.context "/math")
/math.test)
+ (<| (_.context "/time")
+ /time.test)
(<| (_.context "/host Host-platform interoperation")
($_ _.and
/host.test
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index 11bed07da..a170d3163 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -60,73 +60,10 @@
(r.dictionary text.hash size (r.unicode size) json)
)))))
-(type: Variant
- (#Bit Bit)
- (#Text Text)
- (#Frac Frac))
-
-(type: #rec Recursive
- (#Number Frac)
- (#Addition Frac Recursive))
-
-(type: Record
- {#bit Bit
- #frac Frac
- #text Text
- #maybe (Maybe Frac)
- #list (List Frac)
- #dictionary (d.Dictionary Text Frac)
- #variant Variant
- #tuple [Bit Frac Text]
- #recursive Recursive
- ## #instant ti.Instant
- ## #duration tdu.Duration
- #date tda.Date
- #grams (unit.Qty unit.Gram)
- })
-
-(def: gen-recursive
- (Random Recursive)
- (r.rec (function (_ gen-recursive)
- (r.or r.frac
- (r.and r.frac gen-recursive)))))
-
-(derived: recursive-equivalence (poly/equivalence.equivalence Recursive))
-
-(def: qty
- (All [unit] (Random (unit.Qty unit)))
- (|> r.int (:: r.monad map unit.in)))
-
-(def: gen-record
- (Random Record)
- (do r.monad
- [size (:: @ map (n/% 2) r.nat)]
- ($_ r.and
- r.bit
- r.frac
- (r.unicode size)
- (r.maybe r.frac)
- (r.list size r.frac)
- (r.dictionary text.hash size (r.unicode size) r.frac)
- ($_ r.or r.bit (r.unicode size) r.frac)
- ($_ r.and r.bit r.frac (r.unicode size))
- gen-recursive
- ## _instant.instant
- ## _duration.duration
- _date.date
- qty
- )))
-
-(derived: equivalence (poly/equivalence.equivalence Record))
-(derived: codec (poly/json.codec Record))
-
(def: #export test
Test
- (<| (_.context (%name (name-of /.JSON)))
+ (<| (_.context (%name (name-of /._)))
($_ _.and
($equivalence.spec /.equivalence ..json)
($codec.spec /.equivalence /.codec ..json)
- (<| (_.context "Polytypism.")
- (<| (_.seed 14562075782602945288)
- ($codec.spec ..equivalence ..codec gen-record)))
)))
diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux
new file mode 100644
index 000000000..d7389dd20
--- /dev/null
+++ b/stdlib/source/test/lux/macro.lux
@@ -0,0 +1,27 @@
+(.module:
+ [lux #*
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]]
+ {1
+ ["." /]}
+ ["." / #_
+ ["#." code]
+ ["#." syntax]
+ ["#." poly #_
+ ["#/." equivalence]
+ ["#/." functor]
+ ["#/." json]]
+ ])
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ /code.test
+ /syntax.test
+ /poly/equivalence.test
+ /poly/functor.test
+ /poly/json.test
+ )))
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux
index fa40f0fec..3dc7ec7d4 100644
--- a/stdlib/source/test/lux/macro/code.lux
+++ b/stdlib/source/test/lux/macro/code.lux
@@ -1,36 +1,33 @@
(.module:
[lux #*
- [io]
- [control
- [monad (#+ do Monad)]]
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
[data
- [number]
- ["." text ("#;." equivalence)
- format]]
- [math
- ["r" random]]
- [macro
- ["&" code]]]
- lux/test)
+ ["." text ("#@." equivalence)]]]
+ {1
+ ["." /]})
-(context: "Code"
- (with-expansions
- [<tests> (do-template [<expr> <text>]
- [(test (format "Can produce Code node: " <text>)
- (and (text;= <text> (&.to-text <expr>))
- (:: &.equivalence = <expr> <expr>)))]
+(def: #export test
+ Test
+ (`` ($_ _.and
+ (~~ (do-template [<expr> <text>]
+ [(_.test (format "Can produce Code node: " <text>)
+ (and (text@= <text> (/.to-text <expr>))
+ (:: /.equivalence = <expr> <expr>)))]
- [(&.bit #1) "#1"]
- [(&.bit #0) "#0"]
- [(&.int +123) "+123"]
- [(&.frac +123.0) "+123.0"]
- [(&.text "1234") (format text.double-quote "1234" text.double-quote)]
- [(&.tag ["yolo" "lol"]) "#yolo.lol"]
- [(&.identifier ["yolo" "lol"]) "yolo.lol"]
- [(&.form (list (&.bit #1) (&.int +123))) "(#1 +123)"]
- [(&.tuple (list (&.bit #1) (&.int +123))) "[#1 +123]"]
- [(&.record (list [(&.bit #1) (&.int +123)])) "{#1 +123}"]
- [(&.local-tag "lol") "#lol"]
- [(&.local-identifier "lol") "lol"]
- )]
- ($_ seq <tests>)))
+ [(/.bit #1) "#1"]
+ [(/.bit #0) "#0"]
+ [(/.nat 123) "123"]
+ [(/.int +123) "+123"]
+ [(/.frac +123.0) "+123.0"]
+ [(/.text "1234") (format text.double-quote "1234" text.double-quote)]
+ [(/.local-tag "lol") "#lol"]
+ [(/.tag ["yolo" "lol"]) "#yolo.lol"]
+ [(/.local-identifier "lol") "lol"]
+ [(/.identifier ["yolo" "lol"]) "yolo.lol"]
+ [(/.form (list (/.bit #1) (/.int +123))) "(#1 +123)"]
+ [(/.tuple (list (/.bit #1) (/.int +123))) "[#1 +123]"]
+ [(/.record (list [(/.bit #1) (/.int +123)])) "{#1 +123}"]
+ )))))
diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux
index 63f9fa955..941eb881f 100644
--- a/stdlib/source/test/lux/macro/poly/equivalence.lux
+++ b/stdlib/source/test/lux/macro/poly/equivalence.lux
@@ -1,23 +1,23 @@
(.module:
[lux #*
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
[equivalence (#+ Equivalence)]]
[data
["." bit]
["." maybe]
[number
- ["." int ("#;." number)]]
- ["." text
- format]
+ ["." int ("#@." number)]]
+ ["." text]
[collection
["." list]]]
- [math
- ["r" random]]
["." macro
- [poly (#+ derived:)
- ["&" equivalence]]]]
- lux/test)
+ [poly (#+ derived:)]]]
+ {1
+ ["." /]})
(type: Variant
(#Case0 Bit)
@@ -49,7 +49,7 @@
(r.Random Record)
(do r.monad
[size (:: @ map (n/% 2) r.nat)
- #let [gen-int (|> r.int (:: @ map (|>> int;abs (i/% +1,000,000))))]]
+ #let [gen-int (|> r.int (:: @ map (|>> int@abs (i/% +1,000,000))))]]
($_ r.and
r.bit
gen-int
@@ -61,12 +61,13 @@
($_ r.and gen-int r.frac (r.unicode size))
gen-recursive)))
-(derived: (&.Equivalence<?> Record))
+(derived: equivalence (/.equivalence Record))
-(context: "Equivalence polytypism"
- (<| (times 100)
- (do @
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (do r.monad
[sample gen-record
- #let [(^open "&;.") ..equivalence]]
- (test "Every instance equals itself."
- (&;= sample sample)))))
+ #let [(^open "/@.") ..equivalence]]
+ (_.test "Every instance equals itself."
+ (/@= sample sample)))))
diff --git a/stdlib/source/test/lux/macro/poly/functor.lux b/stdlib/source/test/lux/macro/poly/functor.lux
index 873259496..5b477682d 100644
--- a/stdlib/source/test/lux/macro/poly/functor.lux
+++ b/stdlib/source/test/lux/macro/poly/functor.lux
@@ -1,24 +1,25 @@
(.module:
[lux #*
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
[control
["." state]]
[data
["." identity]]
[macro
- [poly (#+ derived:)
- ["&" functor]]]]
- lux/test)
+ [poly (#+ derived:)]]]
+ {1
+ ["." /]})
-## [Utils]
-(derived: (&.Functor<?> .Maybe))
+(derived: maybe-functor (/.functor .Maybe))
+(derived: list-functor (/.functor .List))
+(derived: state-functor (/.functor state.State))
+(derived: identity-functor (/.functor identity.Identity))
-(derived: (&.Functor<?> .List))
-
-(derived: (&.Functor<?> state.State))
-
-(derived: (&.Functor<?> identity.Identity))
-
-## [Tests]
-(context: "Functor polytypism."
- (test "Can derive functors automatically."
- #1))
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (_.test "Can derive functors automatically."
+ #1)))
diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux
new file mode 100644
index 000000000..2669b9801
--- /dev/null
+++ b/stdlib/source/test/lux/macro/poly/json.lux
@@ -0,0 +1,114 @@
+(.module:
+ [lux #*
+ data/text/format
+ ["_" test (#+ Test)]
+ [control
+ pipe
+ codec
+ [monad (#+ do Monad)]
+ [equivalence (#+ Equivalence)]
+ ["p" parser]
+ {[0 #test]
+ [/
+ ["$." equivalence]
+ ["$." codec]]}]
+ [data
+ ["." error]
+ ["." bit]
+ ["." maybe]
+ ["." text]
+ [number
+ ["." frac]]
+ [format
+ [json (#+)]]
+ [collection
+ [row (#+ row)]
+ ["d" dictionary]
+ ["." list]]]
+ [macro
+ [poly (#+ derived:)]
+ ["." poly/equivalence]]
+ [type
+ ["." unit]]
+ [math
+ ["r" random (#+ Random)]]
+ [time
+ ["ti" instant]
+ ["tda" date]
+ ## ["tdu" duration]
+ ]]
+ [test
+ [lux
+ [time
+ ["_." instant]
+ ## ["_." duration]
+ ["_." date]]]]
+ {1
+ ["." /]}
+ )
+
+(type: Variant
+ (#Bit Bit)
+ (#Text Text)
+ (#Frac Frac))
+
+(type: #rec Recursive
+ (#Number Frac)
+ (#Addition Frac Recursive))
+
+(type: Record
+ {#bit Bit
+ #frac Frac
+ #text Text
+ #maybe (Maybe Frac)
+ #list (List Frac)
+ #dictionary (d.Dictionary Text Frac)
+ #variant Variant
+ #tuple [Bit Frac Text]
+ #recursive Recursive
+ ## #instant ti.Instant
+ ## #duration tdu.Duration
+ #date tda.Date
+ #grams (unit.Qty unit.Gram)
+ })
+
+(def: gen-recursive
+ (Random Recursive)
+ (r.rec (function (_ gen-recursive)
+ (r.or r.frac
+ (r.and r.frac gen-recursive)))))
+
+(derived: recursive-equivalence (poly/equivalence.equivalence Recursive))
+
+(def: qty
+ (All [unit] (Random (unit.Qty unit)))
+ (|> r.int (:: r.monad map unit.in)))
+
+(def: gen-record
+ (Random Record)
+ (do r.monad
+ [size (:: @ map (n/% 2) r.nat)]
+ ($_ r.and
+ r.bit
+ r.frac
+ (r.unicode size)
+ (r.maybe r.frac)
+ (r.list size r.frac)
+ (r.dictionary text.hash size (r.unicode size) r.frac)
+ ($_ r.or r.bit (r.unicode size) r.frac)
+ ($_ r.and r.bit r.frac (r.unicode size))
+ ..gen-recursive
+ ## _instant.instant
+ ## _duration.duration
+ _date.date
+ ..qty
+ )))
+
+(derived: equivalence (poly/equivalence.equivalence Record))
+(derived: codec (/.codec Record))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ (<| (_.seed 14562075782602945288)
+ ($codec.spec ..equivalence ..codec gen-record))))
diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux
index ff8c1c433..afe5f208e 100644
--- a/stdlib/source/test/lux/macro/syntax.lux
+++ b/stdlib/source/test/lux/macro/syntax.lux
@@ -1,24 +1,27 @@
(.module:
[lux #*
+ data/text/format
+ [control/monad (#+ do)]
+ ["r" math/random (#+ Random)]
+ ["_" test (#+ Test)]
[control
- [monad (#+ do Monad)]
[equivalence (#+ Equivalence)]
["p" parser]]
[data
["." bit]
["." name]
["." error (#+ Error)]
- ["." number]
- ["." text
- format]]
- [math
- ["r" random]]
+ ["." text]
+ [number
+ ["." nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]]
["." macro
- ["." code]
- ["s" syntax (#+ syntax: Syntax)]]]
- lux/test)
+ ["." code]]]
+ {1
+ ["." / (#+ syntax: Syntax)]})
-## [Utils]
(def: (enforced? parser input)
(-> (Syntax []) (List Code) Bit)
(case (p.run input parser)
@@ -63,93 +66,91 @@
(~' _)
#0)))))
-## [Tests]
-(context: "Simple value syntax."
- (with-expansions
- [<simple-tests> (do-template [<assertion> <value> <ctor> <Equivalence> <get>]
- [(test <assertion>
- (and (equals? <Equivalence> <value> <get> (list (<ctor> <value>)))
- (found? (s.this? (<ctor> <value>)) (list (<ctor> <value>)))
- (enforced? (s.this (<ctor> <value>)) (list (<ctor> <value>)))))]
-
- ["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit]
- ["Can parse Nat syntax." 123 code.nat number.equivalence s.nat]
- ["Can parse Int syntax." +123 code.int number.equivalence s.int]
- ["Can parse Rev syntax." .123 code.rev number.equivalence s.rev]
- ["Can parse Frac syntax." +123.0 code.frac number.equivalence s.frac]
- ["Can parse Text syntax." text.new-line code.text text.equivalence s.text]
- ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier]
- ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag]
- )]
- ($_ seq
- <simple-tests>
-
- (test "Can parse identifiers belonging to the current namespace."
- (and (match "yolo"
- (p.run (list (code.local-identifier "yolo"))
- s.local-identifier))
- (fails? (p.run (list (code.identifier ["yolo" "lol"]))
- s.local-identifier))))
-
- (test "Can parse tags belonging to the current namespace."
- (and (match "yolo"
- (p.run (list (code.local-tag "yolo"))
- s.local-tag))
- (fails? (p.run (list (code.tag ["yolo" "lol"]))
- s.local-tag))))
- )))
-
-(context: "Complex value syntax."
- (with-expansions
- [<group-tests> (do-template [<type> <parser> <ctor>]
- [(test (format "Can parse " <type> " syntax.")
- (and (match [#1 +123]
- (p.run (list (<ctor> (list (code.bit #1) (code.int +123))))
- (<parser> (p.and s.bit s.int))))
- (match #1
- (p.run (list (<ctor> (list (code.bit #1))))
- (<parser> s.bit)))
- (fails? (p.run (list (<ctor> (list (code.bit #1) (code.int +123))))
- (<parser> s.bit)))
- (match (#.Left #1)
- (p.run (list (<ctor> (list (code.bit #1))))
- (<parser> (p.or s.bit s.int))))
- (match (#.Right +123)
- (p.run (list (<ctor> (list (code.int +123))))
- (<parser> (p.or s.bit s.int))))
- (fails? (p.run (list (<ctor> (list (code.frac +123.0))))
- (<parser> (p.or s.bit s.int))))))]
-
- ["form" s.form code.form]
- ["tuple" s.tuple code.tuple])]
- ($_ seq
- <group-tests>
-
- (test "Can parse record syntax."
- (match [#1 +123]
- (p.run (list (code.record (list [(code.bit #1) (code.int +123)])))
- (s.record (p.and s.bit s.int)))))
- )))
-
-(context: "Combinators"
- ($_ seq
- (test "Can parse any Code."
- (match [_ (#.Bit #1)]
- (p.run (list (code.bit #1) (code.int +123))
- s.any)))
-
- (test "Can check whether the end has been reached."
- (and (match #1
- (p.run (list)
- s.end?))
- (match #0
- (p.run (list (code.bit #1))
- s.end?))))
-
- (test "Can ensure the end has been reached."
- (and (match []
- (p.run (list)
- s.end!))
- (fails? (p.run (list (code.bit #1))
- s.end!))))
- ))
+(def: simple-values
+ Test
+ (`` ($_ _.and
+ (~~ (do-template [<assertion> <value> <ctor> <Equivalence> <get>]
+ [(_.test <assertion>
+ (and (equals? <Equivalence> <value> <get> (list (<ctor> <value>)))
+ (found? (/.this? (<ctor> <value>)) (list (<ctor> <value>)))
+ (enforced? (/.this (<ctor> <value>)) (list (<ctor> <value>)))))]
+
+ ["Can parse Bit syntax." #1 code.bit bit.equivalence /.bit]
+ ["Can parse Nat syntax." 123 code.nat nat.equivalence /.nat]
+ ["Can parse Int syntax." +123 code.int int.equivalence /.int]
+ ["Can parse Rev syntax." .123 code.rev rev.equivalence /.rev]
+ ["Can parse Frac syntax." +123.0 code.frac frac.equivalence /.frac]
+ ["Can parse Text syntax." text.new-line code.text text.equivalence /.text]
+ ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence /.identifier]
+ ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence /.tag]
+ ))
+ (_.test "Can parse identifiers belonging to the current namespace."
+ (and (match "yolo"
+ (p.run (list (code.local-identifier "yolo"))
+ /.local-identifier))
+ (fails? (p.run (list (code.identifier ["yolo" "lol"]))
+ /.local-identifier))))
+ (_.test "Can parse tags belonging to the current namespace."
+ (and (match "yolo"
+ (p.run (list (code.local-tag "yolo"))
+ /.local-tag))
+ (fails? (p.run (list (code.tag ["yolo" "lol"]))
+ /.local-tag))))
+ )))
+
+(def: complex-values
+ Test
+ (`` ($_ _.and
+ (~~ (do-template [<type> <parser> <ctor>]
+ [(_.test (format "Can parse " <type> " syntax.")
+ (and (match [#1 +123]
+ (p.run (list (<ctor> (list (code.bit #1) (code.int +123))))
+ (<parser> (p.and /.bit /.int))))
+ (match #1
+ (p.run (list (<ctor> (list (code.bit #1))))
+ (<parser> /.bit)))
+ (fails? (p.run (list (<ctor> (list (code.bit #1) (code.int +123))))
+ (<parser> /.bit)))
+ (match (#.Left #1)
+ (p.run (list (<ctor> (list (code.bit #1))))
+ (<parser> (p.or /.bit /.int))))
+ (match (#.Right +123)
+ (p.run (list (<ctor> (list (code.int +123))))
+ (<parser> (p.or /.bit /.int))))
+ (fails? (p.run (list (<ctor> (list (code.frac +123.0))))
+ (<parser> (p.or /.bit /.int))))))]
+
+ ["form" /.form code.form]
+ ["tuple" /.tuple code.tuple]))
+ (_.test "Can parse record syntax."
+ (match [#1 +123]
+ (p.run (list (code.record (list [(code.bit #1) (code.int +123)])))
+ (/.record (p.and /.bit /.int)))))
+ )))
+
+(def: #export test
+ Test
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ ..simple-values
+ ..complex-values
+ ($_ _.and
+ (_.test "Can parse any Code."
+ (match [_ (#.Bit #1)]
+ (p.run (list (code.bit #1) (code.int +123))
+ /.any)))
+ (_.test "Can check whether the end has been reached."
+ (and (match #1
+ (p.run (list)
+ /.end?))
+ (match #0
+ (p.run (list (code.bit #1))
+ /.end?))))
+ (_.test "Can ensure the end has been reached."
+ (and (match []
+ (p.run (list)
+ /.end!))
+ (fails? (p.run (list (code.bit #1))
+ /.end!))))
+ )
+ )))