diff options
22 files changed, 270 insertions, 282 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index 4561388c9..ce678837e 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -156,12 +156,11 @@ ## blurring the line between what was wanted (the separation) ## and what was analysed. [tailT tailC] - (do @ - [g!tail (macro.gensym "tail")] + (macro.with-gensyms [g!tail] (&.with-type tailT (analyse (` ("lux case" [(~+ tailC)] - (~@ g!tail) - (~@ g!tail)))))) + (~ g!tail) + (~ g!tail)))))) )))) (def: #export (analyse-product analyse membersC) diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux index 2236815ea..9cce16a49 100644 --- a/new-luxc/source/luxc/lang/translation/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/eval.jvm.lux @@ -25,7 +25,7 @@ (-> $.Inst (Meta Top)) (do macro.Monad<Meta> [current-module macro.current-module-name - [_ class-name] (macro.gensym (format current-module "/eval")) + class-name (:: @ map %code (macro.gensym (format current-module "/eval"))) #let [store-name (text.replace-all "/" "." class-name) bytecode ($d.class #$.V1_6 #$.Public $.noneC diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux index 91c5c5f95..336293dc4 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux @@ -84,24 +84,23 @@ (syntax: (arity: [name s.local-symbol] [arity s.nat]) (with-gensyms [g!proc g!name g!translate g!inputs] (do @ - [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input"))) - #let [g!input+ (list/map code.symbol g!input+)]] - (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~@ g!proc)) + [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] + (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) (-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst) (-> Text ..Proc)) - (function [(~@ g!name)] - (function [(~@ g!translate) (~@ g!inputs)] - (case (~@ g!inputs) + (function [(~ g!name)] + (function [(~ g!translate) (~ g!inputs)] + (case (~ g!inputs) (^ (list (~+ g!input+))) (do macro.Monad<Meta> [(~+ (|> g!input+ (list/map (function [g!input] - (list g!input (` ((~@ g!translate) (~ g!input)))))) + (list g!input (` ((~ g!translate) (~ g!input)))))) list.concat))] - ((~' wrap) ((~@ g!proc) [(~+ g!input+)]))) + ((~' wrap) ((~ g!proc) [(~+ g!input+)]))) (~' _) - (macro.fail (wrong-arity (~@ g!name) +1 (list.size (~@ g!inputs)))))))))))))) + (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs)))))))))))))) (arity: nullary +0) (arity: unary +1) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index e7dae30b1..d7b4164e2 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1933,9 +1933,6 @@ (untemplate-text subst) independent))))))) - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [ident #Nil])]))]] - (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) ident)))) - [true [_ (#Form (#Cons [[_ (#Symbol ["" "~'"])] (#Cons [keep-quoted #Nil])]))]] (untemplate false subst keep-quoted) @@ -2722,7 +2719,7 @@ (def:''' (gensym prefix state) #Nil - (-> Text ($' Meta Ident)) + (-> Text ($' Meta Code)) ("lux case" state {{#info info #source source #current-module _ #modules modules #scopes scopes #type-context types #host host @@ -2734,7 +2731,7 @@ #seed (n/+ +1 seed) #expected expected #cursor cursor #scope-type-vars scope-type-vars} - ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))])})) + (symbol$ ["" ($_ text/compose "__gensym__" prefix (nat/encode seed))]))})) (macro:' #export (Rec tokens) (list [(tag$ ["lux" "doc"]) @@ -3039,18 +3036,19 @@ _ #None)) (#Some g!name head tail body) - (let [g!blank ["" ""] + (let [g!blank (symbol$ ["" ""]) + g!name (symbol$ g!name) body+ (list/fold (: (-> Code Code Code) (function' [arg body'] (if (symbol? arg) - (` ("lux function" (~@ g!blank) (~ arg) (~ body'))) - (` ("lux function" (~@ g!blank) (~@ g!blank) - (case (~@ g!blank) (~ arg) (~ body'))))))) + (` ("lux function" (~ g!blank) (~ arg) (~ body'))) + (` ("lux function" (~ g!blank) (~ g!blank) + (case (~ g!blank) (~ arg) (~ body'))))))) body (list/reverse tail))] (return (list (if (symbol? head) - (` ("lux function" (~@ g!name) (~ head) (~ body+))) - (` ("lux function" (~@ g!name) (~@ g!blank) (case (~@ g!blank) (~ head) (~ body+)))))))) + (` ("lux function" (~ g!name) (~ head) (~ body+))) + (` ("lux function" (~ g!name) (~ g!blank) (case (~ g!blank) (~ head) (~ body+)))))))) #None (fail "Wrong syntax for function"))) @@ -4400,12 +4398,12 @@ (^ (list& [_ (#Form (list))] body branches)) (do Monad<Meta> [g!temp (gensym "temp")] - (wrap (list& (symbol$ g!temp) (` (..^open (~@ g!temp) "" (~ body))) branches))) + (wrap (list& g!temp (` (..^open (~ g!temp) "" (~ body))) branches))) (^ (list& [_ (#Form (list [_ (#Text prefix)]))] body branches)) (do Monad<Meta> [g!temp (gensym "temp")] - (wrap (list& (symbol$ g!temp) (` (..^open (~@ g!temp) (~ (text$ prefix)) (~ body))) branches))) + (wrap (list& g!temp (` (..^open (~ g!temp) (~ (text$ prefix)) (~ body))) branches))) (^ (list [_ (#Symbol name)] [_ (#Text prefix)] body)) (do Monad<Meta> @@ -4502,11 +4500,11 @@ (let [pattern (record$ (list/map (: (-> [Ident [Nat Type]] [Code Code]) (function [[[r-prefix r-name] [r-idx r-type]]] [(tag$ [r-prefix r-name]) - (symbol$ (if (n/= idx r-idx) - g!output - g!_))])) + (if (n/= idx r-idx) + g!output + g!_)])) (zip2 tags (enumerate members))))] - (return (list (` ("lux case" (~ record) {(~ pattern) (~@ g!output)}))))) + (return (list (` ("lux case" (~ record) {(~ pattern) (~ g!output)}))))) _ (fail "get@ can only use records."))) @@ -4521,7 +4519,7 @@ (^ (list selector)) (do Monad<Meta> [g!record (gensym "record")] - (wrap (list (` (function [(~@ g!record)] (..get@ (~ selector) (~@ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..get@ (~ selector) (~ g!record))))))) _ (fail "Wrong syntax for get@"))) @@ -4590,7 +4588,7 @@ (list/map int/encode <arg>))))"} (do Monad<Meta> [g!arg (gensym "arg")] - (return (list (` (function [(~@ g!arg)] (|> (~@ g!arg) (~+ tokens)))))))) + (return (list (` (function [(~ g!arg)] (|> (~ g!arg) (~+ tokens)))))))) (macro: #export (<<| tokens) {#.doc "## Similar to the piping macro, but rather than taking an initial object to work on, creates a function for taking it. @@ -4602,7 +4600,7 @@ (list/map int/encode <arg>))))"} (do Monad<Meta> [g!arg (gensym "arg")] - (return (list (` (function [(~@ g!arg)] (<| (~+ tokens) (~@ g!arg)))))))) + (return (list (` (function [(~ g!arg)] (<| (~+ tokens) (~ g!arg)))))))) (def: (imported-by? import-name module-name) (-> Text Text (Meta Bool)) @@ -4817,7 +4815,7 @@ (function [[r-slot-name [r-idx r-type]]] (do Monad<Meta> [g!slot (gensym "")] - (return [r-slot-name r-idx (symbol$ g!slot)])))) + (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) (function [[r-slot-name r-idx r-var]] @@ -4844,20 +4842,19 @@ _ (do Monad<Meta> [bindings (monad/map Monad<Meta> - (: (-> Code (Meta Ident)) + (: (-> Code (Meta Code)) (function [_] (gensym "temp"))) slots) #let [pairs (zip2 slots bindings) - update-expr (list/fold (: (-> [Code Ident] Code Code) + update-expr (list/fold (: (-> [Code Code] Code Code) (function [[s b] v] - (` (..set@ (~ s) (~ v) (~@ b))))) + (` (..set@ (~ s) (~ v) (~ b))))) value (list/reverse pairs)) - [_ accesses'] (list/fold (: (-> [Code Ident] [Code (List (List Code))] [Code (List (List Code))]) + [_ accesses'] (list/fold (: (-> [Code Code] [Code (List (List Code))] [Code (List (List Code))]) (function [[new-slot new-binding] [old-record accesses']] - (let [new-binding (symbol$ new-binding)] - [(` (get@ (~ new-slot) (~ new-binding))) - (#Cons (list new-binding old-record) accesses')]))) + [(` (get@ (~ new-slot) (~ new-binding))) + (#Cons (list new-binding old-record) accesses')])) [record (: (List (List Code)) #Nil)] pairs) accesses (list/join (list/reverse accesses'))]] @@ -4867,13 +4864,13 @@ (^ (list selector value)) (do Monad<Meta> [g!record (gensym "record")] - (wrap (list (` (function [(~@ g!record)] (..set@ (~ selector) (~ value) (~@ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..set@ (~ selector) (~ value) (~ g!record))))))) (^ (list selector)) (do Monad<Meta> [g!value (gensym "value") g!record (gensym "record")] - (wrap (list (` (function [(~@ g!value) (~@ g!record)] (..set@ (~ selector) (~@ g!value) (~@ g!record))))))) + (wrap (list (` (function [(~ g!value) (~ g!record)] (..set@ (~ selector) (~ g!value) (~ g!record))))))) _ (fail "Wrong syntax for set@"))) @@ -4906,7 +4903,7 @@ (function [[r-slot-name [r-idx r-type]]] (do Monad<Meta> [g!slot (gensym "")] - (return [r-slot-name r-idx (symbol$ g!slot)])))) + (return [r-slot-name r-idx g!slot])))) (zip2 tags (enumerate members)))] (let [pattern (record$ (list/map (: (-> [Ident Nat Code] [Code Code]) (function [[r-slot-name r-idx r-var]] @@ -4934,20 +4931,20 @@ (do Monad<Meta> [g!record (gensym "record") g!temp (gensym "temp")] - (wrap (list (` (let [(~@ g!record) (~ record) - (~@ g!temp) (get@ [(~+ slots)] (~@ g!record))] - (set@ [(~+ slots)] ((~ fun) (~@ g!temp)) (~@ g!record)))))))) + (wrap (list (` (let [(~ g!record) (~ record) + (~ g!temp) (get@ [(~+ slots)] (~ g!record))] + (set@ [(~+ slots)] ((~ fun) (~ g!temp)) (~ g!record)))))))) (^ (list selector fun)) (do Monad<Meta> [g!record (gensym "record")] - (wrap (list (` (function [(~@ g!record)] (..update@ (~ selector) (~ fun) (~@ g!record))))))) + (wrap (list (` (function [(~ g!record)] (..update@ (~ selector) (~ fun) (~ g!record))))))) (^ (list selector)) (do Monad<Meta> [g!fun (gensym "fun") g!record (gensym "record")] - (wrap (list (` (function [(~@ g!fun) (~@ g!record)] (..update@ (~ selector) (~@ g!fun) (~@ g!record))))))) + (wrap (list (` (function [(~ g!fun) (~ g!record)] (..update@ (~ selector) (~ g!fun) (~ g!record))))))) _ (fail "Wrong syntax for update@"))) @@ -5291,10 +5288,9 @@ (~+ inits)))))) (do Monad<Meta> [aliases (monad/map Monad<Meta> - (: (-> Code (Meta Ident)) + (: (-> Code (Meta Code)) (function [_] (gensym ""))) - inits) - #let [aliases (list/map symbol$ aliases)]] + inits)] (return (list (` (let [(~+ (interleave aliases inits))] (.loop [(~+ (interleave vars aliases))] (~ body))))))))) @@ -5335,7 +5331,7 @@ (let [tag (tag$ [module name])] (case (get name slot-pairings) (#Some binding) [tag binding] - #None [tag (symbol$ g!_)])))) + #None [tag g!_])))) tags))]] (return (list& pattern body branches))) @@ -5551,13 +5547,13 @@ (wrap [init extras'])))) (def: (multi-level-case$ g!_ [[init-pattern levels] body]) - (-> Ident [Multi-Level-Case Code] (List Code)) + (-> Code [Multi-Level-Case Code] (List Code)) (let [inner-pattern-body (list/fold (function [[calculation pattern] success] (` (case (~ calculation) (~ pattern) (~ success) - (~@ g!_) + (~ g!_) #.None))) (` (#.Some (~ body))) (: (List [Code Code]) (list/reverse levels)))] @@ -5588,18 +5584,18 @@ [mlc (multi-level-case^ levels) expected get-expected-type g!temp (gensym "temp")] - (let [output (list (symbol$ g!temp) + (let [output (list g!temp (` ("lux case" ("lux check" (#.Apply (~ (type-to-code expected)) Maybe) - (case (~@ g!temp) + (case (~ g!temp) (~+ (multi-level-case$ g!temp [mlc body])) - (~@ g!temp) + (~ g!temp) #.None)) - {(#Some (~@ g!temp)) - (~@ g!temp) + {(#Some (~ g!temp)) + (~ g!temp) #None - (case (~@ g!temp) + (case (~ g!temp) (~+ next-branches))})))] (wrap output))) @@ -5695,9 +5691,9 @@ (to-list set))))} (case tokens (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] pattern))] body branches)) - (let [g!whole ["" name]] - (return (list& (symbol$ g!whole) - (` (case (~@ g!whole) (~ pattern) (~ body))) + (let [g!whole (symbol$ ["" name])] + (return (list& g!whole + (` (case (~ g!whole) (~ pattern) (~ body))) branches))) _ @@ -5710,9 +5706,9 @@ (foo value)))} (case tokens (^ (list& [_meta (#Form (list [_ (#Symbol ["" name])] [_ (#Tuple steps)]))] body branches)) - (let [g!name ["" name]] - (return (list& (symbol$ g!name) - (` (let [(~@ g!name) (|> (~@ g!name) (~+ steps))] + (let [g!name (symbol$ ["" name])] + (return (list& g!name + (` (let [(~ g!name) (|> (~ g!name) (~+ steps))] (~ body))) branches))) @@ -5831,14 +5827,14 @@ [arg (` ((~' ~) (~ (symbol$ ["" arg]))))]) args)]] (wrap (list (` (macro: (~+ (export export?)) - ((~ (symbol$ ["" name])) (~@ g!tokens) (~@ g!compiler)) + ((~ (symbol$ ["" name])) (~ g!tokens) (~ g!compiler)) (~ anns) - (case (~@ g!tokens) + (case (~ g!tokens) (^ (list (~+ (list/map (|>> [""] symbol$) args)))) - (#.Right [(~@ g!compiler) + (#.Right [(~ g!compiler) (list (` (~ (replace-syntax rep-env input-template))))]) - (~@ g!_) + (~ g!_) (#.Left (~ (text$ (text/compose "Wrong syntax for " name)))) ))))) )) @@ -5923,7 +5919,7 @@ (^ [ann (#Form (list [_ (#Symbol ["" "~~"])] expansion))]) (do Monad<Meta> [g!expansion (gensym "g!expansion")] - (wrap [(list [(symbol$ g!expansion) expansion]) (symbol$ g!expansion)])) + (wrap [(list [g!expansion expansion]) g!expansion])) (^template [<tag>] [ann (<tag> parts)] @@ -5985,7 +5981,7 @@ [_ (<tag> value)] (do Monad<Meta> [g!meta (gensym "g!meta")] - (wrap (` [(~@ g!meta) (<tag> (~ (<gen> value)))])))) + (wrap (` [(~ g!meta) (<tag> (~ (<gen> value)))])))) ([#Bool "Bool" bool$] [#Nat "Nat" nat$] [#Int "Int" int$] @@ -6005,7 +6001,7 @@ (wrap (` [(~ =key) (~ =value)])))) fields) g!meta (gensym "g!meta")] - (wrap (` [(~@ g!meta) (#.Record (~ (untemplate-list =fields)))]))) + (wrap (` [(~ g!meta) (#.Record (~ (untemplate-list =fields)))]))) [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))] (return unquoted) @@ -6021,13 +6017,13 @@ (do Monad<Meta> [=inits (monad/map Monad<Meta> untemplate-pattern (list/reverse inits)) g!meta (gensym "g!meta")] - (wrap (` [(~@ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))]))) + (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list& spliced =inits)))]))) _ (do Monad<Meta> [=elems (monad/map Monad<Meta> untemplate-pattern elems) g!meta (gensym "g!meta")] - (wrap (` [(~@ g!meta) (<tag> (~ (untemplate-list =elems)))]))))) + (wrap (` [(~ g!meta) (<tag> (~ (untemplate-list =elems)))]))))) ([#Tuple] [#Form]) )) diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 0e283122d..5a3672a39 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -127,23 +127,23 @@ (#Parsed args) (with-gensyms [g!args g!_ g!output g!message] - (wrap (list (` ("lux program" (~@ g!args) + (wrap (list (` ("lux program" (~ g!args) (case ((: (..CLI (io.IO Unit)) ((~! do) (~! p.Monad<Parser>) [(~+ (|> args (list/map (function [[binding parser]] (list binding parser))) list/join)) - (~@ g!_) ..end] + (~ g!_) ..end] ((~' wrap) ((~! do) (~! io.Monad<IO>) [] (~ body))))) - (~@ g!args)) - (#E.Success [(~@ g!_) (~@ g!output)]) - (~@ g!output) + (~ g!args)) + (#E.Success [(~ g!_) (~ g!output)]) + (~ g!output) - (#E.Error (~@ g!message)) - (error! (~@ g!message)) + (#E.Error (~ g!message)) + (error! (~ g!message)) ))) ))) )) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 694234d17..b326d0028 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -262,10 +262,10 @@ (do P.Monad<Promise> [] (~ bodyC))))))})) - (` (def: (~+ (csw.export export)) ((~ g!new) (~@ g!init)) + (` (def: (~+ (csw.export export)) ((~ g!new) (~ g!init)) (All [(~+ g!vars)] (-> ((~ g!type) (~+ g!vars)) (io.IO ((~ g!actor) (~+ g!vars))))) - (..spawn (~ g!behavior) (~@ g!init)))))) + (..spawn (~ g!behavior) (~ g!init)))))) ))) (type: Signature @@ -342,27 +342,27 @@ (with-message actor-name) csw.annotations)) (All [(~+ g!all-vars)] (-> (~+ g!inputsT) (~ actorC) (T.Task (~ (get@ #output signature))))) - (let [(~@ g!task) (T.task (~ g!outputT))] + (let [(~ g!task) (T.task (~ g!outputT))] (io.run (do io.Monad<IO> - [(~@ g!sent?) (..send (function [(~ g!state) (~ g!self)] - (do P.Monad<Promise> - [(~@ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs)) - (~ g!outputT)]) - (do T.Monad<Task> - [] - (~ body)))] - (case (~@ g!return) - (#.Right [(~ g!state) (~@ g!return)]) - (exec (io.run (P.resolve (#.Right (~@ g!return)) (~@ g!task))) - (T.return (~ g!state))) - - (#.Left (~@ g!error)) - (exec (io.run (P.resolve (#.Left (~@ g!error)) (~@ g!task))) - (T.fail (~@ g!error)))) - )) - (~ g!self))] - (if (~@ g!sent?) - ((~' wrap) (~@ g!task)) + [(~ g!sent?) (..send (function [(~ g!state) (~ g!self)] + (do P.Monad<Promise> + [(~ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs)) + (~ g!outputT)]) + (do T.Monad<Task> + [] + (~ body)))] + (case (~ g!return) + (#.Right [(~ g!state) (~ g!return)]) + (exec (io.run (P.resolve (#.Right (~ g!return)) (~ g!task))) + (T.return (~ g!state))) + + (#.Left (~ g!error)) + (exec (io.run (P.resolve (#.Left (~ g!error)) (~ g!task))) + (T.fail (~ g!error)))) + )) + (~ g!self))] + (if (~ g!sent?) + ((~' wrap) (~ g!task)) ((~' wrap) (T.throw ..Dead "")))))))) )) ))) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index d4716709b..bfc51550b 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -80,9 +80,9 @@ [?bottomI ?bottomO] (with-gensyms [g!stack] (monad.do @ - [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default (code.symbol g!stack) ?bottomI)))) - outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default (code.symbol g!stack) ?bottomO))))] - (wrap (list (` (All [(~@ g!stack)] + [inputC (singleton (macro.expand-all (stack-fold (get@ #top inputs) (maybe.default g!stack ?bottomI)))) + outputC (singleton (macro.expand-all (stack-fold (get@ #top outputs) (maybe.default g!stack ?bottomO))))] + (wrap (list (` (All [(~ g!stack)] (-> (~ (de-alias inputC)) (~ (de-alias outputC)))))))))))) @@ -124,14 +124,13 @@ (syntax: #export (apply [arity (|> s.nat (p.filter (.n/> +0)))]) (with-gensyms [g!func g!stack g!output] (monad.do @ - [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @)) - #let [g!inputs (list/map code.symbol g!inputs)]] - (wrap (list (` (: (All [(~+ g!inputs) (~@ g!output)] - (-> (-> (~+ g!inputs) (~@ g!output)) - (=> [(~+ g!inputs)] [(~@ g!output)]))) - (function [(~@ g!func)] - (function [(~ (stack-fold g!inputs (code.symbol g!stack)))] - [(~@ g!stack) ((~@ g!func) (~+ g!inputs))]))))))))) + [g!inputs (|> (macro.gensym "input") (list.repeat arity) (monad.seq @))] + (wrap (list (` (: (All [(~+ g!inputs) (~ g!output)] + (-> (-> (~+ g!inputs) (~ g!output)) + (=> [(~+ g!inputs)] [(~ g!output)]))) + (function [(~ g!func)] + (function [(~ (stack-fold g!inputs g!stack))] + [(~ g!stack) ((~ g!func) (~+ g!inputs))]))))))))) ## [Primitives] (def: #export apply1 (apply +1)) diff --git a/stdlib/source/lux/control/cont.lux b/stdlib/source/lux/control/cont.lux index 1f50fe547..c3be37b73 100644 --- a/stdlib/source/lux/control/cont.lux +++ b/stdlib/source/lux/control/cont.lux @@ -59,7 +59,7 @@ {#.doc (doc "Turns any expression into a function that is pending a continuation." (pending (some-function some-input)))} (with-gensyms [g!k] - (wrap (list (` (.function [(~@ g!k)] ((~@ g!k) (~ expr)))))))) + (wrap (list (` (.function [(~ g!k)] ((~ g!k) (~ expr)))))))) (def: #export (portal init) (All [i o z] diff --git a/stdlib/source/lux/control/contract.lux b/stdlib/source/lux/control/contract.lux index 71d476517..72b4c0770 100644 --- a/stdlib/source/lux/control/contract.lux +++ b/stdlib/source/lux/control/contract.lux @@ -29,9 +29,8 @@ "Otherwise, an error is raised." (post i/even? (i/+ 2 2)))} - (do @ - [g!output (macro.gensym "")] - (wrap (list (` (let [(~@ g!output) (~ expr)] + (macro.with-gensyms [g!output] + (wrap (list (` (let [(~ g!output) (~ expr)] (exec (assert! (~ (code.text (format "Post-condition failed: " (%code test)))) - ((~ test) (~@ g!output))) - (~@ g!output)))))))) + ((~ test) (~ g!output))) + (~ g!output)))))))) diff --git a/stdlib/source/lux/control/pipe.lux b/stdlib/source/lux/control/pipe.lux index 09b41b530..a5ba038f5 100644 --- a/stdlib/source/lux/control/pipe.lux +++ b/stdlib/source/lux/control/pipe.lux @@ -45,17 +45,17 @@ [(new> -1)])))} (with-gensyms [g!temp] (wrap (list (` (with-expansions - [(~@ g!temp) (~ prev)] + [(~ g!temp) (~ prev)] (cond (~+ (do Monad<List> [[test then] branches] - (list (` (|> (~@ g!temp) (~+ test))) - (` (|> (~@ g!temp) (~+ then)))))) + (list (` (|> (~ g!temp) (~+ test))) + (` (|> (~ g!temp) (~+ then)))))) (~ (case ?else (#.Some else) - (` (|> (~@ g!temp) (~+ else))) + (` (|> (~ g!temp) (~+ else))) _ - (code.symbol g!temp)))))))))) + g!temp))))))))) (syntax: #export (loop> [test body^] [then body^] prev) {#.doc (doc "Loops for pipes." @@ -64,10 +64,10 @@ (loop> [(i/< 10)] [i/inc])))} (with-gensyms [g!temp] - (wrap (list (` (loop [(~@ g!temp) (~ prev)] - (if (|> (~@ g!temp) (~+ test)) - ((~' recur) (|> (~@ g!temp) (~+ then))) - (~@ g!temp)))))))) + (wrap (list (` (loop [(~ g!temp) (~ prev)] + (if (|> (~ g!temp) (~+ test)) + ((~' recur) (|> (~ g!temp) (~+ then))) + (~ g!temp)))))))) (syntax: #export (do> monad [steps (p.some body^)] prev) {#.doc (doc "Monadic pipes." @@ -82,11 +82,11 @@ (^ (list& last-step prev-steps)) (let [step-bindings (do Monad<List> [step (list.reverse prev-steps)] - (list (code.symbol g!temp) (` (|> (~@ g!temp) (~+ step)))))] + (list g!temp (` (|> (~ g!temp) (~+ step)))))] (wrap (list (` (do (~ monad) - [(~@ g!temp) (~ prev) + [(~ g!temp) (~ prev) (~+ step-bindings)] - (|> (~@ g!temp) (~+ last-step))))))) + (|> (~ g!temp) (~+ last-step))))))) _ (wrap (list prev))))) @@ -98,9 +98,9 @@ (exec> [int-to-nat %n log!]) (i/* 10)))} (with-gensyms [g!temp] - (wrap (list (` (let [(~@ g!temp) (~ prev)] - (exec (|> (~@ g!temp) (~+ body)) - (~@ g!temp)))))))) + (wrap (list (` (let [(~ g!temp) (~ prev)] + (exec (|> (~ g!temp) (~+ body)) + (~ g!temp)))))))) (syntax: #export (tuple> [paths (p.many body^)] prev) {#.doc (doc "Parallel branching for pipes." @@ -111,8 +111,8 @@ [Int/encode])) "Will become: [50 2 \"5\"]")} (with-gensyms [g!temp] - (wrap (list (` (let [(~@ g!temp) (~ prev)] - [(~+ (L/map (function [body] (` (|> (~@ g!temp) (~+ body)))) + (wrap (list (` (let [(~ g!temp) (~ prev)] + [(~+ (L/map (function [body] (` (|> (~ g!temp) (~+ body)))) paths))])))))) (syntax: #export (case> [branches (p.many (p.seq s.any s.any))] prev) diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux index d4ab696fd..4bce6dd6b 100644 --- a/stdlib/source/lux/data/coll/stream.lux +++ b/stdlib/source/lux/data/coll/stream.lux @@ -137,8 +137,8 @@ (func x y z)))} (with-gensyms [g!stream] (let [body+ (` (let [(~+ (List/join (List/map (function [pattern] - (list (` [(~ pattern) (~@ g!stream)]) - (` (cont.run (~@ g!stream))))) + (list (` [(~ pattern) (~ g!stream)]) + (` ((~! cont.run) (~ g!stream))))) patterns)))] (~ body)))] - (wrap (list& (code.symbol g!stream) body+ branches))))) + (wrap (list& g!stream body+ branches))))) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index eba490617..69f50b5f0 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -31,7 +31,7 @@ (syntax: #export (freeze expr) (with-gensyms [g!_] - (wrap (list (` ((~! freeze') (function [(~@ g!_)] (~ expr)))))))) + (wrap (list (` ((~! freeze') (function [(~ g!_)] (~ expr)))))))) (struct: #export _ (Functor Lazy) (def: (map f fa) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 8068a3366..1c56f1cb9 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -23,8 +23,8 @@ {#.doc (doc "Text interpolation." (format "Static part " (%t static) " does not match URI: " uri))} (macro.with-gensyms [g!compose] - (wrap (list (` (let [(~@ g!compose) (:: (~! text.Monoid<Text>) (~' compose))] - ($_ (~@ g!compose) (~+ fragments)))))))) + (wrap (list (` (let [(~ g!compose) (:: (~! text.Monoid<Text>) (~' compose))] + ($_ (~ g!compose) (~+ fragments)))))))) ## [Formatters] (type: #export (Formatter a) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 45f1f8f69..ab85158cf 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -357,14 +357,14 @@ [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ tail (p.some (p.after (l.this "|") sub^)) - #let [g!op ["" " alt "]]] + #let [g!op (code.symbol ["" " alt "])]] (if (list.empty? tail) (wrap head) (wrap [(list/fold n/max (product.left head) (list/map product.left tail)) - (` (let [(~@ g!op) (~ (if capturing? - (` (~! |||^)) - (` (~! |||_^))))] - ($_ (~@ g!op) + (` (let [(~ g!op) (~ (if capturing? + (` (~! |||^)) + (` (~! |||_^))))] + ($_ (~ g!op) (~ (prep-alternative head)) (~+ (list/map prep-alternative tail)))))])))) @@ -484,9 +484,8 @@ _ do-something-else))} (with-gensyms [g!temp] - (wrap (list& (` (^multi (~@ g!temp) - [((~! l.run) (~@ g!temp) (regex (~ (code.text pattern)))) - (#e.Success (~ (maybe.default (code.symbol g!temp) - bindings)))])) + (wrap (list& (` (^multi (~ g!temp) + [((~! l.run) (~ g!temp) (regex (~ (code.text pattern)))) + (#e.Success (~ (maybe.default g!temp bindings)))])) body branches)))) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 29937c041..dbbc26fb8 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1260,8 +1260,8 @@ )) (def: (complete-call$ g!obj [method args]) - (-> Ident Partial-Call Code) - (` ((~ method) (~ args) (~@ g!obj)))) + (-> Code Partial-Call Code) + (` ((~ method) (~ args) (~ g!obj)))) ## [Syntax] (def: object-super-class @@ -1402,10 +1402,10 @@ "=>" (#.Some "YOLO"))} (with-gensyms [g!temp] - (wrap (list (` (let [(~@ g!temp) (~ expr)] - (if ("jvm null?" (~@ g!temp)) + (wrap (list (` (let [(~ g!temp) (~ expr)] + (if ("jvm null?" (~ g!temp)) #.None - (#.Some (~@ g!temp))))))))) + (#.Some (~ g!temp))))))))) (syntax: #export (!!! expr) {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType." @@ -1418,8 +1418,8 @@ "YOLO")} (with-gensyms [g!value] (wrap (list (` ("lux case" (~ expr) - {(#.Some (~@ g!value)) - (~@ g!value) + {(#.Some (~ g!value)) + (~ g!value) #.None ("jvm null")})))))) @@ -1430,7 +1430,7 @@ "If it fails, you get (#.Left error+stack-traces-as-text)." (try (risky-computation input)))} (with-gensyms [g!_] - (wrap (list (`' ("lux try" (.function [(~@ g!_)] (~ expr)))))))) + (wrap (list (`' ("lux try" (.function [(~ g!_)] (~ expr)))))))) (syntax: #export (instance? [#let [imports (class-imports *compiler*)]] [class (generic-type^ imports (list))] @@ -1446,8 +1446,8 @@ (do @ [g!obj (macro.gensym "obj")] (wrap (list (` (: (-> (primitive "java.lang.Object") Bool) - (function [(~@ g!obj)] - ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~@ g!obj)))))))) + (function [(~ g!obj)] + ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj)))))))) )) (syntax: #export (synchronized lock body) @@ -1464,9 +1464,9 @@ (ClassName::method1 [arg0 arg1 arg2]) (ClassName::method2 [arg3 arg4 arg5])))} (with-gensyms [g!obj] - (wrap (list (` (let [(~@ g!obj) (~ obj)] + (wrap (list (` (let [(~ g!obj) (~ obj)] (exec (~+ (list/map (complete-call$ g!obj) methods)) - (~@ g!obj)))))))) + (~ g!obj)))))))) (def: (class-import$ long-name? [full-name params]) (-> Bool ClassDecl Code) @@ -1509,10 +1509,9 @@ (: (-> [Bool GenericType] (Meta [Code Code])) (function [[maybe? _]] (with-gensyms [arg-name] - (let [arg-name (code.symbol arg-name)] - (wrap [arg-name (if maybe? - (` (!!! (~ arg-name))) - arg-name)]))))) + (wrap [arg-name (if maybe? + (` (!!! (~ arg-name))) + arg-name)])))) import-member-args) #let [arg-classes (: (List Text) (list/map (|>> product.right (simple-class$ (list/compose type-params import-member-tvars))) @@ -1551,11 +1550,11 @@ [(` (Maybe (~ return-type))) (` (??? (~ return-term)))] [return-type - (let [g!temp ["" "Ω"]] - (` (let [(~@ g!temp) (~ return-term)] + (let [g!temp (code.symbol ["" " Ω "])] + (` (let [(~ g!temp) (~ return-term)] (if (not (null? (:! (primitive "java.lang.Object") - (~@ g!temp)))) - (~@ g!temp) + (~ g!temp)))) + (~ g!temp) (error! "Cannot produce null references from method calls.")))))]) _ @@ -1655,18 +1654,18 @@ _ output))) (def: (with-mode-field-set mode class g!input) - (-> Primitive-Mode GenericType Ident Code) + (-> Primitive-Mode GenericType Code Code) (case mode #ManualPrM - (code.symbol g!input) + g!input #AutoPrM (case (simple-class$ (list) class) - "byte" (` (l2b (~@ g!input))) - "short" (` (l2s (~@ g!input))) - "int" (` (l2i (~@ g!input))) - "float" (` (d2f (~@ g!input))) - _ (code.symbol g!input)))) + "byte" (` (l2b (~ g!input))) + "short" (` (l2s (~ g!input))) + "int" (` (l2i (~ g!input))) + "float" (` (d2f (~ g!input))) + _ g!input))) (def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix) (-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Meta (List Code))) @@ -1731,12 +1730,12 @@ (case kind #Class ["invokevirtual" - (list (code.symbol g!obj)) + (list g!obj) (list (class-decl-type$ class))] #Interface ["invokeinterface" - (list (code.symbol g!obj)) + (list g!obj) (list (class-decl-type$ class))] ))) def-params (#.Cons (code.tuple arg-function-inputs) obj-ast) @@ -1762,8 +1761,8 @@ base-gtype (class->type import-field-mode type-params import-field-type) classC (class-decl-type$ class) typeC (if import-field-maybe? - (` (Maybe (~ base-gtype))) - base-gtype) + (` (Maybe (~ base-gtype))) + base-gtype) tvar-asts (: (List Code) (|> class-tvars (list.filter free-type-param?) @@ -1773,7 +1772,7 @@ getter-interop (with-gensyms [g!obj] (let [getter-call (if import-field-static? getter-name - (` ((~ getter-name) (~@ g!obj)))) + (` ((~ getter-name) (~ g!obj)))) getter-type (if import-field-setter? (` (IO (~ typeC))) typeC) @@ -1785,7 +1784,7 @@ (with-mode-field-get import-field-mode import-field-type (` ((~ (code.text (format "jvm getstatic" ":" full-name ":" import-field-name)))))) (with-mode-field-get import-field-mode import-field-type - (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~@ g!obj))))) + (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj))))) getter-body (if import-field-maybe? (` (??? (~ getter-body))) getter-body) @@ -1798,8 +1797,8 @@ setter-interop (if import-field-setter? (with-gensyms [g!obj g!value] (let [setter-call (if import-field-static? - (` ((~ setter-name) (~@ g!value))) - (` ((~ setter-name) (~@ g!value) (~@ g!obj)))) + (` ((~ setter-name) (~ g!value))) + (` ((~ setter-name) (~ g!value) (~ g!obj)))) setter-type (if import-field-static? (` (All [(~+ tvar-asts)] (-> (~ typeC) (IO Unit)))) (` (All [(~+ tvar-asts)] (-> (~ typeC) (~ classC) (IO Unit))))) @@ -1981,8 +1980,8 @@ _ (with-gensyms [g!array] - (wrap (list (` (let [(~@ g!array) (~ array)] - (..array-read (~ idx) (~@ g!array))))))))) + (wrap (list (` (let [(~ g!array) (~ array)] + (..array-read (~ idx) (~ g!array))))))))) (syntax: #export (array-write idx value array) {#.doc (doc "Stores an element into an array." @@ -2010,8 +2009,8 @@ _ (with-gensyms [g!array] - (wrap (list (` (let [(~@ g!array) (~ array)] - (..array-write (~ idx) (~ value) (~@ g!array))))))))) + (wrap (list (` (let [(~ g!array) (~ array)] + (..array-write (~ idx) (~ value) (~ g!array))))))))) (def: simple-bindings^ (Syntax (List [Text Code])) @@ -2035,9 +2034,9 @@ bindings)] (wrap (list (` (do Monad<IO> [(~+ inits) - (~@ g!output) (~ body) - (~' #let) [(~@ g!_) (exec (~+ (list.reverse closes)) [])]] - ((~' wrap) (~@ g!output))))))))) + (~ g!output) (~ body) + (~' #let) [(~ g!_) (exec (~+ (list.reverse closes)) [])]] + ((~' wrap) (~ g!output))))))))) (syntax: #export (class-for [#let [imports (class-imports *compiler*)]] [type (generic-type^ imports (list))]) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 859bfe3e3..aa2429ae7 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -360,10 +360,10 @@ {#.doc "Generates a unique identifier as an Code node (ready to be used in code templates). A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} - (-> Text (Meta Ident)) + (-> Text (Meta Code)) (function [compiler] (#e.Success [(update@ #.seed n/inc compiler) - ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))]]))) + (code.symbol ["" ($_ text/compose "__gensym__" prefix (:: number.Codec<Text,Nat> encode (get@ #.seed compiler)))])]))) (def: (get-local-symbol ast) (-> Code (Meta Text)) @@ -378,11 +378,11 @@ {#.doc (doc "Creates new symbols and offers them to the body expression." (syntax: #export (synchronized lock body) (with-gensyms [g!lock g!body g!_] - (wrap (list (` (let [(~@ g!lock) (~ lock) - (~@ g!_) ("jvm monitorenter" (~ g!lock)) - (~@ g!body) (~ body) - (~@ g!_) ("jvm monitorexit" (~ g!lock))] - (~@ g!body))))) + (wrap (list (` (let [(~ g!lock) (~ lock) + (~ g!_) ("jvm monitorenter" (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) ("jvm monitorexit" (~ g!lock))] + (~ g!body))))) )))} (case tokens (^ (list [_ (#.Tuple symbols)] body)) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 118723709..a14e415b4 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -352,21 +352,21 @@ [name s.local-symbol] body) (with-gensyms [g!type g!output] - (let [g!name ["" name]] - (wrap (.list (` (syntax: (~+ (csw.export export)) ((~@ g!name) [(~@ g!type) s.symbol]) + (let [g!name (code.symbol ["" name])] + (wrap (.list (` (syntax: (~+ (csw.export export)) ((~ g!name) [(~ g!type) s.symbol]) (do macro.Monad<Meta> - [(~@ g!type) (macro.find-type-def (~@ g!type))] + [(~ g!type) (macro.find-type-def (~ g!type))] (case (|> (~ body) - (.function [(~@ g!name)]) + (.function [(~ g!name)]) p.rec (do p.Monad<Parser> []) - (..run (~@ g!type)) + (..run (~ g!type)) (: (.Either .Text .Code))) - (#.Left (~@ g!output)) - (macro.fail (~@ g!output)) + (#.Left (~ g!output)) + (macro.fail (~ g!output)) - (#.Right (~@ g!output)) - ((~' wrap) (.list (~@ g!output)))))))))))) + (#.Right (~ g!output)) + ((~' wrap) (.list (~ g!output)))))))))))) (def: (common-poly-name? poly-func) (-> Text Bool) diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 3455a6672..3cb1fac1a 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -304,5 +304,5 @@ (with-gensyms [g!inputs] (wrap (list (` (: (Codec //.JSON (~ inputT)) (struct (def: (~' encode) ((~! Codec<JSON,?>//encode) (~ inputT))) - (def: ((~' decode) (~@ g!inputs)) (//.run (~@ g!inputs) ((~! Codec<JSON,?>//decode) (~ inputT)))) + (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) ((~! Codec<JSON,?>//decode) (~ inputT)))) ))))))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 5cd68ccb9..e31b8c876 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -233,7 +233,7 @@ #.None))] (case ?parts (#.Some [name args meta body]) - (with-gensyms [g!text/join-with g!tokens g!body g!msg] + (with-gensyms [g!text/join-with g!tokens g!body g!error] (do macro.Monad<Meta> [vars+parsers (monad.map @ (: (-> Code (Meta [Code Code])) @@ -248,27 +248,27 @@ _ (macro.fail "Syntax pattern expects tuples or symbols.")))) args) - #let [g!state ["" "*compiler*"] + #let [g!state (code.symbol ["" "*compiler*"]) error-msg (code.text (text/compose "Wrong syntax for " name)) export-ast (: (List Code) (if exported? (list (' #export)) (list)))]] - (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~@ g!tokens) (~@ g!state)) + (wrap (list (` (macro: (~+ export-ast) ((~ (code.symbol ["" name])) (~ g!tokens) (~ g!state)) (~ meta) - ("lux case" (..run (~@ g!tokens) + ("lux case" (..run (~ g!tokens) (: (Syntax (Meta (List Code))) (do (~! p.Monad<Parser>) [(~+ (join-pairs vars+parsers))] ((~' wrap) (do (~! macro.Monad<Meta>) [] (~ body)))))) - {(#E.Success (~@ g!body)) - ((~@ g!body) (~@ g!state)) + {(#E.Success (~ g!body)) + ((~ g!body) (~ g!state)) - (#E.Error (~@ g!msg)) - (let [(~@ g!text/join-with) (~! text.join-with)] - (#E.Error ((~@ g!text/join-with) ": " (list (~ error-msg) (~@ g!msg)))))}))))))) + (#E.Error (~ g!error)) + (let [(~ g!text/join-with) (~! text.join-with)] + (#E.Error ((~ g!text/join-with) ": " (list (~ error-msg) (~ g!error)))))}))))))) _ (macro.fail "Wrong syntax for syntax:")))) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 57d5ae2f3..864dadfb0 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -183,15 +183,15 @@ (|> x (+ y) (- y) (= x))))))) )} (with-gensyms [g!context g!test g!error] - (wrap (list (` (def: #export (~@ g!context) + (wrap (list (` (def: #export (~ g!context) {#..test ((~! code.text) (~ description))} (IO Test) (io (case ("lux try" [(io (do (~! r.Monad<Random>) [] (~ test)))]) - (#.Right (~@ g!test)) - (~@ g!test) + (#.Right (~ g!test)) + (~ g!test) - (#.Left (~@ g!error)) - (..fail (~@ g!error)))))))))) + (#.Left (~ g!error)) + (..fail (~ g!error)))))))))) (def: (exported-tests module-name) (-> Text (Meta (List [Text Text Text]))) @@ -227,25 +227,25 @@ groups (list.split-all promise.concurrency-level tests+)]] (wrap (list (` (: (IO Unit) (io (exec (do Monad<Promise> - [(~' #let) [(~@ g!total-successes) +0 - (~@ g!total-failures) +0] + [(~' #let) [(~ g!total-successes) +0 + (~ g!total-failures) +0] (~+ (list/join (list/map (function [group] - (list (` [(~@ g!successes) (~@ g!failures)]) (` ((~! run') (list (~+ group)))) - (' #let) (` [(~@ g!total-successes) (n/+ (~@ g!successes) (~@ g!total-successes)) - (~@ g!total-failures) (n/+ (~@ g!failures) (~@ g!total-failures))]))) + (list (` [(~ g!successes) (~ g!failures)]) (` ((~! run') (list (~+ group)))) + (' #let) (` [(~ g!total-successes) (n/+ (~ g!successes) (~ g!total-successes)) + (~ g!total-failures) (n/+ (~ g!failures) (~ g!total-failures))]))) groups)))] - (exec (let [(~@ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))] - (log! ($_ (~@ g!text/compose) + (exec (let [(~ g!text/compose) (:: (~! text.Monoid<Text>) (~' compose))] + (log! ($_ (~ g!text/compose) "Test-suite finished." "\n" - ((~! %i) (nat-to-int (~@ g!total-successes))) + ((~! %i) (nat-to-int (~ g!total-successes))) " out of " - ((~! %i) (nat-to-int (n/+ (~@ g!total-failures) - (~@ g!total-successes)))) + ((~! %i) (nat-to-int (n/+ (~ g!total-failures) + (~ g!total-successes)))) " tests passed." "\n" - ((~! %i) (nat-to-int (~@ g!total-failures))) " tests failed."))) - (promise.future (if (n/> +0 (~@ g!total-failures)) + ((~! %i) (nat-to-int (~ g!total-failures))) " tests failed."))) + (promise.future (if (n/> +0 (~ g!total-failures)) (~! ..die) (~! ..exit))))) []))))))))) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 4d9fc797c..7fe8d02d9 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -355,9 +355,7 @@ (#.Right [args _]) (do @ - [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq @)) - #let [labels (list/map code.symbol labels) - retry (` (let [(~+ (|> (list.zip2 labels args) (list/map join-pair) list/join))] - (..::: (~ (code.symbol member)) (~+ labels))))]] - (wrap (list retry))) + [labels (|> (macro.gensym "") (list.repeat (list.size args)) (monad.seq @))] + (wrap (list (` (let [(~+ (|> (list.zip2 labels args) (list/map join-pair) list/join))] + (..::: (~ (code.symbol member)) (~+ labels))))))) )) diff --git a/stdlib/source/lux/type/object.lux b/stdlib/source/lux/type/object.lux index d46dd59d3..d7ebb1e8c 100644 --- a/stdlib/source/lux/type/object.lux +++ b/stdlib/source/lux/type/object.lux @@ -85,15 +85,15 @@ s.any))) (def: (declarationM g!self (^open)) - (-> Ident Method Code) + (-> Code Method Code) (let [g!type-vars (list/map code.local-symbol type-vars) g!method (code.local-symbol name)] (` (: (All [(~+ g!type-vars)] - (-> (~+ inputs) (~@ g!self) (~ output))) + (-> (~+ inputs) (~ g!self) (~ output))) (~ g!method))))) (def: (definition export [interface parameters] g!self-object g!ext g!states (^open)) - (-> Bool Declaration Code Ident (List Code) Method Code) + (-> Bool Declaration Code Code (List Code) Method Code) (let [g!method (code.local-symbol name) g!parameters (list/map code.local-symbol parameters) g!type-vars (list/map code.local-symbol type-vars) @@ -108,7 +108,7 @@ (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]) (maybe.default g!states (list.tail g!states)))] (` (def: (~+ (csw.export export)) ((~ g!method) (~+ g!_args) (~ g!_object)) - (All [(~+ g!parameters) (~@ g!ext) (~+ g!states) (~+ g!type-vars)] + (All [(~+ g!parameters) (~ g!ext) (~+ g!states) (~+ g!type-vars)] (-> (~+ inputs) (~ g!self-object) (~ output))) (let [(~ g!destructuring) (~ g!_object)] (:: (~ g!_behavior) (~ g!method) (~+ g!_args) (~ g!_object))))))) @@ -242,7 +242,7 @@ ) (def: (getterN export interface g!parameters g!ext g!child ancestors) - (-> Bool Text (List Code) Ident Ident (List Ident) + (-> Bool Text (List Code) Code Code (List Ident) Code) (let [g!get (code.local-symbol (getN interface)) g!interface (code.local-symbol interface) @@ -251,17 +251,17 @@ g!_state (' _state) g!_extension (' _extension) g!ancestors (ancestor-inputs ancestors) - g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) + g!object (` ((~ g!interface) (~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child))) g!tear-down (nest g!ancestors (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)]))] (` (def: (~+ (csw.export export)) ((~ g!get) (~ g!_object)) - (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)] - (-> (~ g!object) (~@ g!child))) + (All [(~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)] + (-> (~ g!object) (~ g!child))) (let [(~ g!tear-down) (~ g!_object)] (~ g!_state)))))) (def: (setterN export interface g!parameters g!ext g!child ancestors) - (-> Bool Text (List Code) Ident Ident (List Ident) + (-> Bool Text (List Code) Code Code (List Ident) Code) (let [g!set (code.local-symbol (setN interface)) g!interface (code.local-symbol interface) @@ -271,20 +271,20 @@ g!_extension (' _extension) g!_input (' _input) g!ancestors (ancestor-inputs ancestors) - g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) + g!object (` ((~ g!interface) (~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child))) g!tear-down (nest g!ancestors (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])) g!build-up (nest g!ancestors (` [(~ g!_behavior) (~ g!_input) (~ g!_extension)]))] (` (def: (~+ (csw.export export)) ((~ g!set) (~ g!_input) (~ g!_object)) - (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)] - (-> (~@ g!child) (~ g!object) (~ g!object))) + (All [(~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)] + (-> (~ g!child) (~ g!object) (~ g!object))) (let [(~ g!tear-down) (~ g!_object)] (~ g!build-up)))))) (def: (updaterN export interface g!parameters g!ext g!child ancestors) - (-> Bool Text (List Code) Ident Ident (List Ident) + (-> Bool Text (List Code) Code Code (List Ident) Code) (let [g!update (code.local-symbol (updateN interface)) g!interface (code.local-symbol interface) @@ -294,15 +294,15 @@ g!_extension (' _extension) g!_change (' _change) g!ancestors (ancestor-inputs ancestors) - g!object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) + g!object (` ((~ g!interface) (~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child))) g!tear-down (nest g!ancestors (` [(~ g!_behavior) (~ g!_state) (~ g!_extension)])) g!build-up (nest g!ancestors (` [(~ g!_behavior) ((~ g!_change) (~ g!_state)) (~ g!_extension)]))] (` (def: (~+ (csw.export export)) ((~ g!update) (~ g!_change) (~ g!_object)) - (All [(~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)] - (-> (-> (~@ g!child) (~@ g!child)) + (All [(~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)] + (-> (-> (~ g!child) (~ g!child)) (-> (~ g!object) (~ g!object)))) (let [(~ g!tear-down) (~ g!_object)] (~ g!build-up)))))) @@ -383,23 +383,23 @@ (list g!interface) (list)) g!interface-def (if (no-parent? parent) - (let [g!recur (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~@ g!child)))] - (` (Ex (~+ g!self-ref) [(~@ g!ext) (~@ g!child)] + (let [g!recur (` ((~ g!interface) (~+ g!parameters) (~ g!ext) (~ g!child)))] + (` (Ex (~+ g!self-ref) [(~ g!ext) (~ g!child)] [((~ g!signature) (~+ g!parameters) (~ g!recur)) - (~@ g!child) - (~@ g!ext)]))) + (~ g!child) + (~ g!ext)]))) (let [g!parent (code.symbol parent) g!ancestors (ancestor-inputs ancestors) - g!recur (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child)))] - (` (Ex (~+ g!self-ref) [(~@ g!ext) (~+ g!ancestors) (~@ g!child)] + g!recur (` ((~ g!interface) (~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child)))] + (` (Ex (~+ g!self-ref) [(~ g!ext) (~+ g!ancestors) (~ g!child)] ((~ g!parent) (~+ mappings) [((~ g!signature) (~+ g!parameters) (~ g!recur)) - (~@ g!child) - (~@ g!ext)] + (~ g!child) + (~ g!ext)] (~+ g!ancestors))))))]] (wrap (list& (` (sig: (~+ (csw.export export)) - ((~ g!signature) (~+ g!parameters) (~@ g!self-class)) - (~+ (let [de-alias (code.replace (code.local-symbol alias) (code.symbol g!self-class))] + ((~ g!signature) (~+ g!parameters) (~ g!self-class)) + (~+ (let [de-alias (code.replace (code.local-symbol alias) g!self-class)] (list/map (|>> (update@ #inputs (list/map de-alias)) (update@ #output de-alias) (declarationM g!self-class)) @@ -416,8 +416,8 @@ (updaterN export interface g!parameters g!ext g!child ancestors) (let [g!ancestors (ancestor-inputs ancestors) - g!states (list/compose g!ancestors (list (code.symbol g!child))) - g!self-object (` ((~ g!interface) (~+ g!parameters) (~@ g!ext) (~+ g!ancestors) (~@ g!child))) + g!states (list/compose g!ancestors (list g!child)) + g!self-object (` ((~ g!interface) (~+ g!parameters) (~ g!ext) (~+ g!ancestors) (~ g!child))) de-alias (code.replace (code.symbol ["" alias]) g!self-object)] (list/map (|>> (update@ #inputs (list/map de-alias)) (update@ #output de-alias) @@ -465,14 +465,14 @@ g!parent-structs (if (no-parent? parent) (list) (list/map (|>> (product.both id structN) code.symbol) (list& parent ancestors)))] - g!parent-inits (monad.map @ (function [_] (:: @ map code.symbol (macro.gensym "parent-init"))) + g!parent-inits (monad.map @ (function [_] (macro.gensym "parent-init")) g!parent-structs) #let [g!full-init (list/fold (function [[parent-struct parent-state] child] (` [(~ parent-struct) (~ parent-state) (~ child)])) - (` [(~ g!struct) (~@ g!init) []]) + (` [(~ g!struct) (~ g!init) []]) (list.zip2 g!parent-structs g!parent-inits)) g!new (code.local-symbol (newN instance)) - g!recur (` ((~ g!class) (~+ g!parameters) (~@ g!extension))) + g!recur (` ((~ g!class) (~+ g!parameters) (~ g!extension))) g!rec (if (list.empty? g!parameters) (list (' #rec)) (list))]] @@ -484,27 +484,27 @@ (~ (|> annotations (with-class interface parent [module instance]) csw.annotations)) - (Ex [(~@ g!extension)] + (Ex [(~ g!extension)] (~ (if (no-parent? parent) (` ((~ g!interface) (~+ interface-mappings) - (~@ g!extension) + (~ g!extension) ((~ g!state) (~+ g!parameters)))) (let [g!parent (code.symbol parent)] (` ((~ g!parent) (~+ parent-mappings) [((~ g!signature) (~+ interface-mappings) (~ g!recur)) ((~ g!state) (~+ g!parameters)) - (~@ g!extension)])))))))) + (~ g!extension)])))))))) (` (struct: (~+ (csw.export export)) (~ g!struct) - (All [(~+ g!parameters) (~@ g!extension)] + (All [(~+ g!parameters) (~ g!extension)] ((~ g!signature) (~+ interface-mappings) ((~ g!interface) (~+ interface-mappings) - (~@ g!extension) + (~ g!extension) (~+ g!inheritance) ((~ g!state) (~+ g!parameters))))) (~+ impls))) - (` (def: (~+ (csw.export export)) ((~ g!new) (~+ g!parent-inits) (~@ g!init)) + (` (def: (~+ (csw.export export)) ((~ g!new) (~+ g!parent-inits) (~ g!init)) (All [(~+ g!parameters)] (-> (~+ g!inheritance) ((~ g!state) (~+ g!parameters)) |