diff options
Diffstat (limited to 'stdlib/source')
-rw-r--r-- | stdlib/source/lux.lux | 51 | ||||
-rw-r--r-- | stdlib/source/lux/concurrency/promise.lux | 42 | ||||
-rw-r--r-- | stdlib/source/lux/control/pipe.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/data/coll/ordered.lux | 39 | ||||
-rw-r--r-- | stdlib/source/lux/data/format/json.lux | 56 | ||||
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 25 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly.lux | 29 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly/eq.lux | 27 | ||||
-rw-r--r-- | stdlib/source/lux/macro/poly/text-encoder.lux | 27 |
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> |