diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux')
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux | 157 |
1 files changed, 79 insertions, 78 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux index 8e0d51cd8..ecf13440b 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis/loop.lux @@ -10,12 +10,13 @@ [macro ["." code] ["." syntax]]] - ["." // (#+ Path Abstraction Synthesis) + [/// + ## TODO: Remove the 'extension' import ASAP. + ["///." extension] [// - ["." extension] - [// - ["." reference (#+ Register Variable)] - ["." analysis (#+ Environment)]]]]) + ["." reference (#+ Register Variable)] + ["." analysis (#+ Environment)] + ["/" synthesis (#+ Path Abstraction Synthesis)]]]) (type: #export (Transform a) (-> a (Maybe a))) @@ -27,10 +28,10 @@ #.None #0)) (template: #export (self) - (#//.Reference (reference.local 0))) + (#/.Reference (reference.local 0))) (template: (recursive-apply args) - (#//.Apply (self) args)) + (#/.Apply (self) args)) (def: improper #0) (def: proper #1) @@ -41,7 +42,7 @@ (^ (self)) improper - (#//.Structure structure) + (#/.Structure structure) (case structure (#analysis.Variant variantS) (proper? (get@ #analysis.value variantS)) @@ -49,51 +50,51 @@ (#analysis.Tuple membersS+) (list.every? proper? membersS+)) - (#//.Control controlS) + (#/.Control controlS) (case controlS - (#//.Branch branchS) + (#/.Branch branchS) (case branchS - (#//.Case inputS pathS) + (#/.Case inputS pathS) (and (proper? inputS) (.loop [pathS pathS] (case pathS - (^or (#//.Alt leftS rightS) (#//.Seq leftS rightS)) + (^or (#/.Alt leftS rightS) (#/.Seq leftS rightS)) (and (recur leftS) (recur rightS)) - (#//.Then bodyS) + (#/.Then bodyS) (proper? bodyS) _ proper))) - (#//.Let inputS register bodyS) + (#/.Let inputS register bodyS) (and (proper? inputS) (proper? bodyS)) - (#//.If inputS thenS elseS) + (#/.If inputS thenS elseS) (and (proper? inputS) (proper? thenS) (proper? elseS))) - (#//.Loop loopS) + (#/.Loop loopS) (case loopS - (#//.Scope scopeS) - (and (list.every? proper? (get@ #//.inits scopeS)) - (proper? (get@ #//.iteration scopeS))) + (#/.Scope scopeS) + (and (list.every? proper? (get@ #/.inits scopeS)) + (proper? (get@ #/.iteration scopeS))) - (#//.Recur argsS) + (#/.Recur argsS) (list.every? proper? argsS)) - (#//.Function functionS) + (#/.Function functionS) (case functionS - (#//.Abstraction environment arity bodyS) + (#/.Abstraction environment arity bodyS) (list.every? reference.self? environment) - (#//.Apply funcS argsS) + (#/.Apply funcS argsS) (and (proper? funcS) (list.every? proper? argsS)))) - (#//.Extension [name argsS]) + (#/.Extension [name argsS]) (list.every? proper? argsS) _ @@ -103,20 +104,20 @@ (-> (Transform Synthesis) (Transform Path)) (function (recur pathS) (case pathS - (#//.Alt leftS rightS) + (#/.Alt leftS rightS) (let [leftS' (recur leftS) rightS' (recur rightS)] (if (or (some? leftS') (some? rightS')) - (#.Some (#//.Alt (maybe.default leftS leftS') - (maybe.default rightS rightS'))) + (#.Some (#/.Alt (maybe.default leftS leftS') + (maybe.default rightS rightS'))) #.None)) - (#//.Seq leftS rightS) - (maybe/map (|>> (#//.Seq leftS)) (recur rightS)) + (#/.Seq leftS rightS) + (maybe/map (|>> (#/.Seq leftS)) (recur rightS)) - (#//.Then bodyS) - (maybe/map (|>> #//.Then) (synthesis-recursion bodyS)) + (#/.Then bodyS) + (maybe/map (|>> #/.Then) (synthesis-recursion bodyS)) _ #.None))) @@ -125,33 +126,33 @@ (-> Nat (Transform Synthesis)) (function (recur exprS) (case exprS - (#//.Control controlS) + (#/.Control controlS) (case controlS - (#//.Branch branchS) + (#/.Branch branchS) (case branchS - (#//.Case inputS pathS) + (#/.Case inputS pathS) (|> pathS (path-recursion recur) - (maybe/map (|>> (#//.Case inputS) #//.Branch #//.Control))) + (maybe/map (|>> (#/.Case inputS) #/.Branch #/.Control))) - (#//.Let inputS register bodyS) - (maybe/map (|>> (#//.Let inputS register) #//.Branch #//.Control) + (#/.Let inputS register bodyS) + (maybe/map (|>> (#/.Let inputS register) #/.Branch #/.Control) (recur bodyS)) - (#//.If inputS thenS elseS) + (#/.If inputS thenS elseS) (let [thenS' (recur thenS) elseS' (recur elseS)] (if (or (some? thenS') (some? elseS')) - (#.Some (|> (#//.If inputS - (maybe.default thenS thenS') - (maybe.default elseS elseS')) - #//.Branch #//.Control)) + (#.Some (|> (#/.If inputS + (maybe.default thenS thenS') + (maybe.default elseS elseS')) + #/.Branch #/.Control)) #.None))) - (^ (#//.Function (recursive-apply argsS))) + (^ (#/.Function (recursive-apply argsS))) (if (n/= arity (list.size argsS)) - (#.Some (|> argsS #//.Recur #//.Loop #//.Control)) + (#.Some (|> argsS #/.Recur #/.Loop #/.Control)) #.None) _ @@ -174,8 +175,8 @@ (-> (Transform Synthesis) Register (Transform Path)) (function (recur pathS) (case pathS - (#//.Bind register) - (#.Some (#//.Bind (n/+ offset register))) + (#/.Bind register) + (#.Some (#/.Bind (n/+ offset register))) (^template [<tag>] (<tag> leftS rightS) @@ -183,10 +184,10 @@ [leftS' (recur leftS) rightS' (recur rightS)] (wrap (<tag> leftS' rightS')))) - ([#//.Alt] [#//.Seq]) + ([#/.Alt] [#/.Seq]) - (#//.Then bodyS) - (|> bodyS adjust-synthesis (maybe/map (|>> #//.Then))) + (#/.Then bodyS) + (|> bodyS adjust-synthesis (maybe/map (|>> #/.Then))) _ (#.Some pathS)))) @@ -195,7 +196,7 @@ (-> Environment Register (Transform Synthesis)) (function (recur exprS) (case exprS - (#//.Structure structureS) + (#/.Structure structureS) (case structureS (#analysis.Variant variantS) (do maybe.monad @@ -203,89 +204,89 @@ (wrap (|> variantS (set@ #analysis.value valueS') #analysis.Variant - #//.Structure))) + #/.Structure))) (#analysis.Tuple membersS+) (|> membersS+ (monad.map maybe.monad recur) - (maybe/map (|>> #analysis.Tuple #//.Structure)))) + (maybe/map (|>> #analysis.Tuple #/.Structure)))) - (#//.Reference reference) + (#/.Reference reference) (case reference (^ (reference.constant constant)) (#.Some exprS) (^ (reference.local register)) - (#.Some (#//.Reference (reference.local (n/+ offset register)))) + (#.Some (#/.Reference (reference.local (n/+ offset register)))) (^ (reference.foreign register)) (|> scope-environment (list.nth register) - (maybe/map (|>> #reference.Variable #//.Reference)))) + (maybe/map (|>> #reference.Variable #/.Reference)))) - (^ (//.branch/case [inputS pathS])) + (^ (/.branch/case [inputS pathS])) (do maybe.monad [inputS' (recur inputS) pathS' (adjust-path recur offset pathS)] - (wrap (|> pathS' [inputS'] //.branch/case))) + (wrap (|> pathS' [inputS'] /.branch/case))) - (^ (//.branch/let [inputS register bodyS])) + (^ (/.branch/let [inputS register bodyS])) (do maybe.monad [inputS' (recur inputS) bodyS' (recur bodyS)] - (wrap (//.branch/let [inputS' register bodyS']))) + (wrap (/.branch/let [inputS' register bodyS']))) - (^ (//.branch/if [inputS thenS elseS])) + (^ (/.branch/if [inputS thenS elseS])) (do maybe.monad [inputS' (recur inputS) thenS' (recur thenS) elseS' (recur elseS)] - (wrap (//.branch/if [inputS' thenS' elseS']))) + (wrap (/.branch/if [inputS' thenS' elseS']))) - (^ (//.loop/scope scopeS)) + (^ (/.loop/scope scopeS)) (do maybe.monad [inits' (|> scopeS - (get@ #//.inits) + (get@ #/.inits) (monad.map maybe.monad recur)) - iteration' (recur (get@ #//.iteration scopeS))] - (wrap (//.loop/scope {#//.start (|> scopeS (get@ #//.start) (n/+ offset)) - #//.inits inits' - #//.iteration iteration'}))) + iteration' (recur (get@ #/.iteration scopeS))] + (wrap (/.loop/scope {#/.start (|> scopeS (get@ #/.start) (n/+ offset)) + #/.inits inits' + #/.iteration iteration'}))) - (^ (//.loop/recur argsS)) + (^ (/.loop/recur argsS)) (|> argsS (monad.map maybe.monad recur) - (maybe/map (|>> //.loop/recur))) + (maybe/map (|>> /.loop/recur))) - (^ (//.function/abstraction [environment arity bodyS])) + (^ (/.function/abstraction [environment arity bodyS])) (do maybe.monad [environment' (monad.map maybe.monad (resolve scope-environment) environment)] - (wrap (//.function/abstraction [environment' arity bodyS]))) + (wrap (/.function/abstraction [environment' arity bodyS]))) - (^ (//.function/apply [function arguments])) + (^ (/.function/apply [function arguments])) (do maybe.monad [function' (recur function) arguments' (monad.map maybe.monad recur arguments)] - (wrap (//.function/apply [function' arguments']))) + (wrap (/.function/apply [function' arguments']))) - (#//.Extension [name argsS]) + (#/.Extension [name argsS]) (|> argsS (monad.map maybe.monad recur) - (maybe/map (|>> [name] #//.Extension))) + (maybe/map (|>> [name] #/.Extension))) _ (#.Some exprS)))) (def: #export (loop environment num-locals inits functionS) (-> Environment Nat (List Synthesis) Abstraction (Maybe Synthesis)) - (let [bodyS (get@ #//.body functionS)] + (let [bodyS (get@ #/.body functionS)] (if (and (n/= (list.size inits) - (get@ #//.arity functionS)) + (get@ #/.arity functionS)) (proper? bodyS)) (|> bodyS (adjust environment num-locals) - (maybe/map (|>> [(inc num-locals) inits] //.loop/scope))) + (maybe/map (|>> [(inc num-locals) inits] /.loop/scope))) #.None))) |