diff options
Diffstat (limited to 'stdlib')
12 files changed, 427 insertions, 215 deletions
diff --git a/stdlib/source/lux/compiler/default/evaluation.lux b/stdlib/source/lux/compiler/default/evaluation.lux index 3fb1a9984..ea76624df 100644 --- a/stdlib/source/lux/compiler/default/evaluation.lux +++ b/stdlib/source/lux/compiler/default/evaluation.lux @@ -29,7 +29,7 @@ [exprA (type.with-type type (expressionA.compile exprC))] (phase.lift (do error.Monad<Error> - [exprS (|> exprA expressionS.synthesize (phase.run synthesis-state))] + [exprS (|> exprA expressionS.phase (phase.run synthesis-state))] (phase.run translation-state (do phase.Monad<Operation> [exprO (translate exprS)] diff --git a/stdlib/source/lux/compiler/default/init.lux b/stdlib/source/lux/compiler/default/init.lux index 947dc9d4b..96464ed2a 100644 --- a/stdlib/source/lux/compiler/default/init.lux +++ b/stdlib/source/lux/compiler/default/init.lux @@ -85,7 +85,7 @@ {#statement.analysis {#statement.state analysis-state #statement.phase expressionA.compile} #statement.synthesis {#statement.state synthesis-state - #statement.phase expressionS.synthesize} + #statement.phase expressionS.phase} #statement.translation {#statement.state translation-state #statement.phase translate}}])) diff --git a/stdlib/source/lux/compiler/default/phase/analysis.lux b/stdlib/source/lux/compiler/default/phase/analysis.lux index 7663f6950..dde9f4e9a 100644 --- a/stdlib/source/lux/compiler/default/phase/analysis.lux +++ b/stdlib/source/lux/compiler/default/phase/analysis.lux @@ -112,19 +112,23 @@ (#..Function (list)) (#..Apply value))) -(def: #export (apply [func args]) +(def: #export (apply [abstraction inputs]) (-> (Application Analysis) Analysis) - (list/fold (function (_ arg func) (#Apply arg func)) func args)) + (list/fold (function (_ input abstraction') + (#Apply input abstraction')) + abstraction + inputs)) (def: #export (application analysis) (-> Analysis (Application Analysis)) - (case analysis - (#Apply head func) - (let [[func' tail] (application func)] - [func' (#.Cons head tail)]) - - _ - [analysis (list)])) + (loop [abstraction analysis + inputs (list)] + (case abstraction + (#Apply input next) + (recur next (#.Cons input inputs)) + + _ + [abstraction inputs]))) (do-template [<name> <tag>] [(template: #export (<name> content) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis.lux b/stdlib/source/lux/compiler/default/phase/synthesis.lux index bf60c9798..da5cad094 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis.lux @@ -1,15 +1,18 @@ (.module: [lux (#- i64 Scope) - [control [monad (#+ do)]] + [control + [monad (#+ do)] + [equivalence (#+ Equivalence)] + ["ex" exception (#+ exception:)]] [data - [error (#+ Error)] - ["." text + [bit ("bit/." Equivalence<Bit>)] + ["." text ("text/." Equivalence<Text>) format] [collection [list ("list/." Functor<List>)] ["." dictionary (#+ Dictionary)]]]] ["." // - ["." analysis (#+ Environment Arity Analysis)] + ["." analysis (#+ Environment Arity Composite Analysis)] ["." extension (#+ Extension)] [// ["." reference (#+ Register Variable Reference)]]]) @@ -17,10 +20,7 @@ (type: #export Resolver (Dictionary Variable Variable)) (type: #export State - {#scope-arity Arity - #resolver Resolver - #direct? Bit - #locals Nat}) + {#locals Nat}) (def: #export fresh-resolver Resolver @@ -28,10 +28,7 @@ (def: #export init State - {#scope-arity 0 - #resolver fresh-resolver - #direct? #0 - #locals 0}) + {#locals 0}) (type: #export Primitive (#Bit Bit) @@ -39,10 +36,6 @@ (#F64 Frac) (#Text Text)) -(type: #export (Structure a) - (#Variant (analysis.Variant a)) - (#Tuple (analysis.Tuple a))) - (type: #export Side (Either Nat Nat)) @@ -96,7 +89,7 @@ (type: #export #rec Synthesis (#Primitive Primitive) - (#Structure (Structure Synthesis)) + (#Structure (Composite Synthesis)) (#Reference Reference) (#Control (Control Synthesis)) (#Extension (Extension Synthesis))) @@ -157,9 +150,15 @@ (<tag> content))] [path/bind #..Bind] + [path/then #..Then] + ) + +(do-template [<name> <tag>] + [(template: #export (<name> left right) + (<tag> [left right]))] + [path/alt #..Alt] [path/seq #..Seq] - [path/then #..Then] ) (type: #export Abstraction @@ -170,41 +169,24 @@ (def: #export unit Text "") -(do-template [<name> <value>] - [(def: #export <name> - (All [a] (-> (Operation a) (Operation a))) - (extension.temporary (set@ #direct? <value>)))] - - [indirectly #0] - [directly #1] - ) - (do-template [<name> <type> <tag>] [(def: #export (<name> value) (-> <type> (All [a] (-> (Operation a) (Operation a)))) (extension.temporary (set@ <tag> value)))] - [with-scope-arity Arity #scope-arity] - [with-resolver Resolver #resolver] [with-locals Nat #locals] ) (def: #export (with-abstraction arity resolver) (-> Arity Resolver (All [a] (-> (Operation a) (Operation a)))) - (extension.with-state {#scope-arity arity - #resolver resolver - #direct? #1 - #locals arity})) + (extension.with-state {#locals arity})) (do-template [<name> <tag> <type>] [(def: #export <name> (Operation <type>) (extension.read (get@ <tag>)))] - [scope-arity #scope-arity Arity] - [resolver #resolver Resolver] - [direct? #direct? Bit] [locals #locals Nat] ) @@ -230,8 +212,8 @@ <tag> content))] - [variant #..Variant] - [tuple #..Tuple] + [variant #analysis.Variant] + [tuple #analysis.Tuple] ) (do-template [<name> <tag>] @@ -272,6 +254,59 @@ [function/apply #..Function #..Apply] ) +(def: #export (%path' %then value) + (All [a] (-> (Format a) (Format (Path' a)))) + (case value + #Pop + "_" + + (#Test primitive) + (format "(? " + (case primitive + (#Bit value) + (%b value) + + (#I64 value) + (%i (.int value)) + + (#F64 value) + (%f value) + + (#Text value) + (%t value)) + ")") + + (#Access access) + (case access + (#Side side) + (case side + (#.Left lefts) + (format "(" (%n lefts) " #0" ")") + + (#.Right lefts) + (format "(" (%n lefts) " #1" ")")) + + (#Member member) + (case member + (#.Left lefts) + (format "[" (%n lefts) " #0" "]") + + (#.Right lefts) + (format "[" (%n lefts) " #1" "]"))) + + (#Bind register) + (format "(@ " (%n register) ")") + + (#Alt left right) + (format "(| " (%path' %then left) " " (%path' %then right) ")") + + (#Seq left right) + (format "(& " (%path' %then left) " " (%path' %then right) ")") + + (#Then then) + (|> (%then then) + (text.enclose ["(! " ")"])))) + (def: #export (%synthesis value) (Format Synthesis) (case value @@ -283,7 +318,7 @@ [..text %t]) (^ (..i64 value)) - (%n (.nat value)) + (%i (.int value)) (^ (..variant [lefts right? content])) (|> (%synthesis content) @@ -295,6 +330,121 @@ (list/map %synthesis) (text.join-with " ") (text.enclose ["[" "]"])) - - _ - "???")) + + (#Reference reference) + (reference.%reference reference) + + (#Control control) + (case control + (#Function function) + (case function + (#Abstraction [environment arity body]) + (|> (%synthesis body) + (format (%n arity) " ") + (format (|> environment + (list/map reference.%variable) + (text.join-with " ") + (text.enclose ["[" "]"])) + " ") + (text.enclose ["(" ")"])) + + (#Apply func args) + (|> (list/map %synthesis args) + (text.join-with " ") + (format (%synthesis func) " ") + (text.enclose ["(" ")"]))) + + ## (%path' %synthesis ...) + ## (#Branch branch) + ## (#Loop loop) + _ + "???") + + (#Extension [name args]) + (|> (list/map %synthesis args) + (text.join-with " ") + (format (%t name)) + (text.enclose ["(" ")"])))) + +(def: #export %path + (Format Path) + (%path' %synthesis)) + +(structure: #export _ (Equivalence Primitive) + (def: (= reference sample) + (case [reference sample] + (^template [<tag> <eq> <format>] + [(<tag> reference') (<tag> sample')] + (<eq> reference' sample')) + ([#Bit bit/= %b] + [#F64 f/= %f] + [#Text text/= %t]) + + [(#I64 reference') (#I64 sample')] + (i/= (.int reference') (.int sample')) + + _ + false))) + +(structure: #export _ (Equivalence Access) + (def: (= reference sample) + (case [reference sample] + (^template [<tag>] + [(<tag> reference') (<tag> sample')] + (case [reference' sample'] + (^template [<side>] + [(<side> reference'') (<side> sample'')] + (n/= reference'' sample'')) + ([#.Left] + [#.Right]) + + _ + false)) + ([#Side] + [#Member]) + + _ + false))) + +(structure: #export (Equivalence<Path'> Equivalence<a>) + (All [a] (-> (Equivalence a) (Equivalence (Path' a)))) + + (def: (= reference sample) + (case [reference sample] + [#Pop #Pop] + true + + (^template [<tag> <equivalence>] + [(<tag> reference') (<tag> sample')] + (:: <equivalence> = reference' sample')) + ([#Test Equivalence<Primitive>] + [#Access Equivalence<Access>] + [#Then Equivalence<a>]) + + [(#Bind reference') (#Bind sample')] + (n/= reference' sample') + + (^template [<tag>] + [(<tag> leftR rightR) (<tag> leftS rightS)] + (and (= leftR leftS) + (= rightR rightS))) + ([#Alt] + [#Seq]) + + _ + false))) + +(structure: #export _ (Equivalence Synthesis) + (def: (= reference sample) + (case [reference sample] + (^template [<tag> <equivalence>] + [(<tag> reference') (<tag> sample')] + (:: <equivalence> = reference' sample')) + ([#Primitive Equivalence<Primitive>]) + + _ + false))) + +(def: #export Equivalence<Path> + (Equivalence Path) + (Equivalence<Path'> Equivalence<Synthesis>)) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux index c9de46ac9..e9e941a30 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis/case.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis/case.lux @@ -43,11 +43,7 @@ [#analysis.Text #//.Text])) (#analysis.Bind register) - (<| (do ///.Monad<Operation> - [arity //.scope-arity]) - (:: @ map (|>> (#//.Seq (#//.Bind (if (function.nested? arity) - (n/+ (dec arity) register) - register))))) + (<| (:: ///.Monad<Operation> map (|>> (#//.Seq (#//.Bind register)))) //.with-new-local thenC) @@ -140,14 +136,9 @@ _ (do @ - [arity //.scope-arity - headB/bodyS (//.with-new-local + [headB/bodyS (//.with-new-local (synthesize^ headB/bodyA))] - (wrap (//.branch/let [inputS - (if (function.nested? arity) - (n/+ (dec arity) inputR) - inputR) - headB/bodyS]))))) + (wrap (//.branch/let [inputS inputR headB/bodyS]))))) <if> (as-is (^or (^ [[(analysis.pattern/bit #1) thenA] diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux index 4a5f2979c..6cdd9b6fc 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis/expression.lux @@ -6,7 +6,7 @@ ["." maybe] [collection ["." list ("list/." Functor<List>)] - ["dict" dictionary (#+ Dictionary)]]]] + ["." dictionary (#+ Dictionary)]]]] ["." // (#+ Synthesis Phase) ["." function] ["." case] @@ -36,62 +36,39 @@ [#analysis.Int #//.I64] [#analysis.Rev #//.I64]))) -(def: #export (synthesize analysis) +(def: #export (phase analysis) Phase (case analysis (#analysis.Primitive analysis') (operation/wrap (#//.Primitive (..primitive analysis'))) - (#analysis.Structure composite) - (case (analysis.variant analysis) - (#.Some variant) + (#analysis.Structure structure) + (case structure + (#analysis.Variant variant) (do ///.Monad<Operation> - [valueS (synthesize (get@ #analysis.value variant))] - (wrap (#//.Structure (#//.Variant (set@ #analysis.value valueS variant))))) - - _ - (do ///.Monad<Operation> - [tupleS (monad.map @ synthesize (analysis.tuple analysis))] - (wrap (#//.Structure (#//.Tuple tupleS))))) + [valueS (phase (get@ #analysis.value variant))] + (wrap (//.variant (set@ #analysis.value valueS variant)))) + (#analysis.Tuple tuple) + (|> tuple + (monad.map ///.Monad<Operation> phase) + (:: ///.Monad<Operation> map (|>> //.tuple)))) + (#analysis.Reference reference) - (case reference - (#reference.Constant constant) - (operation/wrap (#//.Reference reference)) - - (#reference.Variable var) - (do ///.Monad<Operation> - [resolver //.resolver] - (case var - (#reference.Local register) - (do @ - [arity //.scope-arity] - (wrap (if (function.nested? arity) - (if (n/= 0 register) - (|> (dec arity) - (list.n/range 1) - (list/map (|>> //.variable/local)) - [(//.variable/local 0)] - //.function/apply) - (#//.Reference (#reference.Variable (function.adjust arity #0 var)))) - (#//.Reference (#reference.Variable var))))) - - (#reference.Foreign register) - (wrap (|> resolver (dict.get var) (maybe.default var) #reference.Variable #//.Reference))))) + (operation/wrap (#//.Reference reference)) (#analysis.Case inputA branchesAB+) - (case.synthesize (|>> synthesize //.indirectly) inputA branchesAB+) + (case.synthesize phase inputA branchesAB+) (^ (analysis.no-op value)) - (synthesize value) + (phase value) (#analysis.Apply _) - (function.apply (|>> synthesize //.indirectly) analysis) + (function.apply phase analysis) (#analysis.Function environmentA bodyA) - (function.function synthesize environmentA bodyA) + (function.abstraction phase environmentA bodyA) (#analysis.Extension name args) - (extension.apply (|>> synthesize //.indirectly) - [name args]) + (extension.apply phase [name args]) )) diff --git a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux index 3c89ae063..196d959ed 100644 --- a/stdlib/source/lux/compiler/default/phase/synthesis/function.lux +++ b/stdlib/source/lux/compiler/default/phase/synthesis/function.lux @@ -1,120 +1,211 @@ (.module: - [lux (#- function) + [lux #* [control - ["." monad (#+ do)]] + ["." monad (#+ do)] + ["ex" exception (#+ exception:)]] [data ["." maybe] + ["." text + format] [collection ["." list ("list/." Functor<List> Monoid<List> Fold<List>)] ["dict" dictionary (#+ Dictionary)]]]] - ["." // (#+ Synthesis Operation Phase) + ["." // (#+ Path Synthesis Operation Phase) ["." loop (#+ Transform)] - ["/." // + ["/." // ("operation/." Monad<Operation>) ["." analysis (#+ Environment Arity Analysis)] [// - ["." reference (#+ Variable)]]]]) + ["." reference (#+ Register Variable)]]]]) -(def: #export nested? - (-> Arity Bit) - (n/> 1)) +(exception: #export (cannot-find-foreign-variable-in-environment {foreign Register} {environment Environment}) + (ex.report ["Foreign" (%n foreign)] + ["Environment" (|> environment + (list/map reference.%variable) + (text.join-with " "))])) -(def: #export (adjust up-arity after? var) - (-> Arity Bit Variable Variable) - (case var - (#reference.Local register) - (if (and after? (n/>= up-arity register)) - (#reference.Local (n/+ (dec up-arity) register)) - var) +(def: arity-arguments + (-> Arity (List Synthesis)) + (|>> dec + (list.n/range 1) + (list/map (|>> //.variable/local)))) - _ - var)) - -(def: (unfold apply) - (-> Analysis [Analysis (List Analysis)]) - (loop [apply apply - args (list)] - (case apply - (#analysis.Apply arg func) - (recur func (#.Cons arg args)) +(template: #export (self-reference) + (//.variable/local 0)) - _ - [apply args]))) +(def: (expanded-nested-self-reference arity) + (-> Arity Synthesis) + (//.function/apply [(..self-reference) (arity-arguments arity)])) -(def: #export (apply synthesize) +(def: #export (apply phase) (-> Phase Phase) - (.function (_ exprA) - (let [[funcA argsA] (unfold exprA)] + (function (_ exprA) + (let [[funcA argsA] (analysis.application exprA)] (do ///.Monad<Operation> - [funcS (synthesize funcA) - argsS (monad.map @ synthesize argsA) - locals //.locals] - (case funcS - (^ (//.function/abstraction functionS)) - (wrap (|> functionS - (loop.loop (get@ #//.environment functionS) locals argsS) - (maybe.default (//.function/apply [funcS argsS])))) + [funcS (phase funcA) + argsS (monad.map @ phase argsA) + ## locals //.locals + ] + (with-expansions [<apply> (as-is (//.function/apply [funcS argsS]))] + (case funcS + ## (^ (//.function/abstraction functionS)) + ## (wrap (|> functionS + ## (loop.loop (get@ #//.environment functionS) locals argsS) + ## (maybe.default <apply>))) + + (^ (//.function/apply [funcS' argsS'])) + (wrap (//.function/apply [funcS' (list/compose argsS' argsS)])) - (^ (//.function/apply [funcS' argsS'])) - (wrap (//.function/apply [funcS' (list/compose argsS' argsS)])) + _ + (wrap <apply>))))))) +(def: (find-foreign environment register) + (-> Environment Register (Operation Variable)) + (case (list.nth register environment) + (#.Some aliased) + (operation/wrap aliased) + + #.None + (///.throw cannot-find-foreign-variable-in-environment [register environment]))) + +(def: (grow-path grow path) + (-> (-> Synthesis (Operation Synthesis)) Path (Operation Path)) + (case path + (#//.Bind register) + (operation/wrap (#//.Bind (inc register))) + + (^template [<tag>] + (<tag> left right) + (do ///.Monad<Operation> + [left' (grow-path grow left) + right' (grow-path grow right)] + (wrap (<tag> left' right')))) + ([#//.Alt] [#//.Alt]) + + (#//.Then thenS) + (|> thenS + grow + (operation/map (|>> #//.Then))) + + _ + (operation/wrap path))) + +(def: (grow-sub-environment super sub) + (-> Environment Environment (Operation Environment)) + (monad.map ///.Monad<Operation> + (function (_ variable) + (case variable + (#reference.Local register) + (operation/wrap variable) + + (#reference.Foreign register) + (find-foreign super register))) + sub)) + +(def: (grow environment expression) + (-> Environment Synthesis (Operation Synthesis)) + (case expression + (#//.Structure structure) + (case structure + (#analysis.Variant [lefts right? subS]) + (|> subS + (grow environment) + (operation/map (|>> [lefts right?] //.variant))) + + (#analysis.Tuple membersS+) + (|> membersS+ + (monad.map ///.Monad<Operation> (grow environment)) + (operation/map (|>> //.tuple)))) + + (^ (..self-reference)) + (operation/wrap (//.function/apply [expression (list (//.variable/local 1))])) + + (#//.Reference reference) + (case reference + (#reference.Variable variable) + (case variable + (#reference.Local register) + (operation/wrap (//.variable/local (inc register))) + + (#reference.Foreign register) + (|> register + (find-foreign environment) + (operation/map (|>> //.variable)))) + + (#reference.Constant constant) + (operation/wrap expression)) + + (#//.Control control) + (case control + (#//.Branch branch) + (case branch + (#//.Let [inputS register bodyS]) + (do ///.Monad<Operation> + [inputS' (grow environment inputS) + bodyS' (grow environment bodyS)] + (wrap (//.branch/let [inputS' (inc register) bodyS']))) + + (#//.If [testS thenS elseS]) + (do ///.Monad<Operation> + [testS' (grow environment testS) + thenS' (grow environment thenS) + elseS' (grow environment elseS)] + (wrap (//.branch/if [testS' thenS' elseS']))) + + (#//.Case [inputS pathS]) + (do ///.Monad<Operation> + [inputS' (grow environment inputS) + pathS' (grow-path (grow environment) pathS)] + (wrap (//.branch/case [inputS' pathS'])))) + + (#//.Loop loop) + (case loop + (#//.Scope [start initsS+ iterationS]) + (do ///.Monad<Operation> + [initsS+' (monad.map @ (grow environment) initsS+) + iterationS' (grow environment iterationS)] + (wrap (//.loop/scope [start initsS+' iterationS']))) + + (#//.Recur argumentsS+) + (|> argumentsS+ + (monad.map ///.Monad<Operation> (grow environment)) + (operation/map (|>> //.loop/recur)))) + + (#//.Function function) + (case function + (#//.Abstraction [_env _arity _body]) + (do ///.Monad<Operation> + [_env' (grow-sub-environment environment _env)] + (wrap (//.function/abstraction [_env' _arity _body]))) + + (#//.Apply funcS argsS+) + (case funcS + (^ (//.function/apply [(..self-reference) pre-argsS+])) + (operation/wrap (//.function/apply [(..self-reference) + (list/compose pre-argsS+ argsS+)])) + _ - (wrap (//.function/apply [funcS argsS]))))))) + (do ///.Monad<Operation> + [funcS' (grow environment funcS) + argsS+' (monad.map @ (grow environment) argsS+)] + (wrap (//.function/apply [funcS' argsS+'])))))) + + (#//.Extension name argumentsS+) + (|> argumentsS+ + (monad.map ///.Monad<Operation> (grow environment)) + (operation/map (|>> (#//.Extension name)))) -(def: (prepare up down body) - (-> Arity Arity Synthesis Synthesis) - (if (nested? up) - body - (maybe.default body (loop.recursion down body)))) + _ + (operation/wrap expression))) -(def: #export (function synthesize environment body) +(def: #export (abstraction phase environment bodyA) (-> Phase Environment Analysis (Operation Synthesis)) (do ///.Monad<Operation> - [direct? //.direct? - arity //.scope-arity - resolver //.resolver - #let [function-arity (if direct? - (inc arity) - 1) - up-environment (if (nested? arity) - (list/map (.function (_ closure) - (case (dict.get closure resolver) - (#.Some resolved) - (adjust arity #1 resolved) - - #.None - (adjust arity #0 closure))) - environment) - environment) - down-environment (: (List Variable) - (case environment - #.Nil - (list) - - _ - (|> environment - list.size - list.indices - (list/map (|>> #reference.Foreign))))) - resolver' (if (and (nested? function-arity) - direct?) - (list/fold (.function (_ [from to] resolver') - (dict.put from to resolver')) - //.fresh-resolver - (list.zip2 down-environment up-environment)) - (list/fold (.function (_ var resolver') - (dict.put var var resolver')) - //.fresh-resolver - down-environment))] - bodyS (//.with-abstraction function-arity resolver' - (synthesize body))] + [bodyS (phase bodyA)] (case bodyS (^ (//.function/abstraction [env' down-arity' bodyS'])) - (let [arity' (inc down-arity')] - (|> (prepare function-arity arity' bodyS') - [up-environment arity'] //.function/abstraction - wrap)) - + (|> bodyS' + (grow env') + (:: @ map (|>> [environment (inc down-arity')] //.function/abstraction))) + _ - (|> (prepare function-arity 1 bodyS) - [up-environment 1] //.function/abstraction - wrap)))) + (wrap (//.function/abstraction [environment 1 bodyS]))))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux index 1d9415a99..4a963d507 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/case.jvm.lux @@ -142,7 +142,7 @@ [synthesis.member/right runtime.product//right inc]) (^template [<tag> <computation>] - (^ (<tag> [leftP rightP])) + (^ (<tag> leftP rightP)) (do ////.Monad<Operation> [leftO (pattern-matching' translate leftP) rightO (pattern-matching' translate rightP)] diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux index f3c3b9d2e..2084ee46b 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux @@ -31,7 +31,7 @@ (list)]])]] (test "Dummy variables created to mask expressions get eliminated during synthesis." (|> maskA - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (error/map (//primitive.corresponds? maskedA)) (error.default #0)))))) @@ -49,7 +49,7 @@ (list)]])]] (test "Can detect and reify simple 'let' expressions." (|> letA - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (^ (#error.Success (//.branch/let [inputS registerS outputS]))) (and (n/= registerA registerS) @@ -77,7 +77,7 @@ (analysis.control/case [inputA [elseB (list thenB)]]))]] (test "Can detect and reify simple 'if' expressions." (|> ifA - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (^ (#error.Success (//.branch/if [inputS thenS elseS]))) (and (//primitive.corresponds? inputA inputS) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux index fae0e0fdf..133048936 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux @@ -105,9 +105,8 @@ (#analysis.Reference (reference.local chosen)) (|> chosen (n/+ (dec arity)) #reference.Local)]))))) -(context: "Function definition." - (<| (seed 13007429814532219492) - ## (times 100) +(context: "Abstraction." + (<| (times 100) (do @ [[arity//constant function//constant prediction//constant] constant-function [arity//environment function//environment prediction//environment] function-with-environment @@ -115,7 +114,7 @@ ($_ seq (test "Nested functions will get folded together." (|> function//constant - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (^ (#error.Success (//.function/abstraction [environment arity output]))) (and (n/= arity//constant arity) @@ -125,7 +124,7 @@ (n/= 0 arity//constant)))) (test "Folded functions provide direct access to environment variables." (|> function//environment - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) (and (n/= arity//environment arity) @@ -135,7 +134,7 @@ #0))) (test "Folded functions properly offset local variables." (|> function//local - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (^ (#error.Success (//.function/abstraction [environment arity (#//.Reference (reference.variable output))]))) (and (n/= arity//local arity) @@ -145,7 +144,7 @@ #0))) )))) -(context: "Function application." +(context: "Application." (<| (times 100) (do @ [arity (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1)))) @@ -154,7 +153,7 @@ ($_ seq (test "Can synthesize function application." (|> (analysis.apply [funcA argsA]) - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (^ (#error.Success (//.function/apply [funcS argsS]))) (and (//primitive.corresponds? funcA funcS) @@ -165,7 +164,7 @@ #0))) (test "Function application on no arguments just synthesizes to the function itself." (|> (analysis.apply [funcA (list)]) - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (#error.Success funcS) (//primitive.corresponds? funcA funcS) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux index fbe190a93..0a55fbcf6 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux @@ -80,7 +80,7 @@ (~~ (do-template [<desc> <analysis> <synthesis> <sample>] [(test (format "Can synthesize " <desc> ".") (|> (#analysis.Primitive (<analysis> <sample>)) - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (#error.Success (#//.Primitive (<synthesis> value))) (is? <sample> value) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux index 90fd155b0..a78aa1a09 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux @@ -31,7 +31,7 @@ ($_ seq (test "Can synthesize variants." (|> (analysis.sum-analysis size tagA memberA) - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (#error.Success (#//.Structure (#//.Variant [leftsS right?S valueS]))) (let [tagS (if right?S (inc leftsS) leftsS)] @@ -51,7 +51,7 @@ ($_ seq (test "Can synthesize tuple." (|> (analysis.product-analysis membersA) - expression.synthesize + expression.phase (phase.run [bundle.empty //.init]) (case> (#error.Success (#//.Structure (#//.Tuple membersS))) (and (n/= size (list.size membersS)) |