aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
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
9 files changed, 159 insertions, 143 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>
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 17:12:42 +0000