diff options
Diffstat (limited to 'stdlib/source/test/lux/macro')
-rw-r--r-- | stdlib/source/test/lux/macro/code.lux | 36 | ||||
-rw-r--r-- | stdlib/source/test/lux/macro/poly/equivalence.lux | 71 | ||||
-rw-r--r-- | stdlib/source/test/lux/macro/poly/functor.lux | 24 | ||||
-rw-r--r-- | stdlib/source/test/lux/macro/syntax.lux | 155 |
4 files changed, 286 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux new file mode 100644 index 000000000..02baf04a5 --- /dev/null +++ b/stdlib/source/test/lux/macro/code.lux @@ -0,0 +1,36 @@ +(.module: + [lux #* + [io] + [control + [monad (#+ do Monad)]] + [data + [number] + ["." text ("text/." equivalence) + format]] + [math + ["r" random]] + [macro + ["&" code]]] + lux/test) + +(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>)))] + + [(&.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>))) diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux new file mode 100644 index 000000000..3d943f6e6 --- /dev/null +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -0,0 +1,71 @@ +(.module: + [lux #* + [control + [monad (#+ do Monad)] + [equivalence (#+ Equivalence)]] + [data + ["." bit] + ["." maybe] + [number ("int/." int-number)] + ["." text + format] + [collection + ["." list]]] + [math + ["r" random]] + ["." macro + [poly (#+ derived:) + ["&" equivalence]]]] + lux/test) + +(type: Variant + (#Case0 Bit) + (#Case1 Int) + (#Case2 Frac)) + +(type: #rec Recursive + (#Number Frac) + (#Addition Frac Recursive)) + +(type: Record + {#bit Bit + #int Int + #frac Frac + #text Text + #maybe (Maybe Int) + #list (List Int) + #variant Variant + #tuple [Int Frac Text] + #recursive Recursive}) + +(def: gen-recursive + (r.Random Recursive) + (r.rec (function (_ gen-recursive) + (r.or r.frac + (r.and r.frac gen-recursive))))) + +(def: gen-record + (r.Random Record) + (do r.monad + [size (:: @ map (n/% 2) r.nat) + #let [gen-int (|> r.int (:: @ map (|>> int/abs (i/% +1_000_000))))]] + ($_ r.and + r.bit + gen-int + r.frac + (r.unicode size) + (r.maybe gen-int) + (r.list size gen-int) + ($_ r.or r.bit gen-int r.frac) + ($_ r.and gen-int r.frac (r.unicode size)) + gen-recursive))) + +(derived: (&.Equivalence<?> Record)) + +(context: "Equivalence polytypism" + (<| (times 100) + (do @ + [sample gen-record + #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 new file mode 100644 index 000000000..873259496 --- /dev/null +++ b/stdlib/source/test/lux/macro/poly/functor.lux @@ -0,0 +1,24 @@ +(.module: + [lux #* + [control + ["." state]] + [data + ["." identity]] + [macro + [poly (#+ derived:) + ["&" functor]]]] + lux/test) + +## [Utils] +(derived: (&.Functor<?> .Maybe)) + +(derived: (&.Functor<?> .List)) + +(derived: (&.Functor<?> state.State)) + +(derived: (&.Functor<?> identity.Identity)) + +## [Tests] +(context: "Functor polytypism." + (test "Can derive functors automatically." + #1)) diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux new file mode 100644 index 000000000..ff8c1c433 --- /dev/null +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -0,0 +1,155 @@ +(.module: + [lux #* + [control + [monad (#+ do Monad)] + [equivalence (#+ Equivalence)] + ["p" parser]] + [data + ["." bit] + ["." name] + ["." error (#+ Error)] + ["." number] + ["." text + format]] + [math + ["r" random]] + ["." macro + ["." code] + ["s" syntax (#+ syntax: Syntax)]]] + lux/test) + +## [Utils] +(def: (enforced? parser input) + (-> (Syntax []) (List Code) Bit) + (case (p.run input parser) + (#.Right [_ []]) + #1 + + _ + #0)) + +(def: (found? parser input) + (-> (Syntax Bit) (List Code) Bit) + (case (p.run input parser) + (#.Right [_ #1]) + #1 + + _ + #0)) + +(def: (equals? Equivalence<a> reference parser input) + (All [a] (-> (Equivalence a) a (Syntax a) (List Code) Bit)) + (case (p.run input parser) + (#.Right [_ output]) + (:: Equivalence<a> = reference output) + + _ + #0)) + +(def: (fails? input) + (All [a] (-> (Error a) Bit)) + (case input + (#.Left _) + #1 + + _ + #0)) + +(syntax: (match pattern input) + (wrap (list (` (case (~ input) + (^ (#.Right [(~' _) (~ pattern)])) + #1 + + (~' _) + #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!)))) + )) |