diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/case.lux | 56 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/expression.lux | 160 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/function.lux | 18 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/loop.lux | 118 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis/variable.lux | 64 |
6 files changed, 209 insertions, 209 deletions
diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux index 3207c41b4..33c8aa063 100644 --- a/new-luxc/source/luxc/lang/synthesis.lux +++ b/new-luxc/source/luxc/lang/synthesis.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux) (def: #export Arity Nat) diff --git a/new-luxc/source/luxc/lang/synthesis/case.lux b/new-luxc/source/luxc/lang/synthesis/case.lux index c35483dd8..ab4820b30 100644 --- a/new-luxc/source/luxc/lang/synthesis/case.lux +++ b/new-luxc/source/luxc/lang/synthesis/case.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (data [bool "bool/" Eq<Bool>] [text "text/" Eq<Text>] @@ -6,54 +6,54 @@ [number] (coll [list "list/" Fold<List> Monoid<List>])) (macro [code "code/" Eq<Code>])) - (luxc (lang [";L" variable #+ Variable] + (luxc (lang [".L" variable #+ Variable] ["la" analysis] ["ls" synthesis] - (synthesis [";S" function])))) + (synthesis [".S" function])))) -(def: popPS ls;Path (' ("lux case pop"))) +(def: popPS ls.Path (' ("lux case pop"))) (def: (path' arity num-locals pattern) - (-> ls;Arity Nat la;Pattern [Nat (List ls;Path)]) + (-> ls.Arity Nat la.Pattern [Nat (List ls.Path)]) (case pattern (^code ("lux case tuple" [(~@ membersP)])) (case membersP - #;Nil + #.Nil [num-locals (list popPS)] - (#;Cons singletonP #;Nil) + (#.Cons singletonP #.Nil) (path' arity num-locals singletonP) - (#;Cons _) - (let [last-idx (n.dec (list;size membersP)) - [_ output] (list/fold (: (-> la;Pattern [Nat [Nat (List ls;Path)]] [Nat [Nat (List ls;Path)]]) + (#.Cons _) + (let [last-idx (n/dec (list.size membersP)) + [_ output] (list/fold (: (-> la.Pattern [Nat [Nat (List ls.Path)]] [Nat [Nat (List ls.Path)]]) (function [current-pattern [current-idx num-locals' next]] (let [[num-locals'' current-path] (path' arity num-locals' current-pattern)] - [(n.dec current-idx) + [(n/dec current-idx) num-locals'' - (|> (list (if (n.= last-idx current-idx) - (` ("lux case tuple right" (~ (code;nat current-idx)))) - (` ("lux case tuple left" (~ (code;nat current-idx)))))) + (|> (list (if (n/= last-idx current-idx) + (` ("lux case tuple right" (~ (code.nat current-idx)))) + (` ("lux case tuple left" (~ (code.nat current-idx)))))) (list/compose current-path) (list/compose next))]))) [last-idx num-locals (list popPS)] - (list;reverse membersP))] + (list.reverse membersP))] output)) - (^code ("lux case variant" (~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP))) + (^code ("lux case variant" (~ [_ (#.Nat tag)]) (~ [_ (#.Nat num-tags)]) (~ memberP))) (let [[num-locals' member-path] (path' arity num-locals memberP)] - [num-locals' (|> (list (if (n.= (n.dec num-tags) tag) - (` ("lux case variant right" (~ (code;nat tag)))) - (` ("lux case variant left" (~ (code;nat tag)))))) + [num-locals' (|> (list (if (n/= (n/dec num-tags) tag) + (` ("lux case variant right" (~ (code.nat tag)))) + (` ("lux case variant left" (~ (code.nat tag)))))) (list/compose member-path) (list& popPS))]) - (^code ("lux case bind" (~ [_ (#;Nat register)]))) - [(n.inc num-locals) + (^code ("lux case bind" (~ [_ (#.Nat register)]))) + [(n/inc num-locals) (list popPS - (` ("lux case bind" (~ (code;nat (if (functionS;nested? arity) - (n.+ (n.dec arity) register) + (` ("lux case bind" (~ (code.nat (if (functionS.nested? arity) + (n/+ (n/dec arity) register) register))))))] _ @@ -61,18 +61,18 @@ (list popPS pattern)])) (def: (clean-unnecessary-pops paths) - (-> (List ls;Path) (List ls;Path)) + (-> (List ls.Path) (List ls.Path)) (case paths - (#;Cons path paths') + (#.Cons path paths') (if (is popPS path) (clean-unnecessary-pops paths') paths) - #;Nil + #.Nil paths)) (def: #export (path arity num-locals synthesize pattern bodyA) - (-> ls;Arity Nat (-> Nat la;Analysis ls;Synthesis) la;Pattern la;Analysis ls;Path) + (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis) la.Pattern la.Analysis ls.Path) (let [[num-locals' pieces] (path' arity num-locals pattern)] (|> pieces clean-unnecessary-pops @@ -81,7 +81,7 @@ (` ("lux case exec" (~ (synthesize num-locals' bodyA)))))))) (def: #export (weave leftP rightP) - (-> ls;Path ls;Path ls;Path) + (-> ls.Path ls.Path ls.Path) (with-expansions [<default> (as-is (` ("lux case alt" (~ leftP) (~ rightP))))] (case [leftP rightP] (^ [(^code ("lux case seq" (~ preL) (~ postL))) diff --git a/new-luxc/source/luxc/lang/synthesis/expression.lux b/new-luxc/source/luxc/lang/synthesis/expression.lux index aaa2cf2c7..d3fbfcb58 100644 --- a/new-luxc/source/luxc/lang/synthesis/expression.lux +++ b/new-luxc/source/luxc/lang/synthesis/expression.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control ["p" parser]) (data [maybe] @@ -12,82 +12,82 @@ ["s" syntax])) (luxc (lang ["la" analysis] ["ls" synthesis] - (synthesis [";S" case] - [";S" function] - [";S" loop]) - [";L" variable #+ Variable]) + (synthesis [".S" case] + [".S" function] + [".S" loop]) + [".L" variable #+ Variable]) )) (def: init-env (List Variable) (list)) -(def: init-resolver (Dict Int Int) (dict;new number;Hash<Int>)) +(def: init-resolver (Dict Int Int) (dict.new number.Hash<Int>)) (def: (prepare-body inner-arity arity body) - (-> ls;Arity ls;Arity ls;Synthesis ls;Synthesis) - (if (functionS;nested? inner-arity) + (-> ls.Arity ls.Arity ls.Synthesis ls.Synthesis) + (if (functionS.nested? inner-arity) body - (loopS;reify-recursion arity body))) + (loopS.reify-recursion arity body))) (def: (let$ register inputS bodyS) - (-> Nat ls;Synthesis ls;Synthesis ls;Synthesis) - (` ("lux let" (~ (code;nat register)) (~ inputS) (~ bodyS)))) + (-> Nat ls.Synthesis ls.Synthesis ls.Synthesis) + (` ("lux let" (~ (code.nat register)) (~ inputS) (~ bodyS)))) (def: (if$ testS thenS elseS) - (-> ls;Synthesis ls;Synthesis ls;Synthesis ls;Synthesis) + (-> ls.Synthesis ls.Synthesis ls.Synthesis ls.Synthesis) (` ("lux if" (~ testS) (~ thenS) (~ elseS)))) (def: (function$ arity environment body) - (-> ls;Arity (List Variable) ls;Synthesis ls;Synthesis) - (` ("lux function" (~ (code;nat arity)) - [(~@ (list/map code;int environment))] + (-> ls.Arity (List Variable) ls.Synthesis ls.Synthesis) + (` ("lux function" (~ (code.nat arity)) + [(~@ (list/map code.int environment))] (~ body)))) (def: (variant$ tag last? valueS) - (-> Nat Bool ls;Synthesis ls;Synthesis) - (` ((~ (code;nat tag)) (~ (code;bool last?)) (~ valueS)))) + (-> Nat Bool ls.Synthesis ls.Synthesis) + (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ valueS)))) (def: (var$ var) - (-> Variable ls;Synthesis) - (` ((~ (code;int var))))) + (-> Variable ls.Synthesis) + (` ((~ (code.int var))))) (def: (procedure$ name argsS) - (-> Text (List ls;Synthesis) ls;Synthesis) - (` ((~ (code;text name)) (~@ argsS)))) + (-> Text (List ls.Synthesis) ls.Synthesis) + (` ((~ (code.text name)) (~@ argsS)))) (def: (call$ funcS argsS) - (-> ls;Synthesis (List ls;Synthesis) ls;Synthesis) + (-> ls.Synthesis (List ls.Synthesis) ls.Synthesis) (` ("lux call" (~ funcS) (~@ argsS)))) (def: (synthesize-case arity num-locals synthesize inputA branchesA) - (-> ls;Arity Nat (-> Nat la;Analysis ls;Synthesis) - la;Analysis (List [la;Pattern la;Analysis]) - ls;Synthesis) + (-> ls.Arity Nat (-> Nat la.Analysis ls.Synthesis) + la.Analysis (List [la.Pattern la.Analysis]) + ls.Synthesis) (let [inputS (synthesize num-locals inputA)] - (case (list;reverse branchesA) - (^multi (^ (list [(^code ("lux case bind" (~ [_ (#;Nat input-register)]))) - (^code ((~ [_ (#;Int var)])))])) - (not (variableL;captured? var)) - (n.= input-register (variableL;local-register var))) + (case (list.reverse branchesA) + (^multi (^ (list [(^code ("lux case bind" (~ [_ (#.Nat input-register)]))) + (^code ((~ [_ (#.Int var)])))])) + (not (variableL.captured? var)) + (n/= input-register (variableL.local-register var))) inputS - (^ (list [(^code ("lux case bind" (~ [_ (#;Nat register)]))) bodyA])) - (let$ (if (functionS;nested? arity) - (n.+ (n.dec arity) register) + (^ (list [(^code ("lux case bind" (~ [_ (#.Nat register)]))) bodyA])) + (let$ (if (functionS.nested? arity) + (n/+ (n/dec arity) register) register) inputS - (synthesize (n.inc num-locals) bodyA)) + (synthesize (n/inc num-locals) bodyA)) (^or (^ (list [(^code true) thenA] [(^code false) elseA])) (^ (list [(^code false) elseA] [(^code true) thenA]))) (if$ inputS (synthesize num-locals thenA) (synthesize num-locals elseA)) - (#;Cons [lastP lastA] prevsPA) - (let [transform-branch (: (-> la;Pattern la;Analysis ls;Path) - (caseS;path arity num-locals synthesize)) - pathS (list/fold caseS;weave + (#.Cons [lastP lastA] prevsPA) + (let [transform-branch (: (-> la.Pattern la.Analysis ls.Path) + (caseS.path arity num-locals synthesize)) + pathS (list/fold caseS.weave (transform-branch lastP lastA) - (list/map (product;uncurry transform-branch) prevsPA))] + (list/map (product.uncurry transform-branch) prevsPA))] (` ("lux case" (~ inputS) (~ pathS)))) _ @@ -95,17 +95,17 @@ ))) (def: (synthesize-apply synthesize num-locals exprA) - (-> (-> la;Analysis ls;Synthesis) Nat la;Analysis ls;Synthesis) - (let [[funcA argsA] (functionS;unfold-apply exprA) + (-> (-> la.Analysis ls.Synthesis) Nat la.Analysis ls.Synthesis) + (let [[funcA argsA] (functionS.unfold-apply exprA) funcS (synthesize funcA) argsS (list/map synthesize argsA)] (case funcS - (^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)] - (~ (loopS;adjust _env num-locals _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)] + (~ (loopS.adjust _env num-locals _bodyS)))) (^code ("lux call" (~ funcS') (~@ argsS'))) (call$ funcS' (list/compose argsS' argsS)) @@ -114,7 +114,7 @@ (call$ funcS argsS)))) (def: #export (synthesize expressionA) - (-> la;Analysis ls;Synthesis) + (-> la.Analysis ls.Synthesis) (loop [arity +0 resolver init-resolver direct? false @@ -123,63 +123,63 @@ (case expressionA (^code [(~ _left) (~ _right)]) (` [(~@ (list/map (recur arity resolver false num-locals) - (la;unfold-tuple expressionA)))]) + (la.unfold-tuple expressionA)))]) (^or (^code ("lux sum left" (~ _))) (^code ("lux sum right" (~ _)))) - (let [[tag last? value] (maybe;assume (la;unfold-variant expressionA))] + (let [[tag last? value] (maybe.assume (la.unfold-variant expressionA))] (variant$ tag last? (recur arity resolver false num-locals value))) - (^code ((~ [_ (#;Int var)]))) - (if (variableL;local? var) - (if (functionS;nested? arity) - (if (variableL;self? var) - (call$ (var$ 0) (|> (list;n.range +1 (n.dec arity)) - (list/map (|>. variableL;local code;int (~) () (`))))) - (var$ (functionS;adjust-var arity var))) + (^code ((~ [_ (#.Int var)]))) + (if (variableL.local? var) + (if (functionS.nested? arity) + (if (variableL.self? var) + (call$ (var$ 0) (|> (list.n/range +1 (n/dec arity)) + (list/map (|>> variableL.local code.int (~) () (`))))) + (var$ (functionS.adjust-var arity var))) (var$ var)) - (var$ (maybe;default var (dict;get var resolver)))) + (var$ (maybe.default var (dict.get var resolver)))) - (^code ("lux case" (~ inputA) (~ [_ (#;Record branchesA)]))) + (^code ("lux case" (~ inputA) (~ [_ (#.Record branchesA)]))) (synthesize-case arity num-locals (recur arity resolver false) inputA branchesA) (^multi (^code ("lux function" [(~@ scope)] (~ bodyA))) - [(s;run scope (p;some s;int)) (#e;Success raw-env)]) + [(s.run scope (p.some s.int)) (#e.Success raw-env)]) (let [function-arity (if direct? - (n.inc arity) + (n/inc arity) +1) env (list/map (function [closure] - (case (dict;get closure resolver) - (#;Some resolved) - (if (and (variableL;local? resolved) - (functionS;nested? arity) - (|> resolved variableL;local-register (n.>= arity))) - (functionS;adjust-var arity resolved) + (case (dict.get closure resolver) + (#.Some resolved) + (if (and (variableL.local? resolved) + (functionS.nested? arity) + (|> resolved variableL.local-register (n/>= arity))) + (functionS.adjust-var arity resolved) resolved) - #;None - (if (and (variableL;local? closure) - (functionS;nested? arity)) - (functionS;adjust-var arity closure) + #.None + (if (and (variableL.local? closure) + (functionS.nested? arity)) + (functionS.adjust-var arity closure) closure))) raw-env) env-vars (: (List Variable) (case raw-env - #;Nil (list) - _ (|> (list;size raw-env) n.dec (list;n.range +0) (list/map variableL;captured)))) - resolver' (if (and (functionS;nested? function-arity) + #.Nil (list) + _ (|> (list.size raw-env) n/dec (list.n/range +0) (list/map variableL.captured)))) + resolver' (if (and (functionS.nested? function-arity) direct?) (list/fold (function [[from to] resolver'] - (dict;put from to resolver')) + (dict.put from to resolver')) init-resolver - (list;zip2 env-vars env)) + (list.zip2 env-vars env)) (list/fold (function [var resolver'] - (dict;put var var resolver')) + (dict.put var var resolver')) init-resolver env-vars))] (case (recur function-arity resolver' true function-arity bodyA) - (^ [_ (#;Form (list [_ (#;Text "lux function")] [_ (#;Nat unmerged-arity)] env' bodyS'))]) - (let [merged-arity (n.inc unmerged-arity)] + (^ [_ (#.Form (list [_ (#.Text "lux function")] [_ (#.Nat unmerged-arity)] env' bodyS'))]) + (let [merged-arity (n/inc unmerged-arity)] (function$ merged-arity env (prepare-body function-arity merged-arity bodyS'))) @@ -189,7 +189,7 @@ (^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/function.lux b/new-luxc/source/luxc/lang/synthesis/function.lux index 52aee9a49..25dd75aff 100644 --- a/new-luxc/source/luxc/lang/synthesis/function.lux +++ b/new-luxc/source/luxc/lang/synthesis/function.lux @@ -1,29 +1,29 @@ -(;module: +(.module: lux (luxc (lang ["la" analysis] ["ls" synthesis] - [";L" variable #+ Variable]))) + [".L" variable #+ Variable]))) (do-template [<name> <comp> <ref>] [(def: #export (<name> arity) - (-> ls;Arity Bool) + (-> ls.Arity Bool) (<comp> <ref> arity))] - [nested? n.> +1] - [top? n.= +0] + [nested? n/> +1] + [top? n/= +0] ) (def: #export (adjust-var outer var) - (-> ls;Arity Variable Variable) - (|> outer n.dec nat-to-int (i.+ var))) + (-> ls.Arity Variable Variable) + (|> outer n/dec nat-to-int (i/+ var))) (def: #export (unfold-apply apply) - (-> la;Analysis [la;Analysis (List la;Analysis)]) + (-> la.Analysis [la.Analysis (List la.Analysis)]) (loop [apply apply args (list)] (case apply (^code ("lux apply" (~ arg) (~ func))) - (recur func (#;Cons arg args)) + (recur func (#.Cons arg args)) _ [apply args]))) diff --git a/new-luxc/source/luxc/lang/synthesis/loop.lux b/new-luxc/source/luxc/lang/synthesis/loop.lux index a5da743d5..0510e2377 100644 --- a/new-luxc/source/luxc/lang/synthesis/loop.lux +++ b/new-luxc/source/luxc/lang/synthesis/loop.lux @@ -1,4 +1,4 @@ -(;module: +(.module: lux (lux (control [monad #+ do] ["p" parser]) @@ -7,101 +7,101 @@ (macro [code] [syntax])) (luxc (lang ["ls" synthesis] - [";L" variable #+ Variable Register]))) + [".L" variable #+ Variable Register]))) (def: #export (contains-self-reference? exprS) - (-> ls;Synthesis Bool) + (-> ls.Synthesis Bool) (case exprS - (^ [_ (#;Form (list [_ (#;Nat tag)] [_ (#;Bool last?)] memberS))]) + (^ [_ (#.Form (list [_ (#.Nat tag)] [_ (#.Bool last?)] memberS))]) (contains-self-reference? memberS) - [_ (#;Tuple membersS)] - (list;any? contains-self-reference? membersS) + [_ (#.Tuple membersS)] + (list.any? contains-self-reference? membersS) - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (variableL;self? var) + (^ [_ (#.Form (list [_ (#.Int var)]))]) + (variableL.self? var) - (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))]) (or (contains-self-reference? inputS) (loop [pathS pathS] (case pathS - (^or (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))]) - (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))])) + (^or (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))])) (or (recur leftS) (recur rightS)) - (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))]) (contains-self-reference? bodyS) _ false))) - (^ [_ (#;Form (list [_ (#;Text "lux function")] arity [_ (#;Tuple environment)] bodyS))]) - (list;any? (function [captured] + (^ [_ (#.Form (list [_ (#.Text "lux function")] arity [_ (#.Tuple environment)] bodyS))]) + (list.any? (function [captured] (case captured - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (variableL;self? var) + (^ [_ (#.Form (list [_ (#.Int var)]))]) + (variableL.self? var) _ false)) environment) - (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))]) + (^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))]) (or (contains-self-reference? funcS) - (list;any? contains-self-reference? argsS)) + (list.any? contains-self-reference? argsS)) - (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))]) + (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))]) (or (contains-self-reference? inputS) (contains-self-reference? bodyS)) - (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) + (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) (or (contains-self-reference? inputS) (contains-self-reference? thenS) (contains-self-reference? elseS)) - (^ [_ (#;Form (list [_ (#;Text "lux loop")] offset [_ (#;Tuple initsS)] bodyS))]) - (or (list;any? contains-self-reference? initsS) + (^ [_ (#.Form (list [_ (#.Text "lux loop")] offset [_ (#.Tuple initsS)] bodyS))]) + (or (list.any? contains-self-reference? initsS) (contains-self-reference? bodyS)) - (^or (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))]) - (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))])) - (list;any? contains-self-reference? argsS) + (^or (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))]) + (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))])) + (list.any? contains-self-reference? argsS) _ false )) (def: #export (reify-recursion arity exprS) - (-> Nat ls;Synthesis ls;Synthesis) + (-> Nat ls.Synthesis ls.Synthesis) (loop [exprS exprS] (case exprS - (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case")] inputS pathS))]) (` ("lux case" (~ inputS) (~ (let [reify-recursion' recur] (loop [pathS pathS] (case pathS - (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftS rightS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftS rightS))]) (` ("lux case alt" (~ (recur leftS)) (~ (recur rightS)))) - (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftS rightS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftS rightS))]) (` ("lux case seq" (~ leftS) (~ (recur rightS)))) - (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))]) (` ("lux case exec" (~ (reify-recursion' bodyS)))) _ pathS)))))) - (^multi (^ [_ (#;Form (list& [_ (#;Text "lux call")] - [_ (#;Form (list [_ (#;Int 0)]))] + (^multi (^ [_ (#.Form (list& [_ (#.Text "lux call")] + [_ (#.Form (list [_ (#.Int 0)]))] argsS))]) - (n.= arity (list;size argsS))) + (n/= arity (list.size argsS))) (` ("lux recur" (~@ argsS))) - (^ [_ (#;Form (list [_ (#;Text "lux let")] register inputS bodyS))]) + (^ [_ (#.Form (list [_ (#.Text "lux let")] register inputS bodyS))]) (` ("lux let" (~ register) (~ inputS) (~ (recur bodyS)))) - (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) + (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) (` ("lux if" (~ inputS) (~ (recur thenS)) (~ (recur elseS)))) _ @@ -109,15 +109,15 @@ ))) (def: #export (adjust env offset exprS) - (-> (List Variable) Register ls;Synthesis ls;Synthesis) + (-> (List Variable) Register ls.Synthesis ls.Synthesis) (let [resolve-captured (: (-> Variable Variable) (function [var] - (let [idx (|> var (i.* -1) int-to-nat n.dec)] - (|> env (list;nth idx) maybe;assume))))] + (let [idx (|> var (i/* -1) int-to-nat n/dec)] + (|> env (list.nth idx) maybe.assume))))] (loop [exprS exprS] (case exprS - (^code ((~ [_ (#;Nat tag)]) (~ last?) (~ valueS))) - (` ((~ (code;nat tag)) (~ last?) (~ (recur valueS)))) + (^code ((~ [_ (#.Nat tag)]) (~ last?) (~ valueS))) + (` ((~ (code.nat tag)) (~ last?) (~ (recur valueS)))) (^code [(~@ members)]) (` [(~@ (list/map recur members))]) @@ -128,15 +128,15 @@ (loop [pathS pathS] (case pathS (^template [<pattern>] - (^ [_ (#;Form (list [_ (#;Text <pattern>)] leftS rightS))]) + (^ [_ (#.Form (list [_ (#.Text <pattern>)] leftS rightS))]) (` (<pattern> (~ (recur leftS)) (~ (recur rightS))))) (["lux case alt"] ["lux case seq"]) - (^code ("lux case bind" (~ [_ (#;Nat register)]))) - (` ("lux case bind" (~ (code;nat (n.+ offset register))))) + (^code ("lux case bind" (~ [_ (#.Nat register)]))) + (` ("lux case bind" (~ (code.nat (n/+ offset register))))) - (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))]) + (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))]) (` ("lux case exec" (~ (adjust' bodyS)))) _ @@ -146,42 +146,42 @@ (` ("lux function" (~ arity) [(~@ (list/map (function [_var] (case _var - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (` ((~ (code;int (resolve-captured var))))) + (^ [_ (#.Form (list [_ (#.Int var)]))]) + (` ((~ (code.int (resolve-captured var))))) _ _var)) environment))] (~ bodyS))) - (^ [_ (#;Form (list& [_ (#;Text "lux call")] funcS argsS))]) + (^ [_ (#.Form (list& [_ (#.Text "lux call")] funcS argsS))]) (` ("lux call" (~ (recur funcS)) (~@ (list/map recur argsS)))) - (^ [_ (#;Form (list& [_ (#;Text "lux recur")] argsS))]) + (^ [_ (#.Form (list& [_ (#.Text "lux recur")] argsS))]) (` ("lux recur" (~@ (list/map recur argsS)))) - (^code ("lux let" (~ [_ (#;Nat register)]) (~ inputS) (~ bodyS))) - (` ("lux let" (~ (code;nat (n.+ offset register))) + (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ bodyS))) + (` ("lux let" (~ (code.nat (n/+ offset register))) (~ (recur inputS)) (~ (recur bodyS)))) - (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) + (^ [_ (#.Form (list [_ (#.Text "lux if")] inputS thenS elseS))]) (` ("lux if" (~ (recur inputS)) (~ (recur thenS)) (~ (recur elseS)))) - (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat loop-offset)] [_ (#;Tuple initsS)] bodyS))]) - (` ("lux loop" (~ (code;nat (n.+ offset loop-offset))) + (^ [_ (#.Form (list [_ (#.Text "lux loop")] [_ (#.Nat loop-offset)] [_ (#.Tuple initsS)] bodyS))]) + (` ("lux loop" (~ (code.nat (n/+ offset loop-offset))) [(~@ (list/map recur initsS))] (~ (recur bodyS)))) - (^ [_ (#;Form (list [_ (#;Int var)]))]) - (if (variableL;captured? var) - (` ((~ (code;int (resolve-captured var))))) - (` ((~ (code;int (|> offset nat-to-int (i.+ var))))))) + (^ [_ (#.Form (list [_ (#.Int var)]))]) + (if (variableL.captured? var) + (` ((~ (code.int (resolve-captured var))))) + (` ((~ (code.int (|> offset nat-to-int (i/+ var))))))) - (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]) - (` ((~ (code;text procedure)) (~@ (list/map recur argsS)))) + (^ [_ (#.Form (list& [_ (#.Text procedure)] argsS))]) + (` ((~ (code.text procedure)) (~@ (list/map recur argsS)))) _ exprS diff --git a/new-luxc/source/luxc/lang/synthesis/variable.lux b/new-luxc/source/luxc/lang/synthesis/variable.lux index 3ce9f2678..b1988018d 100644 --- a/new-luxc/source/luxc/lang/synthesis/variable.lux +++ b/new-luxc/source/luxc/lang/synthesis/variable.lux @@ -1,96 +1,96 @@ -(;module: +(.module: lux (lux (data [number] (coll [list "list/" Fold<List> Monoid<List>] ["s" set]))) (luxc (lang ["la" analysis] ["ls" synthesis] - [";L" variable #+ Variable]))) + [".L" variable #+ Variable]))) (def: (bound-vars path) - (-> ls;Path (List Variable)) + (-> ls.Path (List Variable)) (case path - (#ls;BindP register) + (#ls.BindP register) (list (nat-to-int register)) - (^or (#ls;SeqP pre post) (#ls;AltP pre post)) + (^or (#ls.SeqP pre post) (#ls.AltP pre post)) (list/compose (bound-vars pre) (bound-vars post)) _ (list))) (def: (path-bodies path) - (-> ls;Path (List ls;Synthesis)) + (-> ls.Path (List ls.Synthesis)) (case path - (#ls;ExecP body) + (#ls.ExecP body) (list body) - (#ls;SeqP pre post) + (#ls.SeqP pre post) (path-bodies post) - (#ls;AltP pre post) + (#ls.AltP pre post) (list/compose (path-bodies pre) (path-bodies post)) _ (list))) (def: (non-arg? arity var) - (-> ls;Arity Variable Bool) - (and (variableL;local? var) - (n.> arity (int-to-nat var)))) + (-> ls.Arity Variable Bool) + (and (variableL.local? var) + (n/> arity (int-to-nat var)))) -(type: Tracker (s;Set Variable)) +(type: Tracker (s.Set Variable)) -(def: init-tracker Tracker (s;new number;Hash<Int>)) +(def: init-tracker Tracker (s.new number.Hash<Int>)) (def: (unused-vars current-arity bound exprS) - (-> ls;Arity (List Variable) ls;Synthesis (List Variable)) + (-> ls.Arity (List Variable) ls.Synthesis (List Variable)) (let [tracker (loop [exprS exprS - tracker (list/fold s;add init-tracker bound)] + tracker (list/fold s.add init-tracker bound)] (case exprS - (#ls;Variable var) + (#ls.Variable var) (if (non-arg? current-arity var) - (s;remove var tracker) + (s.remove var tracker) tracker) - (#ls;Variant tag last? memberS) + (#ls.Variant tag last? memberS) (recur memberS tracker) - (#ls;Tuple membersS) + (#ls.Tuple membersS) (list/fold recur tracker membersS) - (#ls;Call funcS argsS) + (#ls.Call funcS argsS) (list/fold recur (recur funcS tracker) argsS) - (^or (#ls;Recur argsS) - (#ls;Procedure name argsS)) + (^or (#ls.Recur argsS) + (#ls.Procedure name argsS)) (list/fold recur tracker argsS) - (#ls;Let offset inputS outputS) + (#ls.Let offset inputS outputS) (|> tracker (recur inputS) (recur outputS)) - (#ls;If testS thenS elseS) + (#ls.If testS thenS elseS) (|> tracker (recur testS) (recur thenS) (recur elseS)) - (#ls;Loop offset initsS bodyS) + (#ls.Loop offset initsS bodyS) (recur bodyS (list/fold recur tracker initsS)) - (#ls;Case inputS outputPS) - (let [tracker' (list/fold s;add + (#ls.Case inputS outputPS) + (let [tracker' (list/fold s.add (recur inputS tracker) (bound-vars outputPS))] (list/fold recur tracker' (path-bodies outputPS))) - (#ls;Function arity env bodyS) - (list/fold s;remove tracker env) + (#ls.Function arity env bodyS) + (list/fold s.remove tracker env) _ tracker ))] - (s;to-list tracker))) + (s.to-list tracker))) ## (def: (optimize-register-use current-arity [pathS bodyS]) -## (-> ls;Arity [ls;Path ls;Synthesis] [ls;Path ls;Synthesis]) +## (-> ls.Arity [ls.Path ls.Synthesis] [ls.Path ls.Synthesis]) ## (let [bound (bound-vars pathS) ## unused (unused-vars current-arity bound bodyS) ## adjusted (adjust-vars unused bound)] |