diff options
| -rw-r--r-- | lux-mode/lux-mode.el | 5 | ||||
| -rw-r--r-- | new-luxc/source/luxc/io.jvm.lux | 37 | ||||
| -rw-r--r-- | new-luxc/source/luxc/module/descriptor/annotation.lux | 7 | ||||
| -rw-r--r-- | new-luxc/source/luxc/module/descriptor/type.lux | 75 | ||||
| -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 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/effect.lux | 25 | ||||
| -rw-r--r-- | stdlib/test/test/lux/host.jvm.lux | 27 | ||||
| -rw-r--r-- | stdlib/test/test/lux/macro/ast.lux | 37 | ||||
| -rw-r--r-- | stdlib/test/test/lux/macro/syntax.lux | 76 | ||||
| -rw-r--r-- | stdlib/test/test/lux/type.lux | 40 |
18 files changed, 328 insertions, 303 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 0dc38676d..1556d40d8 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -218,7 +218,7 @@ Called by `imenu--generic-function'." "exception:" "function" "case" ":" ":!" ":!!" "undefined" "ident-for" "and" "or" - "exec" "let" "let%" "if" "cond" "do" "be" "open" "loop" "recur" "comment" "list" "list&" "io" "vector" "tree" + "exec" "let" "with-expansions" "if" "cond" "do" "be" "open" "loop" "recur" "comment" "list" "list&" "io" "vector" "tree" "get@" "set@" "update@" "|>" "|>." "<|" "<|." "_$" "$_" "~" "~@" "~'" "::" ":::" "default" "|" "&" "->" "All" "Ex" "Rec" "host" "$" "type" "^" "^or" "^slots" "^=>" "^~" "^@" "^template" "^open" "^|>" "^stream&" "^regex" @@ -340,7 +340,7 @@ This function also returns nil meaning don't specify the indentation." ((or (eq method 'defun) (and (null method) (> (length function) 3) - (string-match "\\`\\(?:\\S +/\\)?\\(\\w+:\\|\\(\\w+;\\)?with-\\)" + (string-match "\\`\\(?:\\S +/\\)?\\(\\w+:\\|\\(\\w*;\\)?with-\\)" function))) (lisp-indent-defform state indent-point)) ((integerp method) @@ -365,7 +365,6 @@ This function also returns nil meaning don't specify the indentation." (def 'defun) (function 'defun) (let 'defun) - (let% 'defun) (case 'defun) (do 'defun) (exec 'defun) diff --git a/new-luxc/source/luxc/io.jvm.lux b/new-luxc/source/luxc/io.jvm.lux index ab62b8f43..18142e77a 100644 --- a/new-luxc/source/luxc/io.jvm.lux +++ b/new-luxc/source/luxc/io.jvm.lux @@ -67,24 +67,25 @@ (-> (List &;Path) Text (P;Promise (E;Error [&;Path Text]))) (let [host-path (format module-name host-extension ".lux") lux-path (format module-name ".lux")] - (let% [<tries> (do-template [<path>] - [(do P;Monad<Promise> - [?file (find-in-sources <path> source-dirs)]) - (case ?file - (#;Some file) - (do @ - [?code (read-source-code file)] - (case ?code - (#E;Error error) - (wrap (#E;Error error)) - - (#E;Success code) - (wrap (#E;Success [<path> code])))) - - #;None)] - - [host-path] - [lux-path])] + (with-expansions + [<tries> (do-template [<path>] + [(do P;Monad<Promise> + [?file (find-in-sources <path> source-dirs)]) + (case ?file + (#;Some file) + (do @ + [?code (read-source-code file)] + (case ?code + (#E;Error error) + (wrap (#E;Error error)) + + (#E;Success code) + (wrap (#E;Success [<path> code])))) + + #;None)] + + [host-path] + [lux-path])] (<| <tries> (wrap (#E;Error (format "Module cannot be found: " module-name))))))) diff --git a/new-luxc/source/luxc/module/descriptor/annotation.lux b/new-luxc/source/luxc/module/descriptor/annotation.lux index 9a687e02a..d5e0d8000 100644 --- a/new-luxc/source/luxc/module/descriptor/annotation.lux +++ b/new-luxc/source/luxc/module/descriptor/annotation.lux @@ -64,9 +64,10 @@ (def: ann-value-decoder (l;Lexer Ann-Value) - (let% [<simple> (do-template [<tag> <lexer> <signal>] - [(do l;Monad<Lexer> - [])])] + (with-expansions + [<simple> (do-template [<tag> <lexer> <signal>] + [(do l;Monad<Lexer> + [])])] ($_ l;either <simple> (|> ... (l;after (l;text bool-signal))) diff --git a/new-luxc/source/luxc/module/descriptor/type.lux b/new-luxc/source/luxc/module/descriptor/type.lux index d9079e893..d661aa385 100644 --- a/new-luxc/source/luxc/module/descriptor/type.lux +++ b/new-luxc/source/luxc/module/descriptor/type.lux @@ -76,43 +76,44 @@ (l;Lexer Type) (l;rec (function [type-decoder] - (let% [<simple> (do-template [<type> <signal>] - [(|> (l/wrap <type>) (l;after (l;text <signal>)))] - - [Type type-signal] - [#;Void void-signal] - [#;Unit unit-signal]) - <combinators> (do-template [<tag> <prefix>] - [(do l;Monad<Lexer> - [_ (l;text <prefix>) - left type-decoder - right type-decoder] - (wrap (<tag> left right)))] - - [#;Product product-signal] - [#;Sum sum-signal] - [#;Function function-signal] - [#;App application-signal]) - <abstractions> (do-template [<tag> <prefix>] - [(do l;Monad<Lexer> - [_ (l;text <prefix>) - env (&;decode-list type-decoder) - body type-decoder] - (wrap (<tag> env body)))] - - [#;UnivQ uq-signal] - [#;ExQ eq-signal]) - <wildcards> (do-template [<tag> <prefix>] - [(do l;Monad<Lexer> - [_ (l;text <prefix>) - id (l;codec number;Codec<Text,Int> - (l;some' l;digit)) - _ (l;text &;stop-signal)] - (wrap (<tag> (int-to-nat id))))] - - [#;Bound bound-signal] - [#;Ex ex-signal] - [#;Var var-signal])] + (with-expansions + [<simple> (do-template [<type> <signal>] + [(|> (l/wrap <type>) (l;after (l;text <signal>)))] + + [Type type-signal] + [#;Void void-signal] + [#;Unit unit-signal]) + <combinators> (do-template [<tag> <prefix>] + [(do l;Monad<Lexer> + [_ (l;text <prefix>) + left type-decoder + right type-decoder] + (wrap (<tag> left right)))] + + [#;Product product-signal] + [#;Sum sum-signal] + [#;Function function-signal] + [#;App application-signal]) + <abstractions> (do-template [<tag> <prefix>] + [(do l;Monad<Lexer> + [_ (l;text <prefix>) + env (&;decode-list type-decoder) + body type-decoder] + (wrap (<tag> env body)))] + + [#;UnivQ uq-signal] + [#;ExQ eq-signal]) + <wildcards> (do-template [<tag> <prefix>] + [(do l;Monad<Lexer> + [_ (l;text <prefix>) + id (l;codec number;Codec<Text,Int> + (l;some' l;digit)) + _ (l;text &;stop-signal)] + (wrap (<tag> (int-to-nat id))))] + + [#;Bound bound-signal] + [#;Ex ex-signal] + [#;Var var-signal])] ($_ l;either (do l;Monad<Lexer> [_ (l;text host-signal) 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> ))) |