diff options
Diffstat (limited to 'new-luxc')
17 files changed, 74 insertions, 57 deletions
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<Meta> [[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<Meta> - [[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 @@ (<analyser> analyse tag value) _ - (<analyser> analyse tag (` [(~@ values)])))) + (<analyser> 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/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<Meta> @@ -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 [<name> <analyser>] [(def: (<name> proc) (-> Text Proc) @@ -158,13 +175,14 @@ (def: lux-procs Bundle (|> (dict.new text.Hash<Text>) - (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/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index fb521d02e..ce678837e 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -156,10 +156,9 @@ ## 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)] + (analyse (` ("lux case" [(~+ tailC)] (~ g!tail) (~ g!tail)))))) )))) @@ -170,7 +169,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 +218,7 @@ _ (&.throw Invalid-Tuple-Type (format " Type: " (%type expectedT) "\n" - "Expression: " (%code (` [(~@ membersC)])))))) + "Expression: " (%code (` [(~+ membersC)])))))) _ (case (type.apply (list inputT) funT) @@ -232,7 +231,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<Meta> [?macro (&.with-error-tracking (macro.find-macro macro-name))] 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..336293dc4 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)) @@ -91,13 +91,13 @@ (function [(~ g!name)] (function [(~ g!translate) (~ g!inputs)] (case (~ g!inputs) - (^ (list (~@ g!input+))) + (^ (list (~+ g!input+))) (do macro.Monad<Meta> - [(~@ (|> g!input+ + [(~+ (|> g!input+ (list/map (function [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)))))))))))))) 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<Meta> [#let [size (list.size members)] - _ (&.assert Not-A-Tuple (%code (` [(~@ members)])) + _ (&.assert Not-A-Tuple (%code (` [(~+ members)])) (n/>= +2 size)) membersI (|> members list.enumerate diff --git a/new-luxc/test/test/luxc/lang/synthesis/function.lux b/new-luxc/test/test/luxc/lang/synthesis/function.lux index eaae351f0..52a9d78db 100644 --- a/new-luxc/test/test/luxc/lang/synthesis/function.lux +++ b/new-luxc/test/test/luxc/lang/synthesis/function.lux @@ -66,7 +66,7 @@ [total-args prediction bodyA] (recur (n/inc num-args) (list/map (function [pick] (maybe.assume (list.nth pick global-env))) picks))] - (wrap [total-args prediction (` ("lux function" [(~@ (list/map (|>> variableL.captured code.int) picks))] + (wrap [total-args prediction (` ("lux function" [(~+ (list/map (|>> variableL.captured code.int) picks))] (~ bodyA)))])) (do @ [chosen (pick (list.size global-env))] @@ -74,7 +74,7 @@ (maybe.assume (dict.get chosen resolver)) (la.var (variableL.captured chosen))])))))))] (wrap [total-args prediction (` ("lux function" - [(~@ (list/map code.int absolute-env))] + [(~+ (list/map code.int absolute-env))] (~ bodyA)))]) )) diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux index 9921a2797..3bc4664e8 100644 --- a/new-luxc/test/test/luxc/lang/translation/case.lux +++ b/new-luxc/test/test/luxc/lang/translation/case.lux @@ -44,7 +44,7 @@ [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) idx (|> r.nat (:: @ map (n/% size))) [subS subP] gen-case - #let [caseS (` [(~@ (list.concat (list (list.repeat idx (' [])) + #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' [])) (list subS) (list.repeat (|> size n/dec (n/- idx)) (' [])))))]) caseP (if (tail? size idx) diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux index 1c3dc6f83..d61c85f58 100644 --- a/new-luxc/test/test/luxc/lang/translation/function.lux +++ b/new-luxc/test/test/luxc/lang/translation/function.lux @@ -49,7 +49,7 @@ (test "Can read arguments." (|> (do macro.Monad<Meta> [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` ("lux call" (~ functionS) (~@ argsS))))] + sampleI (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))] (@eval.eval sampleI)) (macro.run (init-compiler [])) (case> (#e.Success valueT) @@ -65,8 +65,8 @@ postS (list.drop partial-arity argsS)] runtime-bytecode @runtime.translate sampleI (expressionT.translate (` ("lux call" - ("lux call" (~ functionS) (~@ preS)) - (~@ postS))))] + ("lux call" (~ functionS) (~+ preS)) + (~+ postS))))] (@eval.eval sampleI)) (macro.run (init-compiler [])) (case> (#e.Success valueT) @@ -85,10 +85,10 @@ (|> arg n/inc (n/- super-arity) nat-to-int)) sub-arity (|> arity (n/- super-arity)) functionS (` ("lux function" (~ (code.nat super-arity)) [] - ("lux function" (~ (code.nat sub-arity)) [(~@ (list/map code.int env))] + ("lux function" (~ (code.nat sub-arity)) [(~+ (list/map code.int env))] ((~ (code.int arg-var))))))] runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` ("lux call" (~ functionS) (~@ argsS))))] + sampleI (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))] (@eval.eval sampleI)) (macro.run (init-compiler [])) (case> (#e.Success valueT) |