diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/macro/poly/functor.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/format/json.lux | 65 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro.lux | 27 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/code.lux | 59 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/poly/equivalence.lux | 35 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/poly/functor.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/poly/json.lux | 114 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/syntax.lux | 201 |
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!)))) + ) + ))) |