aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/macro
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/lux/macro')
-rw-r--r--stdlib/source/test/lux/macro/code.lux36
-rw-r--r--stdlib/source/test/lux/macro/poly/equivalence.lux71
-rw-r--r--stdlib/source/test/lux/macro/poly/functor.lux24
-rw-r--r--stdlib/source/test/lux/macro/syntax.lux155
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!))))
+ ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-12 20:41:50 +0000