aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux51
-rw-r--r--stdlib/source/lux/concurrency/promise.lux42
-rw-r--r--stdlib/source/lux/control/pipe.lux6
-rw-r--r--stdlib/source/lux/data/coll/ordered.lux39
-rw-r--r--stdlib/source/lux/data/format/json.lux56
-rw-r--r--stdlib/source/lux/host.jvm.lux25
-rw-r--r--stdlib/source/lux/macro/poly.lux29
-rw-r--r--stdlib/source/lux/macro/poly/eq.lux27
-rw-r--r--stdlib/source/lux/macro/poly/text-encoder.lux27
-rw-r--r--stdlib/test/test/lux/control/effect.lux25
-rw-r--r--stdlib/test/test/lux/host.jvm.lux27
-rw-r--r--stdlib/test/test/lux/macro/ast.lux37
-rw-r--r--stdlib/test/test/lux/macro/syntax.lux76
-rw-r--r--stdlib/test/test/lux/type.lux40
14 files changed, 265 insertions, 242 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index f530f9ca5..af5a0d142 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -5273,30 +5273,31 @@
(wrap (list (record$ =pairs))))
))
-(macro: #export (let% tokens)
+(macro: #export (with-expansions tokens)
{#;doc (doc "Controlled macro-expansion."
"Bind an arbitraty number of ASTs resulting from macro-expansion to local bindings."
"Wherever a binding appears, the bound ASTs will be spliced in there."
(test: "AST operations & structures"
- (let% [<tests> (do-template [<expr> <text> <pattern>]
- [(compare <pattern> <expr>)
- (compare <text> (:: AST/encode show <expr>))
- (compare true (:: Eq<AST> = <expr> <expr>))]
-
- [(bool true) "true" [_ (#;Bool true)]]
- [(bool false) "false" [_ (#;Bool false)]]
- [(int 123) "123" [_ (#;Int 123)]]
- [(real 123.0) "123.0" [_ (#;Real 123.0)]]
- [(char #"\n") "#\"\\n\"" [_ (#;Char #"\n")]]
- [(text "\n") "\"\\n\"" [_ (#;Text "\n")]]
- [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;Tag ["yolo" "lol"])]]
- [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;Symbol ["yolo" "lol"])]]
- [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;Form (list [_ (#;Bool true)] [_ (#;Int 123)]))])]
- [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;Tuple (list [_ (#;Bool true)] [_ (#;Int 123)]))])]
- [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;Record (list [[_ (#;Bool true)] [_ (#;Int 123)]]))])]
- [(local-tag "lol") "#lol" [_ (#;Tag ["" "lol"])]]
- [(local-symbol "lol") "lol" [_ (#;Symbol ["" "lol"])]]
- )]
+ (with-expansions
+ [<tests> (do-template [<expr> <text> <pattern>]
+ [(compare <pattern> <expr>)
+ (compare <text> (:: AST/encode show <expr>))
+ (compare true (:: Eq<AST> = <expr> <expr>))]
+
+ [(bool true) "true" [_ (#;Bool true)]]
+ [(bool false) "false" [_ (#;Bool false)]]
+ [(int 123) "123" [_ (#;Int 123)]]
+ [(real 123.0) "123.0" [_ (#;Real 123.0)]]
+ [(char #"\n") "#\"\\n\"" [_ (#;Char #"\n")]]
+ [(text "\n") "\"\\n\"" [_ (#;Text "\n")]]
+ [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;Tag ["yolo" "lol"])]]
+ [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;Symbol ["yolo" "lol"])]]
+ [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;Form (list [_ (#;Bool true)] [_ (#;Int 123)]))])]
+ [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;Tuple (list [_ (#;Bool true)] [_ (#;Int 123)]))])]
+ [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;Record (list [[_ (#;Bool true)] [_ (#;Int 123)]]))])]
+ [(local-tag "lol") "#lol" [_ (#;Tag ["" "lol"])]]
+ [(local-symbol "lol") "lol" [_ (#;Symbol ["" "lol"])]]
+ )]
(test-all <tests>))))}
(case tokens
(^ (list& [_ (#Tuple bindings)] bodies))
@@ -5304,21 +5305,23 @@
(^ (list& [_ (#Symbol ["" var-name])] macro-expr bindings'))
(do Monad<Lux>
[expansion (macro-expand-once macro-expr)]
- (case (place-tokens var-name expansion (` (;let% [(~@ bindings')] (~@ bodies))))
+ (case (place-tokens var-name expansion (` (;with-expansions
+ [(~@ bindings')]
+ (~@ bodies))))
(#Some output)
(wrap output)
_
- (fail "[let%] Improper macro expansion.")))
+ (fail "[with-expansions] Improper macro expansion.")))
#Nil
(return bodies)
_
- (fail "Wrong syntax for let%"))
+ (fail "Wrong syntax for with-expansions"))
_
- (fail "Wrong syntax for let%")))
+ (fail "Wrong syntax for with-expansions")))
(def: (flatten-alias type)
(-> Type Type)
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index ef3d28a29..edca7d05a 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -148,16 +148,17 @@
{#;doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Promise a) (Promise b) (Promise (| a b))))
(let [a|b (promise (Either ($ +0) ($ +1)))]
- (let% [<sides> (do-template [<promise> <tag>]
- [(await (function [value]
- (do Monad<IO>
- [_ (resolve (<tag> value) a|b)]
- (wrap [])))
- <promise>)]
-
- [left #;Left]
- [right #;Right]
- )]
+ (with-expansions
+ [<sides> (do-template [<promise> <tag>]
+ [(await (function [value]
+ (do Monad<IO>
+ [_ (resolve (<tag> value) a|b)]
+ (wrap [])))
+ <promise>)]
+
+ [left #;Left]
+ [right #;Right]
+ )]
(exec <sides>
a|b))))
@@ -165,16 +166,17 @@
{#;doc "Homogeneous alternative combinator."}
(All [a] (-> (Promise a) (Promise a) (Promise a)))
(let [left||right (promise ($ +0))]
- (let% [<sides> (do-template [<promise>]
- [(await [(function [value]
- (do Monad<IO>
- [_ (resolve value left||right)]
- (wrap [])))]
- <promise>)]
-
- [left]
- [right]
- )]
+ (with-expansions
+ [<sides> (do-template [<promise>]
+ [(await [(function [value]
+ (do Monad<IO>
+ [_ (resolve value left||right)]
+ (wrap [])))]
+ <promise>)]
+
+ [left]
+ [right]
+ )]
(exec <sides>
left||right))))
diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux
index 7c68c06f6..fb0273835 100644
--- a/stdlib/source/lux/control/pipe.lux
+++ b/stdlib/source/lux/control/pipe.lux
@@ -37,7 +37,8 @@
(|> 5
(@> [(i.+ @ @)])))}
(wrap (list (fold (function [next prev]
- (` (let% [(~ (ast;symbol ["" name])) (~ prev)]
+ (` (with-expansions
+ [(~ (ast;symbol ["" name])) (~ prev)]
(~ next))))
prev
body))))
@@ -53,7 +54,8 @@
[i.odd?] [(i.* 3)]
[(_> -1)])))}
(with-gensyms [g!temp]
- (wrap (list (` (let% [(~ g!temp) (~ prev)]
+ (wrap (list (` (with-expansions
+ [(~ g!temp) (~ prev)]
(cond (~@ (do Monad<List>
[[test then] branches]
(list (` (|> (~ g!temp) (~@ test)))
diff --git a/stdlib/source/lux/data/coll/ordered.lux b/stdlib/source/lux/data/coll/ordered.lux
index 5ecf96781..c6fd5937f 100644
--- a/stdlib/source/lux/data/coll/ordered.lux
+++ b/stdlib/source/lux/data/coll/ordered.lux
@@ -105,9 +105,10 @@
(def: (balance-left-add parent self)
(All [a] (-> (Node a) (Node a) (Node a)))
- (let% [<default-behavior> (as-is (black (get@ #value parent)
- (#;Some self)
- (get@ #right parent)))]
+ (with-expansions
+ [<default-behavior> (as-is (black (get@ #value parent)
+ (#;Some self)
+ (get@ #right parent)))]
(case (get@ #color self)
#Red
(case (get@ #left self)
@@ -140,9 +141,10 @@
(def: (balance-right-add parent self)
(All [a] (-> (Node a) (Node a) (Node a)))
- (let% [<default-behavior> (as-is (black (get@ #value parent)
- (get@ #left parent)
- (#;Some self)))]
+ (with-expansions
+ [<default-behavior> (as-is (black (get@ #value parent)
+ (get@ #left parent)
+ (#;Some self)))]
(case (get@ #color self)
#Red
(case (get@ #right self)
@@ -203,18 +205,19 @@
(#;Some root)
(let [reference (get@ #value root)]
- (let% [<sides> (do-template [<comp> <tag> <add>]
- [(<comp> reference elem)
- (let [side-root (get@ <tag> root)
- outcome (recur side-root)]
- (if (is side-root outcome)
- ?root
- (#;Some (<add> (default (undefined) outcome)
- root))))]
-
- [T/< #left add-left]
- [T/> #right add-right]
- )]
+ (with-expansions
+ [<sides> (do-template [<comp> <tag> <add>]
+ [(<comp> reference elem)
+ (let [side-root (get@ <tag> root)
+ outcome (recur side-root)]
+ (if (is side-root outcome)
+ ?root
+ (#;Some (<add> (default (undefined) outcome)
+ root))))]
+
+ [T/< #left add-left]
+ [T/> #right add-right]
+ )]
(cond <sides>
## (T/= reference elem)
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 41654d93d..535de1b53 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -773,15 +773,16 @@
(poly: #hidden (Codec<JSON,?>//encode *env* :x:)
(let [->Codec//encode (: (-> AST AST)
(function [.type.] (` (-> (~ .type.) JSON))))]
- (let% [<basic> (do-template [<type> <matcher> <encoder>]
- [(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//encode (` <type>))) <encoder>))))]
-
- [Unit poly;unit (function [(~ (ast;symbol ["" "0"]))] #Null)]
- [Bool poly;bool ;;gen-boolean]
- [Int poly;int (|>. ;int-to-real ;;gen-number)]
- [Real poly;real ;;gen-number]
- [Char poly;char (|>. char;as-text ;;gen-string)]
- [Text poly;text ;;gen-string])]
+ (with-expansions
+ [<basic> (do-template [<type> <matcher> <encoder>]
+ [(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//encode (` <type>))) <encoder>))))]
+
+ [Unit poly;unit (function [(~ (ast;symbol ["" "0"]))] #Null)]
+ [Bool poly;bool ;;gen-boolean]
+ [Int poly;int (|>. ;int-to-real ;;gen-number)]
+ [Real poly;real ;;gen-number]
+ [Char poly;char (|>. char;as-text ;;gen-string)]
+ [Text poly;text ;;gen-string])]
($_ macro;either
<basic>
(with-gensyms [g!type-fun g!case g!input g!key g!val]
@@ -924,24 +925,25 @@
(poly: #hidden (Codec<JSON,?>//decode *env* :x:)
(let [->Codec//decode (: (-> AST AST)
(function [.type.] (` (-> JSON (Error (~ .type.))))))]
- (let% [<basic> (do-template [<type> <matcher> <decoder>]
- [(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//decode (` <type>))) <decoder>))))]
-
- [Unit poly;unit ;;unit]
- [Bool poly;bool ;;bool]
- [Int poly;int ;;int]
- [Real poly;real ;;real]
- [Char poly;char ;;char]
- [Text poly;text ;;text])
- <complex> (do-template [<type> <matcher> <decoder>]
- [(do @
- [:sub: (<matcher> :x:)
- .sub. (Codec<JSON,?>//decode *env* :sub:)]
- (wrap (` (: (~ (->Codec//decode (type;to-ast :x:)))
- (<decoder> (~ .sub.))))))]
-
- [Maybe poly;maybe ;;nullable]
- [List poly;list ;;array])]
+ (with-expansions
+ [<basic> (do-template [<type> <matcher> <decoder>]
+ [(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//decode (` <type>))) <decoder>))))]
+
+ [Unit poly;unit ;;unit]
+ [Bool poly;bool ;;bool]
+ [Int poly;int ;;int]
+ [Real poly;real ;;real]
+ [Char poly;char ;;char]
+ [Text poly;text ;;text])
+ <complex> (do-template [<type> <matcher> <decoder>]
+ [(do @
+ [:sub: (<matcher> :x:)
+ .sub. (Codec<JSON,?>//decode *env* :sub:)]
+ (wrap (` (: (~ (->Codec//decode (type;to-ast :x:)))
+ (<decoder> (~ .sub.))))))]
+
+ [Maybe poly;maybe ;;nullable]
+ [List poly;list ;;array])]
($_ macro;either
<basic>
(with-gensyms [g!type-fun g!case g!input g!key g!val]
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index 2aa352cf7..96853e6f5 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -683,18 +683,19 @@
(wrap (#GenericWildcard (#;Some [bound-kind bound])))))
(do s;Monad<Syntax>
[name (full-class-name^ imports)]
- (let% [<branches> (do-template [<class> <name>]
- [(Text/= <name> name)
- (wrap (#GenericClass <class> (list)))]
-
- ["[Z" "Boolean-Array"]
- ["[B" "Byte-Array"]
- ["[S" "Short-Array"]
- ["[I" "Int-Array"]
- ["[J" "Long-Array"]
- ["[F" "Float-Array"]
- ["[D" "Double-Array"]
- ["[C" "Char-Array"])]
+ (with-expansions
+ [<branches> (do-template [<class> <name>]
+ [(Text/= <name> name)
+ (wrap (#GenericClass <class> (list)))]
+
+ ["[Z" "Boolean-Array"]
+ ["[B" "Byte-Array"]
+ ["[S" "Short-Array"]
+ ["[I" "Int-Array"]
+ ["[J" "Long-Array"]
+ ["[F" "Float-Array"]
+ ["[D" "Double-Array"]
+ ["[C" "Char-Array"])]
(cond (member? text;Eq<Text> (map product;left type-vars) name)
(wrap (#GenericTypeVar name))
diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux
index 3252cfeeb..decc25b93 100644
--- a/stdlib/source/lux/macro/poly.lux
+++ b/stdlib/source/lux/macro/poly.lux
@@ -63,20 +63,21 @@
(def: #export primitive
(Matcher Type)
(;function [:type:]
- (let% [<primitives> (do-template [<parser> <type>]
- [(do Monad<Lux>
- [_ (<parser> :type:)]
- (wrap <type>))]
-
- [void Void]
- [unit Unit]
- [bool Bool]
- [nat Nat]
- [int Int]
- [deg Deg]
- [real Real]
- [char Char]
- [text Text])]
+ (with-expansions
+ [<primitives> (do-template [<parser> <type>]
+ [(do Monad<Lux>
+ [_ (<parser> :type:)]
+ (wrap <type>))]
+
+ [void Void]
+ [unit Unit]
+ [bool Bool]
+ [nat Nat]
+ [int Int]
+ [deg Deg]
+ [real Real]
+ [char Char]
+ [text Text])]
($_ macro;either
<primitives>))))
diff --git a/stdlib/source/lux/macro/poly/eq.lux b/stdlib/source/lux/macro/poly/eq.lux
index a26566e79..dc3b84cce 100644
--- a/stdlib/source/lux/macro/poly/eq.lux
+++ b/stdlib/source/lux/macro/poly/eq.lux
@@ -35,20 +35,21 @@
(poly: #export (Eq<?> env :x:)
(let [->Eq (: (-> AST AST)
(function [.type.] (` (eq;Eq (~ .type.)))))]
- (let% [<basic> (do-template [<type> <matcher> <eq>]
- [(do @
- [_ (<matcher> :x:)]
- (wrap (` (: (~ (->Eq (` <type>)))
- <eq>))))]
+ (with-expansions
+ [<basic> (do-template [<type> <matcher> <eq>]
+ [(do @
+ [_ (<matcher> :x:)]
+ (wrap (` (: (~ (->Eq (` <type>)))
+ <eq>))))]
- [Unit poly;unit (function [(~' test) (~' input)] true)]
- [Bool poly;bool bool;Eq<Bool>]
- [Nat poly;nat number;Eq<Nat>]
- [Int poly;int number;Eq<Int>]
- [Deg poly;deg number;Eq<Deg>]
- [Real poly;real number;Eq<Real>]
- [Char poly;char char;Eq<Char>]
- [Text poly;text text;Eq<Text>])]
+ [Unit poly;unit (function [(~' test) (~' input)] true)]
+ [Bool poly;bool bool;Eq<Bool>]
+ [Nat poly;nat number;Eq<Nat>]
+ [Int poly;int number;Eq<Int>]
+ [Deg poly;deg number;Eq<Deg>]
+ [Real poly;real number;Eq<Real>]
+ [Char poly;char char;Eq<Char>]
+ [Text poly;text text;Eq<Text>])]
($_ macro;either
## Primitive types
<basic>
diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux
index 21215d851..10fd85ebe 100644
--- a/stdlib/source/lux/macro/poly/text-encoder.lux
+++ b/stdlib/source/lux/macro/poly/text-encoder.lux
@@ -36,20 +36,21 @@
(poly: #export (Codec<Text,?>::encode env :x:)
(let [->Codec::encode (: (-> AST AST)
(function [.type.] (` (-> (~ .type.) Text))))]
- (let% [<basic> (do-template [<type> <matcher> <encoder>]
- [(do @
- [_ (<matcher> :x:)]
- (wrap (` (: (~ (->Codec::encode (` <type>)))
- (~' <encoder>)))))]
+ (with-expansions
+ [<basic> (do-template [<type> <matcher> <encoder>]
+ [(do @
+ [_ (<matcher> :x:)]
+ (wrap (` (: (~ (->Codec::encode (` <type>)))
+ (~' <encoder>)))))]
- [Unit poly;unit (function [_0] "[]")]
- [Bool poly;bool (:: bool;Codec<Text,Bool> encode)]
- [Nat poly;nat (:: number;Codec<Text,Nat> encode)]
- [Int poly;int (:: number;Codec<Text,Int> encode)]
- [Deg poly;deg (:: number;Codec<Text,Deg> encode)]
- [Real poly;real (:: number;Codec<Text,Real> encode)]
- [Char poly;char (:: char;Codec<Text,Char> encode)]
- [Text poly;text (:: text;Codec<Text,Text> encode)])]
+ [Unit poly;unit (function [_0] "[]")]
+ [Bool poly;bool (:: bool;Codec<Text,Bool> encode)]
+ [Nat poly;nat (:: number;Codec<Text,Nat> encode)]
+ [Int poly;int (:: number;Codec<Text,Int> encode)]
+ [Deg poly;deg (:: number;Codec<Text,Deg> encode)]
+ [Real poly;real (:: number;Codec<Text,Real> encode)]
+ [Char poly;char (:: char;Codec<Text,Char> encode)]
+ [Text poly;text (:: text;Codec<Text,Text> encode)])]
($_ macro;either
## Primitives
<basic>
diff --git a/stdlib/test/test/lux/control/effect.lux b/stdlib/test/test/lux/control/effect.lux
index 39e5afa5d..abbdca56a 100644
--- a/stdlib/test/test/lux/control/effect.lux
+++ b/stdlib/test/test/lux/control/effect.lux
@@ -46,19 +46,20 @@
## [Tests]
(test: "Algebraic effects"
- (let% [<single-effect-tests> (do-template [<op> <op-size> <field> <field-value>]
- [(io;run (with-handler Handler<EffABC,IO>
- (doE Functor<EffABC>
- []
- (lift (<op> <op-size> "YOLO")))))
- (n.= <field-value> (io;run (with-handler Handler<EffABC,IO>
- (doE Functor<EffABC>
- []
- (lift <field>)))))]
+ (with-expansions
+ [<single-effect-tests> (do-template [<op> <op-size> <field> <field-value>]
+ [(io;run (with-handler Handler<EffABC,IO>
+ (doE Functor<EffABC>
+ []
+ (lift (<op> <op-size> "YOLO")))))
+ (n.= <field-value> (io;run (with-handler Handler<EffABC,IO>
+ (doE Functor<EffABC>
+ []
+ (lift <field>)))))]
- [opA +10 fieldA +10]
- [opB +4 fieldB +20]
- [opC +2 fieldC +30])]
+ [opA +10 fieldA +10]
+ [opB +4 fieldB +20]
+ [opC +2 fieldC +30])]
(assert "Can handle effects using handlers."
(and <single-effect-tests>
diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux
index 93fe5b5e6..ae12784af 100644
--- a/stdlib/test/test/lux/host.jvm.lux
+++ b/stdlib/test/test/lux/host.jvm.lux
@@ -54,19 +54,20 @@
(test: "Conversions"
[sample R;int]
- (let% [<int-convs> (do-template [<to> <from> <message>]
- [(assert <message>
- (or (|> sample <to> <from> (i.= sample))
- (let [capped-sample (|> sample <to> <from>)]
- (|> capped-sample <to> <from> (i.= capped-sample)))))]
-
- [&;l2b &;b2l "Can succesfully convert to/from byte."]
- [&;l2s &;s2l "Can succesfully convert to/from short."]
- [&;l2i &;i2l "Can succesfully convert to/from int."]
- [&;l2f &;f2l "Can succesfully convert to/from float."]
- [&;l2d &;d2l "Can succesfully convert to/from double."]
- [(<| &;i2c &;l2i) (<| &;i2l &;c2i) "Can succesfully convert to/from char."]
- )]
+ (with-expansions
+ [<int-convs> (do-template [<to> <from> <message>]
+ [(assert <message>
+ (or (|> sample <to> <from> (i.= sample))
+ (let [capped-sample (|> sample <to> <from>)]
+ (|> capped-sample <to> <from> (i.= capped-sample)))))]
+
+ [&;l2b &;b2l "Can succesfully convert to/from byte."]
+ [&;l2s &;s2l "Can succesfully convert to/from short."]
+ [&;l2i &;i2l "Can succesfully convert to/from int."]
+ [&;l2f &;f2l "Can succesfully convert to/from float."]
+ [&;l2d &;d2l "Can succesfully convert to/from double."]
+ [(<| &;i2c &;l2i) (<| &;i2l &;c2i) "Can succesfully convert to/from char."]
+ )]
($_ seq
<int-convs>
)))
diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/ast.lux
index 95ac999a0..8670ead71 100644
--- a/stdlib/test/test/lux/macro/ast.lux
+++ b/stdlib/test/test/lux/macro/ast.lux
@@ -10,23 +10,24 @@
lux/test)
(test: "AST"
- (let% [<tests> (do-template [<expr> <text>]
- [(assert (format "Can produce AST node: " <text>)
- (and (T/= <text> (&;to-text <expr>))
- (:: &;Eq<AST> = <expr> <expr>)))]
+ (with-expansions
+ [<tests> (do-template [<expr> <text>]
+ [(assert (format "Can produce AST node: " <text>)
+ (and (T/= <text> (&;to-text <expr>))
+ (:: &;Eq<AST> = <expr> <expr>)))]
- [(&;bool true) "true"]
- [(&;bool false) "false"]
- [(&;int 123) "123"]
- [(&;real 123.0) "123.0"]
- [(&;char #"\n") "#\"\\n\""]
- [(&;text "\n") "\"\\n\""]
- [(&;tag ["yolo" "lol"]) "#yolo;lol"]
- [(&;symbol ["yolo" "lol"]) "yolo;lol"]
- [(&;form (list (&;bool true) (&;int 123))) "(true 123)"]
- [(&;tuple (list (&;bool true) (&;int 123))) "[true 123]"]
- [(&;record (list [(&;bool true) (&;int 123)])) "{true 123}"]
- [(&;local-tag "lol") "#lol"]
- [(&;local-symbol "lol") "lol"]
- )]
+ [(&;bool true) "true"]
+ [(&;bool false) "false"]
+ [(&;int 123) "123"]
+ [(&;real 123.0) "123.0"]
+ [(&;char #"\n") "#\"\\n\""]
+ [(&;text "\n") "\"\\n\""]
+ [(&;tag ["yolo" "lol"]) "#yolo;lol"]
+ [(&;symbol ["yolo" "lol"]) "yolo;lol"]
+ [(&;form (list (&;bool true) (&;int 123))) "(true 123)"]
+ [(&;tuple (list (&;bool true) (&;int 123))) "[true 123]"]
+ [(&;record (list [(&;bool true) (&;int 123)])) "{true 123}"]
+ [(&;local-tag "lol") "#lol"]
+ [(&;local-symbol "lol") "lol"]
+ )]
($_ seq <tests>)))
diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux
index f523f227c..41c372e15 100644
--- a/stdlib/test/test/lux/macro/syntax.lux
+++ b/stdlib/test/test/lux/macro/syntax.lux
@@ -63,22 +63,23 @@
## [Tests]
(test: "Simple value syntax."
- (let% [<simple-tests> (do-template [<assertion> <value> <ctor> <Eq> <get>]
- [(assert <assertion>
- (and (is? <Eq> <value> <get> (list (<ctor> <value>)))
- (found? (s;this? (<ctor> <value>)) (list (<ctor> <value>)))
- (enforced? (s;this! (<ctor> <value>)) (list (<ctor> <value>)))))]
-
- ["Can parse Bool syntax." true ast;bool bool;Eq<Bool> s;bool]
- ["Can parse Nat syntax." +123 ast;nat number;Eq<Nat> s;nat]
- ["Can parse Int syntax." 123 ast;int number;Eq<Int> s;int]
- ["Can parse Deg syntax." .123 ast;deg number;Eq<Deg> s;deg]
- ["Can parse Real syntax." 123.0 ast;real number;Eq<Real> s;real]
- ["Can parse Char syntax." #"\n" ast;char char;Eq<Char> s;char]
- ["Can parse Text syntax." "\n" ast;text text;Eq<Text> s;text]
- ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq<Ident> s;symbol]
- ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq<Ident> s;tag]
- )]
+ (with-expansions
+ [<simple-tests> (do-template [<assertion> <value> <ctor> <Eq> <get>]
+ [(assert <assertion>
+ (and (is? <Eq> <value> <get> (list (<ctor> <value>)))
+ (found? (s;this? (<ctor> <value>)) (list (<ctor> <value>)))
+ (enforced? (s;this! (<ctor> <value>)) (list (<ctor> <value>)))))]
+
+ ["Can parse Bool syntax." true ast;bool bool;Eq<Bool> s;bool]
+ ["Can parse Nat syntax." +123 ast;nat number;Eq<Nat> s;nat]
+ ["Can parse Int syntax." 123 ast;int number;Eq<Int> s;int]
+ ["Can parse Deg syntax." .123 ast;deg number;Eq<Deg> s;deg]
+ ["Can parse Real syntax." 123.0 ast;real number;Eq<Real> s;real]
+ ["Can parse Char syntax." #"\n" ast;char char;Eq<Char> s;char]
+ ["Can parse Text syntax." "\n" ast;text text;Eq<Text> s;text]
+ ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq<Ident> s;symbol]
+ ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq<Ident> s;tag]
+ )]
($_ seq
<simple-tests>
@@ -98,27 +99,28 @@
)))
(test: "Complex value syntax."
- (let% [<group-tests> (do-template [<type> <parser> <ctor>]
- [(assert (format "Can parse " <type> " syntax.")
- (and (match [true 123]
- (s;run (list (<ctor> (list (ast;bool true) (ast;int 123))))
- (<parser> (s;seq s;bool s;int))))
- (match true
- (s;run (list (<ctor> (list (ast;bool true))))
- (<parser> s;bool)))
- (fails? (s;run (list (<ctor> (list (ast;bool true) (ast;int 123))))
- (<parser> s;bool)))
- (match (#;Left true)
- (s;run (list (<ctor> (list (ast;bool true))))
- (<parser> (s;alt s;bool s;int))))
- (match (#;Right 123)
- (s;run (list (<ctor> (list (ast;int 123))))
- (<parser> (s;alt s;bool s;int))))
- (fails? (s;run (list (<ctor> (list (ast;real 123.0))))
- (<parser> (s;alt s;bool s;int))))))]
-
- ["form" s;form ast;form]
- ["tuple" s;tuple ast;tuple])]
+ (with-expansions
+ [<group-tests> (do-template [<type> <parser> <ctor>]
+ [(assert (format "Can parse " <type> " syntax.")
+ (and (match [true 123]
+ (s;run (list (<ctor> (list (ast;bool true) (ast;int 123))))
+ (<parser> (s;seq s;bool s;int))))
+ (match true
+ (s;run (list (<ctor> (list (ast;bool true))))
+ (<parser> s;bool)))
+ (fails? (s;run (list (<ctor> (list (ast;bool true) (ast;int 123))))
+ (<parser> s;bool)))
+ (match (#;Left true)
+ (s;run (list (<ctor> (list (ast;bool true))))
+ (<parser> (s;alt s;bool s;int))))
+ (match (#;Right 123)
+ (s;run (list (<ctor> (list (ast;int 123))))
+ (<parser> (s;alt s;bool s;int))))
+ (fails? (s;run (list (<ctor> (list (ast;real 123.0))))
+ (<parser> (s;alt s;bool s;int))))))]
+
+ ["form" s;form ast;form]
+ ["tuple" s;tuple ast;tuple])]
($_ seq
<group-tests>
diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux
index 77858e7fa..e0087960f 100644
--- a/stdlib/test/test/lux/type.lux
+++ b/stdlib/test/test/lux/type.lux
@@ -92,16 +92,17 @@
(seqM @))
#let [(^open "&/") &;Eq<Type>
(^open "L/") (list;Eq<List> &;Eq<Type>)]]
- (let% [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>]
- [(assert (format "Can build and tear-down " <desc> " types.")
- (let [flat (|> members <ctor> <dtor>)]
- (or (L/= members flat)
- (and (L/= (list) members)
- (L/= (list <unit>) flat)))))]
-
- ["variant" &;variant &;flatten-variant Void]
- ["tuple" &;tuple &;flatten-tuple Unit]
- )]
+ (with-expansions
+ [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>]
+ [(assert (format "Can build and tear-down " <desc> " types.")
+ (let [flat (|> members <ctor> <dtor>)]
+ (or (L/= members flat)
+ (and (L/= (list) members)
+ (L/= (list <unit>) flat)))))]
+
+ ["variant" &;variant &;flatten-variant Void]
+ ["tuple" &;tuple &;flatten-tuple Unit]
+ )]
($_ seq
<struct-tests>
)))
@@ -141,15 +142,16 @@
_
true))))
#let [(^open "&/") &;Eq<Type>]]
- (let% [<quant-tests> (do-template [<desc> <ctor> <dtor>]
- [(assert (format "Can build and tear-down " <desc> " types.")
- (let [[flat-size flat-body] (|> extra (<ctor> size) <dtor>)]
- (and (n.= size flat-size)
- (&/= extra flat-body))))]
-
- ["universally-quantified" &;univq &;flatten-univq]
- ["existentially-quantified" &;exq &;flatten-exq]
- )]
+ (with-expansions
+ [<quant-tests> (do-template [<desc> <ctor> <dtor>]
+ [(assert (format "Can build and tear-down " <desc> " types.")
+ (let [[flat-size flat-body] (|> extra (<ctor> size) <dtor>)]
+ (and (n.= size flat-size)
+ (&/= extra flat-body))))]
+
+ ["universally-quantified" &;univq &;flatten-univq]
+ ["existentially-quantified" &;exq &;flatten-exq]
+ )]
($_ seq
<quant-tests>
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 13:22:46 +0000