From f92c4dc2f813b40f14d240491daa665942165e7e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 2 Dec 2017 01:06:34 -0400 Subject: - Adjusted new-luxc to new macro-templating syntax. --- new-luxc/source/luxc/lang/analysis.lux | 2 +- new-luxc/source/luxc/lang/analysis/case.lux | 8 ++++---- .../source/luxc/lang/analysis/case/coverage.lux | 2 +- new-luxc/source/luxc/lang/analysis/expression.lux | 2 +- new-luxc/source/luxc/lang/analysis/function.lux | 2 +- new-luxc/source/luxc/lang/analysis/structure.lux | 12 +++++------ new-luxc/source/luxc/lang/synthesis/case.lux | 2 +- new-luxc/source/luxc/lang/synthesis/expression.lux | 20 +++++++++---------- new-luxc/source/luxc/lang/synthesis/loop.lux | 18 ++++++++--------- new-luxc/source/luxc/lang/translation.lux | 2 +- new-luxc/source/luxc/lang/translation/eval.jvm.lux | 2 +- .../luxc/lang/translation/expression.jvm.lux | 8 ++++---- .../luxc/lang/translation/procedure/common.jvm.lux | 23 +++++++++++----------- .../source/luxc/lang/translation/structure.jvm.lux | 2 +- 14 files changed, 53 insertions(+), 52 deletions(-) (limited to 'new-luxc/source') diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux index 107d4979e..e33f51927 100644 --- a/new-luxc/source/luxc/lang/analysis.lux +++ b/new-luxc/source/luxc/lang/analysis.lux @@ -75,7 +75,7 @@ (def: #export (procedure name args) (-> Text (List Analysis) Analysis) - (` ((~ (code.text name)) (~@ args)))) + (` ((~ (code.text name)) (~+ args)))) (def: #export (var idx) (-> Variable Analysis) diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux index 16f775907..c40bb2ac3 100644 --- a/new-luxc/source/luxc/lang/analysis/case.lux +++ b/new-luxc/source/luxc/lang/analysis/case.lux @@ -214,7 +214,7 @@ [nextA next] (wrap [(list) nextA])) (list.reverse matches))] - (wrap [(` ("lux case tuple" [(~@ memberP+)])) + (wrap [(` ("lux case tuple" [(~+ memberP+)])) thenA]))) _ @@ -250,12 +250,12 @@ (do macro.Monad [[testP nextA] (analyse-pattern #.None (type.variant (list.drop (n/dec num-cases) flat-sum)) - (` [(~@ values)]) + (` [(~+ values)]) next)] (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP))) nextA])) (do macro.Monad - [[testP nextA] (analyse-pattern #.None case-type (` [(~@ values)]) next)] + [[testP nextA] (analyse-pattern #.None case-type (` [(~+ values)]) next)] (wrap [(` ("lux case variant" (~ (code.nat idx)) (~ (code.nat num-cases)) (~ testP))) nextA]))) @@ -274,7 +274,7 @@ [idx group variantT] (macro.resolve-tag tag) _ (&.with-type-env (tc.check inputT variantT))] - (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~@ values))) next))) + (analyse-pattern (#.Some (list.size group)) inputT (` ((~ (code.nat idx)) (~+ values))) next))) _ (&.throw Unrecognized-Pattern-Syntax (%code pattern)) diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux index 5d34387b4..ae72b47e4 100644 --- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux +++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux @@ -71,7 +71,7 @@ ## Tuple patterns can be exhaustive if there is exhaustiveness for all of ## their sub-patterns. - (^code ("lux case tuple" [(~@ subs)])) + (^code ("lux case tuple" [(~+ subs)])) (loop [subs subs] (case subs #.Nil diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux index 0f3cdcf6e..1463e7ec5 100644 --- a/new-luxc/source/luxc/lang/analysis/expression.lux +++ b/new-luxc/source/luxc/lang/analysis/expression.lux @@ -74,7 +74,7 @@ ( analyse tag value) _ - ( analyse tag (` [(~@ values)])))) + ( analyse tag (` [(~+ values)])))) ([#.Nat structureA.analyse-sum] [#.Tag structureA.analyse-tagged-sum]) diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux index 758acd681..a502a9d19 100644 --- a/new-luxc/source/luxc/lang/analysis/function.lux +++ b/new-luxc/source/luxc/lang/analysis/function.lux @@ -74,7 +74,7 @@ (#.Function inputT outputT) (<| (:: @ map (function [[scope bodyA]] - (` ("lux function" [(~@ (list/map code.int (variableL.environment scope)))] + (` ("lux function" [(~+ (list/map code.int (variableL.environment scope)))] (~ bodyA))))) &.with-scope ## Functions have access not only to their argument, but diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index fb521d02e..4561388c9 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -159,9 +159,9 @@ (do @ [g!tail (macro.gensym "tail")] (&.with-type tailT - (analyse (` ("lux case" [(~@ tailC)] - (~ g!tail) - (~ g!tail)))))) + (analyse (` ("lux case" [(~+ tailC)] + (~@ g!tail) + (~@ g!tail)))))) )))) (def: #export (analyse-product analyse membersC) @@ -170,7 +170,7 @@ [expectedT macro.expected-type] (&.with-stacked-errors (function [_] (Cannot-Analyse-Tuple (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~@ membersC)]))))) + "Expression: " (%code (` [(~+ membersC)]))))) (case expectedT (#.Product _) (analyse-typed-product analyse membersC) @@ -219,7 +219,7 @@ _ (&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~@ membersC)])))))) + "Expression: " (%code (` [(~+ membersC)])))))) _ (case (type.apply (list inputT) funT) @@ -232,7 +232,7 @@ _ (&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~@ membersC)])))) + "Expression: " (%code (` [(~+ membersC)])))) )))) (def: #export (analyse-tagged-sum analyse tag valueC) diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux index ab4820b30..3e57de337 100644 --- a/new-luxc/source/luxc/lang/synthesis/case.lux +++ b/new-luxc/source/luxc/lang/synthesis/case.lux @@ -16,7 +16,7 @@ (def: (path' arity num-locals pattern) (-> ls.Arity Nat la.Pattern [Nat (List ls.Path)]) (case pattern - (^code ("lux case tuple" [(~@ membersP)])) + (^code ("lux case tuple" [(~+ membersP)])) (case membersP #.Nil [num-locals diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux index d3fbfcb58..b31a146a1 100644 --- a/new-luxc/source/luxc/lang/synthesis/expression.lux +++ b/new-luxc/source/luxc/lang/synthesis/expression.lux @@ -40,7 +40,7 @@ (def: (function$ arity environment body) (-> ls.Arity (List Variable) ls.Synthesis ls.Synthesis) (` ("lux function" (~ (code.nat arity)) - [(~@ (list/map code.int environment))] + [(~+ (list/map code.int environment))] (~ body)))) (def: (variant$ tag last? valueS) @@ -53,11 +53,11 @@ (def: (procedure$ name argsS) (-> Text (List ls.Synthesis) ls.Synthesis) - (` ((~ (code.text name)) (~@ argsS)))) + (` ((~ (code.text name)) (~+ argsS)))) (def: (call$ funcS argsS) (-> ls.Synthesis (List ls.Synthesis) ls.Synthesis) - (` ("lux call" (~ funcS) (~@ argsS)))) + (` ("lux call" (~ funcS) (~+ argsS)))) (def: (synthesize-case arity num-locals synthesize inputA branchesA) (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis) @@ -100,14 +100,14 @@ funcS (synthesize funcA) argsS (list/map synthesize argsA)] (case funcS - (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~@ _env)] (~ _bodyS))) + (^multi (^code ("lux function" (~ [_ (#.Nat _arity)]) [(~+ _env)] (~ _bodyS))) (and (n/= _arity (list.size argsS)) (not (loopS.contains-self-reference? _bodyS))) [(s.run _env (p.some s.int)) (#e.Success _env)]) - (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~@ argsS)] + (` ("lux loop" (~ (code.nat (n/inc num-locals))) [(~+ argsS)] (~ (loopS.adjust _env num-locals _bodyS)))) - (^code ("lux call" (~ funcS') (~@ argsS'))) + (^code ("lux call" (~ funcS') (~+ argsS'))) (call$ funcS' (list/compose argsS' argsS)) _ @@ -122,7 +122,7 @@ expressionA expressionA] (case expressionA (^code [(~ _left) (~ _right)]) - (` [(~@ (list/map (recur arity resolver false num-locals) + (` [(~+ (list/map (recur arity resolver false num-locals) (la.unfold-tuple expressionA)))]) (^or (^code ("lux sum left" (~ _))) @@ -143,7 +143,7 @@ (^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)]))) (synthesize-case arity num-locals (recur arity resolver false) inputA branchesA) - (^multi (^code ("lux function" [(~@ scope)] (~ bodyA))) + (^multi (^code ("lux function" [(~+ scope)] (~ bodyA))) [(s.run scope (p.some s.int)) (#e.Success raw-env)]) (let [function-arity (if direct? (n/inc arity) @@ -186,10 +186,10 @@ bodyS (function$ +1 env (prepare-body function-arity +1 bodyS)))) - (^code ("lux apply" (~@ _))) + (^code ("lux apply" (~+ _))) (synthesize-apply (recur arity resolver false num-locals) num-locals expressionA) - (^code ((~ [_ (#.Text name)]) (~@ args))) + (^code ((~ [_ (#.Text name)]) (~+ args))) (procedure$ name (list/map (recur arity resolver false num-locals) args)) _ diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux index 0510e2377..762032a59 100644 --- a/new-luxc/source/luxc/lang/synthesis/loop.lux +++ b/new-luxc/source/luxc/lang/synthesis/loop.lux @@ -96,7 +96,7 @@ [_ (#.Form (list [_ (#.Int 0)]))] argsS))]) (n/= arity (list.size argsS))) - (` ("lux recur" (~@ argsS))) + (` ("lux recur" (~+ argsS))) (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))]) (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS)))) @@ -119,8 +119,8 @@ (^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS))) (` ((~ (code.nat tag)) (~ last?) (~ (recur valueS)))) - (^code [(~@ members)]) - (` [(~@ (list/map recur members))]) + (^code [(~+ members)]) + (` [(~+ (list/map recur members))]) (^code ("lux case" (~ inputS) (~ pathS))) (` ("lux case" (~ (recur inputS)) @@ -142,9 +142,9 @@ _ pathS)))))) - (^code ("lux function" (~ arity) [(~@ environment)] (~ bodyS))) + (^code ("lux function" (~ arity) [(~+ environment)] (~ bodyS))) (` ("lux function" (~ arity) - [(~@ (list/map (function [_var] + [(~+ (list/map (function [_var] (case _var (^ [_ (#.Form (list [_ (#.Int var)]))]) (` ((~ (code.int (resolve-captured var))))) @@ -155,10 +155,10 @@ (~ bodyS))) (^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))]) - (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS)))) + (` ("lux call" (~ (recur funcS)) (~+ (list/map recur argsS)))) (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))]) - (` ("lux recur" (~@ (list/map recur argsS)))) + (` ("lux recur" (~+ (list/map recur argsS)))) (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS))) (` ("lux let" (~ (code.nat (n/+ offset register))) @@ -172,7 +172,7 @@ (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat loop-offset)] [_ (#.Tuple initsS)] bodyS))]) (` ("lux loop" (~ (code.nat (n/+ offset loop-offset))) - [(~@ (list/map recur initsS))] + [(~+ (list/map recur initsS))] (~ (recur bodyS)))) (^ [_ (#.Form (list [_ (#.Int var)]))]) @@ -181,7 +181,7 @@ (` ((~ (code.int (|> offset nat-to-int (i/+ var))))))) (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))]) - (` ((~ (code.text procedure)) (~@ (list/map recur argsS)))) + (` ((~ (code.text procedure)) (~+ (list/map recur argsS)))) _ exprS diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux index 07f1fe533..71bef93a2 100644 --- a/new-luxc/source/luxc/lang/translation.lux +++ b/new-luxc/source/luxc/lang/translation.lux @@ -72,7 +72,7 @@ (def: #export (translate translate-module aliases code) (-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases)) (case code - (^code ((~ [_ (#.Symbol macro-name)]) (~@ args))) + (^code ((~ [_ (#.Symbol macro-name)]) (~+ args))) (do macro.Monad [?macro (&.with-error-tracking (macro.find-macro macro-name))] diff --git a/new-luxc/source/luxc/lang/translation/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/eval.jvm.lux index 9cce16a49..2236815ea 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 [current-module macro.current-module-name - class-name (:: @ map %code (macro.gensym (format current-module "/eval"))) + [_ class-name] (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/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/expression.jvm.lux index c75ef0a19..4496de784 100644 --- a/new-luxc/source/luxc/lang/translation/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/expression.jvm.lux @@ -44,7 +44,7 @@ (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS))) (structureT.translate-variant translate tag last? valueS) - (^code [(~@ members)]) + (^code [(~+ members)]) (structureT.translate-tuple translate members) (^ [_ (#.Form (list [_ (#.Int var)]))]) @@ -61,14 +61,14 @@ (^code ("lux case" (~ inputS) (~ pathPS))) (caseT.translate-case translate inputS pathPS) - (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~@ environment)] (~ bodyS))) + (^multi (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS))) [(s.run environment (p.some s.int)) (#e.Success environment)]) (functionT.translate-function translate environment arity bodyS) - (^code ("lux call" (~ functionS) (~@ argsS))) + (^code ("lux call" (~ functionS) (~+ argsS))) (functionT.translate-call translate functionS argsS) - (^code ((~ [_ (#.Text procedure)]) (~@ argsS))) + (^code ((~ [_ (#.Text procedure)]) (~+ argsS))) (procedureT.translate-procedure translate procedure argsS) _ 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 41d9b91ab..91c5c5f95 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux @@ -47,7 +47,7 @@ (Dict Text Proc)) (syntax: (Vector [size s.nat] elemT) - (wrap (list (` [(~@ (list.repeat size elemT))])))) + (wrap (list (` [(~+ (list.repeat size elemT))])))) (type: #export Nullary (-> (Vector +0 $.Inst) $.Inst)) (type: #export Unary (-> (Vector +1 $.Inst) $.Inst)) @@ -84,23 +84,24 @@ (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")))] - (wrap (list (` (def: #export ((~ (code.local-symbol name)) (~ g!proc)) + [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)) (-> (-> (..Vector (~ (code.nat arity)) $.Inst) $.Inst) (-> Text ..Proc)) - (function [(~ g!name)] - (function [(~ g!translate) (~ g!inputs)] - (case (~ g!inputs) - (^ (list (~@ g!input+))) + (function [(~@ g!name)] + (function [(~@ g!translate) (~@ g!inputs)] + (case (~@ g!inputs) + (^ (list (~+ g!input+))) (do macro.Monad - [(~@ (|> g!input+ + [(~+ (|> 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/new-luxc/source/luxc/lang/translation/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/structure.jvm.lux index 9a78be78e..f7cdb524f 100644 --- a/new-luxc/source/luxc/lang/translation/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/structure.jvm.lux @@ -24,7 +24,7 @@ (-> (-> ls.Synthesis (Meta $.Inst)) (List ls.Synthesis) (Meta $.Inst)) (do macro.Monad [#let [size (list.size members)] - _ (&.assert Not-A-Tuple (%code (` [(~@ members)])) + _ (&.assert Not-A-Tuple (%code (` [(~+ members)])) (n/>= +2 size)) membersI (|> members list.enumerate -- cgit v1.3.1 From 46955edbe6cea9f367562b9fb17cef526109d9e0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 2 Dec 2017 01:10:12 -0400 Subject: - Added new "lux in-module" procedure for changing the module while analysing an expression. --- luxc/src/lux/analyser.clj | 7 ++++++ luxc/src/lux/base.clj | 10 ++++++++ .../source/luxc/lang/analysis/procedure/common.lux | 28 ++++++++++++++++++---- stdlib/source/lux.lux | 20 ++++++++++------ 4 files changed, 53 insertions(+), 12 deletions(-) (limited to 'new-luxc/source') diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj index 13bf3bc61..6e765cb9b 100644 --- a/luxc/src/lux/analyser.clj +++ b/luxc/src/lux/analyser.clj @@ -162,6 +162,13 @@ (&/with-cursor cursor (&&lux/analyse-module analyse optimize eval! compile-module ?meta))) + "lux in-module" + (|let [(&/$Cons [_ (&/$Text ?module)] + (&/$Cons ?expr (&/$Nil))) parameters] + (&/with-cursor cursor + (&/with-module ?module + (analyse exo-type ?expr)))) + ;; else (&/with-analysis-meta cursor exo-type (cond (.startsWith ^String ?procedure "jvm") diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index ae9b2bb47..ee4bcde10 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -1437,6 +1437,16 @@ ($Left msg) ($Left msg)))) +(defn with-module [name body] + (fn [state] + (|case (body (set$ $current-module ($Some name) state)) + ($Right [state* output]) + ($Right (T [(set$ $current-module (get$ $current-module state) state*) + output])) + + ($Left msg) + ($Left msg)))) + (defn |eitherL [left right] (fn [compiler] (|case (run-state left compiler) diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux index b003edfa7..ecdcd0bfd 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux @@ -20,6 +20,7 @@ [".A" type])))) (exception: #export Incorrect-Procedure-Arity) +(exception: #export Invalid-Syntax) ## [Utils] (type: #export Proc @@ -80,7 +81,7 @@ ## [Analysers] ## "lux is" represents reference/pointer equality. -(def: (lux-is proc) +(def: (lux//is proc) (-> Text Proc) (function [analyse eval args] (do macro.Monad @@ -90,7 +91,7 @@ ## "lux try" provides a simple way to interact with the host platform's ## error-handling facilities. -(def: (lux-try proc) +(def: (lux//try proc) (-> Text Proc) (function [analyse eval args] (case args @@ -127,6 +128,22 @@ _ (&.throw Incorrect-Procedure-Arity (wrong-arity proc +2 (list.size args)))))) +(def: (lux//in-module proc) + (-> Text Proc) + (function [analyse eval argsC+] + (case argsC+ + (^ (list [_ (#.Text module-name)] exprC)) + (&.with-current-module module-name + (analyse exprC)) + + _ + (&.throw Invalid-Syntax (format "Procedure: " proc "\n" + " Inputs:" (|> argsC+ + list.enumerate + (list/map (function [[idx argC]] + (format "\n " (%n idx) " " (%code argC)))) + (text.join-with "")) "\n"))))) + (do-template [ ] [(def: ( proc) (-> Text Proc) @@ -158,13 +175,14 @@ (def: lux-procs Bundle (|> (dict.new text.Hash) - (install "is" lux-is) - (install "try" lux-try) + (install "is" lux//is) + (install "try" lux//try) (install "function" lux//function) (install "case" lux//case) (install "check" lux//check) (install "coerce" lux//coerce) - (install "check type" lux//check//type))) + (install "check type" lux//check//type) + (install "in-module" lux//in-module))) (def: io-procs Bundle diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index e7326f34b..22fc75e92 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1842,9 +1842,9 @@ #None (#Left ($_ text/compose "Unknown module: " module " @ " (ident/encode ident)))}))) -(def:''' (splice replace? untemplate elems) +(def:''' (splice replace? untemplate subst elems) #Nil - (-> Bool (-> Code ($' Meta Code)) ($' List Code) ($' Meta Code)) + (-> Bool (-> Code ($' Meta Code)) Text ($' List Code) ($' Meta Code)) ("lux case" replace? {true ("lux case" (list/reverse elems) @@ -1855,7 +1855,9 @@ (do Monad [lastO ("lux case" lastI {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] - (wrap spliced) + (wrap (if (text/= "" subst) + spliced + (form$ (list (text$ "lux in-module") (text$ subst) spliced)))) _ (do Monad @@ -1866,7 +1868,9 @@ ("lux case" leftI {[_ (#Form (#Cons [[_ (#Symbol ["" "~+"])] (#Cons [spliced #Nil])]))] (wrap (form$ (list (symbol$ ["lux" "splice-helper"]) - spliced + (if (text/= "" subst) + spliced + (form$ (list (text$ "lux in-module") (text$ subst) spliced))) rightO))) _ @@ -1931,7 +1935,9 @@ (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) (tuple$ (list (text$ module) (text$ name))))))) [true [_ (#Form (#Cons [[_ (#Symbol ["" "~"])] (#Cons [unquoted #Nil])]))]] - (return unquoted) + (return (if (text/= "" subst) + unquoted + (form$ (list (text$ "lux in-module") (text$ subst) unquoted)))) [true [_ (#Form (#Cons [[_ (#Symbol ["" "~@"])] (#Cons [ident #Nil])]))]] (return (wrap-meta (form$ (list (tag$ ["lux" "Symbol"]) ident)))) @@ -1941,13 +1947,13 @@ [_ [meta (#Form elems)]] (do Monad - [output (splice replace? (untemplate replace? subst) elems) + [output (splice replace? (untemplate replace? subst) subst elems) #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Form"]) output)))]] (wrap [meta output'])) [_ [meta (#Tuple elems)]] (do Monad - [output (splice replace? (untemplate replace? subst) elems) + [output (splice replace? (untemplate replace? subst) subst elems) #let [[_ output'] (wrap-meta (form$ (list (tag$ ["lux" "Tuple"]) output)))]] (wrap [meta output'])) -- cgit v1.3.1 From 5c4a26c9344898c4fa958946b47b55e1c84818bd Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 2 Dec 2017 13:55:48 -0400 Subject: - "gensym" went back to producing Code, instead of Ident. --- new-luxc/source/luxc/lang/analysis/structure.lux | 7 +- new-luxc/source/luxc/lang/translation/eval.jvm.lux | 2 +- .../luxc/lang/translation/procedure/common.jvm.lux | 17 ++- stdlib/source/lux.lux | 122 ++++++++++----------- stdlib/source/lux/cli.lux | 14 +-- stdlib/source/lux/concurrency/actor.lux | 44 ++++---- stdlib/source/lux/control/concatenative.lux | 21 ++-- stdlib/source/lux/control/cont.lux | 2 +- stdlib/source/lux/control/contract.lux | 9 +- stdlib/source/lux/control/pipe.lux | 34 +++--- stdlib/source/lux/data/coll/stream.lux | 6 +- stdlib/source/lux/data/lazy.lux | 2 +- stdlib/source/lux/data/text/format.lux | 4 +- stdlib/source/lux/data/text/regex.lux | 17 ++- stdlib/source/lux/host.jvm.lux | 83 +++++++------- stdlib/source/lux/macro.lux | 14 +-- stdlib/source/lux/macro/poly.lux | 18 +-- stdlib/source/lux/macro/poly/json.lux | 2 +- stdlib/source/lux/macro/syntax.lux | 18 +-- stdlib/source/lux/test.lux | 34 +++--- stdlib/source/lux/type/implicit.lux | 8 +- stdlib/source/lux/type/object.lux | 74 ++++++------- 22 files changed, 270 insertions(+), 282 deletions(-) (limited to 'new-luxc/source') 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 [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 [(~+ (|> 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 [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 [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 @@ -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 [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 ))))"} (do Monad [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 ))))"} (do Monad [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 [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 [bindings (monad/map Monad - (: (-> 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 [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 [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 [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 [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 [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 [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 [aliases (monad/map Monad - (: (-> 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 [g!expansion (gensym "g!expansion")] - (wrap [(list [(symbol$ g!expansion) expansion]) (symbol$ g!expansion)])) + (wrap [(list [g!expansion expansion]) g!expansion])) (^template [] [ann ( parts)] @@ -5985,7 +5981,7 @@ [_ ( value)] (do Monad [g!meta (gensym "g!meta")] - (wrap (` [(~@ g!meta) ( (~ ( value)))])))) + (wrap (` [(~ g!meta) ( (~ ( 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 [=inits (monad/map Monad untemplate-pattern (list/reverse inits)) g!meta (gensym "g!meta")] - (wrap (` [(~@ g!meta) ( (~ (untemplate-list& spliced =inits)))]))) + (wrap (` [(~ g!meta) ( (~ (untemplate-list& spliced =inits)))]))) _ (do Monad [=elems (monad/map Monad untemplate-pattern elems) g!meta (gensym "g!meta")] - (wrap (` [(~@ g!meta) ( (~ (untemplate-list =elems)))]))))) + (wrap (` [(~ g!meta) ( (~ (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) [(~+ (|> args (list/map (function [[binding parser]] (list binding parser))) list/join)) - (~@ g!_) ..end] + (~ g!_) ..end] ((~' wrap) ((~! do) (~! io.Monad) [] (~ 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 [] (~ 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 - [(~@ g!sent?) (..send (function [(~ g!state) (~ g!self)] - (do P.Monad - [(~@ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs)) - (~ g!outputT)]) - (do T.Monad - [] - (~ 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 + [(~ g!return) (: (T.Task [((~ g!type) (~+ g!actor-refs)) + (~ g!outputT)]) + (do T.Monad + [] + (~ 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 [[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 [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) (~' compose))] - ($_ (~@ g!compose) (~+ fragments)))))))) + (wrap (list (` (let [(~ g!compose) (:: (~! text.Monoid) (~' 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 [(~+ 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 encode (get@ #.seed compiler)))]]))) + (code.symbol ["" ($_ text/compose "__gensym__" prefix (:: number.Codec 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 - [(~@ 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 []) - (..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//encode) (~ inputT))) - (def: ((~' decode) (~@ g!inputs)) (//.run (~@ g!inputs) ((~! Codec//decode) (~ inputT)))) + (def: ((~' decode) (~ g!inputs)) (//.run (~ g!inputs) ((~! Codec//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 [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) [(~+ (join-pairs vars+parsers))] ((~' wrap) (do (~! macro.Monad) [] (~ 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) [] (~ 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 - [(~' #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) (~' compose))] - (log! ($_ (~@ g!text/compose) + (exec (let [(~ g!text/compose) (:: (~! text.Monoid) (~' 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)) -- cgit v1.3.1