From db697bb636e2341d26bb188cc1b9981a1ab505d7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 7 May 2017 14:30:48 -0400 Subject: - Changed the name of "let%" to "with-expansions". --- lux-mode/lux-mode.el | 5 +- new-luxc/source/luxc/io.jvm.lux | 37 ++++++----- .../source/luxc/module/descriptor/annotation.lux | 7 +- new-luxc/source/luxc/module/descriptor/type.lux | 75 ++++++++++----------- stdlib/source/lux.lux | 51 ++++++++------- stdlib/source/lux/concurrency/promise.lux | 42 ++++++------ stdlib/source/lux/control/pipe.lux | 6 +- stdlib/source/lux/data/coll/ordered.lux | 39 ++++++----- stdlib/source/lux/data/format/json.lux | 56 ++++++++-------- stdlib/source/lux/host.jvm.lux | 25 +++---- stdlib/source/lux/macro/poly.lux | 29 +++++---- stdlib/source/lux/macro/poly/eq.lux | 27 ++++---- stdlib/source/lux/macro/poly/text-encoder.lux | 27 ++++---- stdlib/test/test/lux/control/effect.lux | 25 +++---- stdlib/test/test/lux/host.jvm.lux | 27 ++++---- stdlib/test/test/lux/macro/ast.lux | 37 ++++++----- stdlib/test/test/lux/macro/syntax.lux | 76 +++++++++++----------- 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% [ (do-template [] - [(do P;Monad - [?file (find-in-sources 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 [ code])))) - - #;None)] - - [host-path] - [lux-path])] + (with-expansions + [ (do-template [] + [(do P;Monad + [?file (find-in-sources 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 [ code])))) + + #;None)] + + [host-path] + [lux-path])] (<| (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% [ (do-template [ ] - [(do l;Monad - [])])] + (with-expansions + [ (do-template [ ] + [(do l;Monad + [])])] ($_ l;either (|> ... (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% [ (do-template [ ] - [(|> (l/wrap ) (l;after (l;text )))] - - [Type type-signal] - [#;Void void-signal] - [#;Unit unit-signal]) - (do-template [ ] - [(do l;Monad - [_ (l;text ) - left type-decoder - right type-decoder] - (wrap ( left right)))] - - [#;Product product-signal] - [#;Sum sum-signal] - [#;Function function-signal] - [#;App application-signal]) - (do-template [ ] - [(do l;Monad - [_ (l;text ) - env (&;decode-list type-decoder) - body type-decoder] - (wrap ( env body)))] - - [#;UnivQ uq-signal] - [#;ExQ eq-signal]) - (do-template [ ] - [(do l;Monad - [_ (l;text ) - id (l;codec number;Codec - (l;some' l;digit)) - _ (l;text &;stop-signal)] - (wrap ( (int-to-nat id))))] - - [#;Bound bound-signal] - [#;Ex ex-signal] - [#;Var var-signal])] + (with-expansions + [ (do-template [ ] + [(|> (l/wrap ) (l;after (l;text )))] + + [Type type-signal] + [#;Void void-signal] + [#;Unit unit-signal]) + (do-template [ ] + [(do l;Monad + [_ (l;text ) + left type-decoder + right type-decoder] + (wrap ( left right)))] + + [#;Product product-signal] + [#;Sum sum-signal] + [#;Function function-signal] + [#;App application-signal]) + (do-template [ ] + [(do l;Monad + [_ (l;text ) + env (&;decode-list type-decoder) + body type-decoder] + (wrap ( env body)))] + + [#;UnivQ uq-signal] + [#;ExQ eq-signal]) + (do-template [ ] + [(do l;Monad + [_ (l;text ) + id (l;codec number;Codec + (l;some' l;digit)) + _ (l;text &;stop-signal)] + (wrap ( (int-to-nat id))))] + + [#;Bound bound-signal] + [#;Ex ex-signal] + [#;Var var-signal])] ($_ l;either (do l;Monad [_ (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% [ (do-template [ ] - [(compare ) - (compare (:: AST/encode show )) - (compare true (:: Eq = ))] - - [(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 + [ (do-template [ ] + [(compare ) + (compare (:: AST/encode show )) + (compare true (:: Eq = ))] + + [(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 ))))} (case tokens (^ (list& [_ (#Tuple bindings)] bodies)) @@ -5304,21 +5305,23 @@ (^ (list& [_ (#Symbol ["" var-name])] macro-expr bindings')) (do Monad [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% [ (do-template [ ] - [(await (function [value] - (do Monad - [_ (resolve ( value) a|b)] - (wrap []))) - )] - - [left #;Left] - [right #;Right] - )] + (with-expansions + [ (do-template [ ] + [(await (function [value] + (do Monad + [_ (resolve ( value) a|b)] + (wrap []))) + )] + + [left #;Left] + [right #;Right] + )] (exec a|b)))) @@ -165,16 +166,17 @@ {#;doc "Homogeneous alternative combinator."} (All [a] (-> (Promise a) (Promise a) (Promise a))) (let [left||right (promise ($ +0))] - (let% [ (do-template [] - [(await [(function [value] - (do Monad - [_ (resolve value left||right)] - (wrap [])))] - )] - - [left] - [right] - )] + (with-expansions + [ (do-template [] + [(await [(function [value] + (do Monad + [_ (resolve value left||right)] + (wrap [])))] + )] + + [left] + [right] + )] (exec 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 [[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% [ (as-is (black (get@ #value parent) - (#;Some self) - (get@ #right parent)))] + (with-expansions + [ (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% [ (as-is (black (get@ #value parent) - (get@ #left parent) - (#;Some self)))] + (with-expansions + [ (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% [ (do-template [ ] - [( reference elem) - (let [side-root (get@ root) - outcome (recur side-root)] - (if (is side-root outcome) - ?root - (#;Some ( (default (undefined) outcome) - root))))] - - [T/< #left add-left] - [T/> #right add-right] - )] + (with-expansions + [ (do-template [ ] + [( reference elem) + (let [side-root (get@ root) + outcome (recur side-root)] + (if (is side-root outcome) + ?root + (#;Some ( (default (undefined) outcome) + root))))] + + [T/< #left add-left] + [T/> #right add-right] + )] (cond ## (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//encode *env* :x:) (let [->Codec//encode (: (-> AST AST) (function [.type.] (` (-> (~ .type.) JSON))))] - (let% [ (do-template [ ] - [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//encode (` ))) ))))] - - [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 + [ (do-template [ ] + [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//encode (` ))) ))))] + + [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 (with-gensyms [g!type-fun g!case g!input g!key g!val] @@ -924,24 +925,25 @@ (poly: #hidden (Codec//decode *env* :x:) (let [->Codec//decode (: (-> AST AST) (function [.type.] (` (-> JSON (Error (~ .type.))))))] - (let% [ (do-template [ ] - [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//decode (` ))) ))))] - - [Unit poly;unit ;;unit] - [Bool poly;bool ;;bool] - [Int poly;int ;;int] - [Real poly;real ;;real] - [Char poly;char ;;char] - [Text poly;text ;;text]) - (do-template [ ] - [(do @ - [:sub: ( :x:) - .sub. (Codec//decode *env* :sub:)] - (wrap (` (: (~ (->Codec//decode (type;to-ast :x:))) - ( (~ .sub.))))))] - - [Maybe poly;maybe ;;nullable] - [List poly;list ;;array])] + (with-expansions + [ (do-template [ ] + [(do @ [_ ( :x:)] (wrap (` (: (~ (->Codec//decode (` ))) ))))] + + [Unit poly;unit ;;unit] + [Bool poly;bool ;;bool] + [Int poly;int ;;int] + [Real poly;real ;;real] + [Char poly;char ;;char] + [Text poly;text ;;text]) + (do-template [ ] + [(do @ + [:sub: ( :x:) + .sub. (Codec//decode *env* :sub:)] + (wrap (` (: (~ (->Codec//decode (type;to-ast :x:))) + ( (~ .sub.))))))] + + [Maybe poly;maybe ;;nullable] + [List poly;list ;;array])] ($_ macro;either (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 [name (full-class-name^ imports)] - (let% [ (do-template [ ] - [(Text/= name) - (wrap (#GenericClass (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 + [ (do-template [ ] + [(Text/= name) + (wrap (#GenericClass (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 (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% [ (do-template [ ] - [(do Monad - [_ ( :type:)] - (wrap ))] - - [void Void] - [unit Unit] - [bool Bool] - [nat Nat] - [int Int] - [deg Deg] - [real Real] - [char Char] - [text Text])] + (with-expansions + [ (do-template [ ] + [(do Monad + [_ ( :type:)] + (wrap ))] + + [void Void] + [unit Unit] + [bool Bool] + [nat Nat] + [int Int] + [deg Deg] + [real Real] + [char Char] + [text Text])] ($_ macro;either )))) 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% [ (do-template [ ] - [(do @ - [_ ( :x:)] - (wrap (` (: (~ (->Eq (` ))) - ))))] + (with-expansions + [ (do-template [ ] + [(do @ + [_ ( :x:)] + (wrap (` (: (~ (->Eq (` ))) + ))))] - [Unit poly;unit (function [(~' test) (~' input)] true)] - [Bool poly;bool bool;Eq] - [Nat poly;nat number;Eq] - [Int poly;int number;Eq] - [Deg poly;deg number;Eq] - [Real poly;real number;Eq] - [Char poly;char char;Eq] - [Text poly;text text;Eq])] + [Unit poly;unit (function [(~' test) (~' input)] true)] + [Bool poly;bool bool;Eq] + [Nat poly;nat number;Eq] + [Int poly;int number;Eq] + [Deg poly;deg number;Eq] + [Real poly;real number;Eq] + [Char poly;char char;Eq] + [Text poly;text text;Eq])] ($_ macro;either ## Primitive types 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::encode env :x:) (let [->Codec::encode (: (-> AST AST) (function [.type.] (` (-> (~ .type.) Text))))] - (let% [ (do-template [ ] - [(do @ - [_ ( :x:)] - (wrap (` (: (~ (->Codec::encode (` ))) - (~' )))))] + (with-expansions + [ (do-template [ ] + [(do @ + [_ ( :x:)] + (wrap (` (: (~ (->Codec::encode (` ))) + (~' )))))] - [Unit poly;unit (function [_0] "[]")] - [Bool poly;bool (:: bool;Codec encode)] - [Nat poly;nat (:: number;Codec encode)] - [Int poly;int (:: number;Codec encode)] - [Deg poly;deg (:: number;Codec encode)] - [Real poly;real (:: number;Codec encode)] - [Char poly;char (:: char;Codec encode)] - [Text poly;text (:: text;Codec encode)])] + [Unit poly;unit (function [_0] "[]")] + [Bool poly;bool (:: bool;Codec encode)] + [Nat poly;nat (:: number;Codec encode)] + [Int poly;int (:: number;Codec encode)] + [Deg poly;deg (:: number;Codec encode)] + [Real poly;real (:: number;Codec encode)] + [Char poly;char (:: char;Codec encode)] + [Text poly;text (:: text;Codec encode)])] ($_ macro;either ## Primitives 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% [ (do-template [ ] - [(io;run (with-handler Handler - (doE Functor - [] - (lift ( "YOLO"))))) - (n.= (io;run (with-handler Handler - (doE Functor - [] - (lift )))))] + (with-expansions + [ (do-template [ ] + [(io;run (with-handler Handler + (doE Functor + [] + (lift ( "YOLO"))))) + (n.= (io;run (with-handler Handler + (doE Functor + [] + (lift )))))] - [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 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% [ (do-template [ ] - [(assert - (or (|> sample (i.= sample)) - (let [capped-sample (|> sample )] - (|> capped-sample (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 + [ (do-template [ ] + [(assert + (or (|> sample (i.= sample)) + (let [capped-sample (|> sample )] + (|> capped-sample (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 ))) 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% [ (do-template [ ] - [(assert (format "Can produce AST node: " ) - (and (T/= (&;to-text )) - (:: &;Eq = )))] + (with-expansions + [ (do-template [ ] + [(assert (format "Can produce AST node: " ) + (and (T/= (&;to-text )) + (:: &;Eq = )))] - [(&;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 ))) 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% [ (do-template [ ] - [(assert - (and (is? (list ( ))) - (found? (s;this? ( )) (list ( ))) - (enforced? (s;this! ( )) (list ( )))))] - - ["Can parse Bool syntax." true ast;bool bool;Eq s;bool] - ["Can parse Nat syntax." +123 ast;nat number;Eq s;nat] - ["Can parse Int syntax." 123 ast;int number;Eq s;int] - ["Can parse Deg syntax." .123 ast;deg number;Eq s;deg] - ["Can parse Real syntax." 123.0 ast;real number;Eq s;real] - ["Can parse Char syntax." #"\n" ast;char char;Eq s;char] - ["Can parse Text syntax." "\n" ast;text text;Eq s;text] - ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq s;symbol] - ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq s;tag] - )] + (with-expansions + [ (do-template [ ] + [(assert + (and (is? (list ( ))) + (found? (s;this? ( )) (list ( ))) + (enforced? (s;this! ( )) (list ( )))))] + + ["Can parse Bool syntax." true ast;bool bool;Eq s;bool] + ["Can parse Nat syntax." +123 ast;nat number;Eq s;nat] + ["Can parse Int syntax." 123 ast;int number;Eq s;int] + ["Can parse Deg syntax." .123 ast;deg number;Eq s;deg] + ["Can parse Real syntax." 123.0 ast;real number;Eq s;real] + ["Can parse Char syntax." #"\n" ast;char char;Eq s;char] + ["Can parse Text syntax." "\n" ast;text text;Eq s;text] + ["Can parse Symbol syntax." ["yolo" "lol"] ast;symbol ident;Eq s;symbol] + ["Can parse Tag syntax." ["yolo" "lol"] ast;tag ident;Eq s;tag] + )] ($_ seq @@ -98,27 +99,28 @@ ))) (test: "Complex value syntax." - (let% [ (do-template [ ] - [(assert (format "Can parse " " syntax.") - (and (match [true 123] - (s;run (list ( (list (ast;bool true) (ast;int 123)))) - ( (s;seq s;bool s;int)))) - (match true - (s;run (list ( (list (ast;bool true)))) - ( s;bool))) - (fails? (s;run (list ( (list (ast;bool true) (ast;int 123)))) - ( s;bool))) - (match (#;Left true) - (s;run (list ( (list (ast;bool true)))) - ( (s;alt s;bool s;int)))) - (match (#;Right 123) - (s;run (list ( (list (ast;int 123)))) - ( (s;alt s;bool s;int)))) - (fails? (s;run (list ( (list (ast;real 123.0)))) - ( (s;alt s;bool s;int))))))] - - ["form" s;form ast;form] - ["tuple" s;tuple ast;tuple])] + (with-expansions + [ (do-template [ ] + [(assert (format "Can parse " " syntax.") + (and (match [true 123] + (s;run (list ( (list (ast;bool true) (ast;int 123)))) + ( (s;seq s;bool s;int)))) + (match true + (s;run (list ( (list (ast;bool true)))) + ( s;bool))) + (fails? (s;run (list ( (list (ast;bool true) (ast;int 123)))) + ( s;bool))) + (match (#;Left true) + (s;run (list ( (list (ast;bool true)))) + ( (s;alt s;bool s;int)))) + (match (#;Right 123) + (s;run (list ( (list (ast;int 123)))) + ( (s;alt s;bool s;int)))) + (fails? (s;run (list ( (list (ast;real 123.0)))) + ( (s;alt s;bool s;int))))))] + + ["form" s;form ast;form] + ["tuple" s;tuple ast;tuple])] ($_ seq 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 (^open "L/") (list;Eq &;Eq)]] - (let% [ (do-template [ ] - [(assert (format "Can build and tear-down " " types.") - (let [flat (|> members )] - (or (L/= members flat) - (and (L/= (list) members) - (L/= (list ) flat)))))] - - ["variant" &;variant &;flatten-variant Void] - ["tuple" &;tuple &;flatten-tuple Unit] - )] + (with-expansions + [ (do-template [ ] + [(assert (format "Can build and tear-down " " types.") + (let [flat (|> members )] + (or (L/= members flat) + (and (L/= (list) members) + (L/= (list ) flat)))))] + + ["variant" &;variant &;flatten-variant Void] + ["tuple" &;tuple &;flatten-tuple Unit] + )] ($_ seq ))) @@ -141,15 +142,16 @@ _ true)))) #let [(^open "&/") &;Eq]] - (let% [ (do-template [ ] - [(assert (format "Can build and tear-down " " types.") - (let [[flat-size flat-body] (|> extra ( size) )] - (and (n.= size flat-size) - (&/= extra flat-body))))] - - ["universally-quantified" &;univq &;flatten-univq] - ["existentially-quantified" &;exq &;flatten-exq] - )] + (with-expansions + [ (do-template [ ] + [(assert (format "Can build and tear-down " " types.") + (let [[flat-size flat-body] (|> extra ( size) )] + (and (n.= size flat-size) + (&/= extra flat-body))))] + + ["universally-quantified" &;univq &;flatten-univq] + ["existentially-quantified" &;exq &;flatten-exq] + )] ($_ seq ))) -- cgit v1.2.3