diff options
Diffstat (limited to 'new-luxc/source/luxc/synthesizer')
| -rw-r--r-- | new-luxc/source/luxc/synthesizer/case.lux | 27 | ||||
| -rw-r--r-- | new-luxc/source/luxc/synthesizer/function.lux | 43 | ||||
| -rw-r--r-- | new-luxc/source/luxc/synthesizer/loop.lux | 14 | ||||
| -rw-r--r-- | new-luxc/source/luxc/synthesizer/structure.lux | 28 | ||||
| -rw-r--r-- | new-luxc/source/luxc/synthesizer/variable.lux | 44 |
5 files changed, 40 insertions, 116 deletions
diff --git a/new-luxc/source/luxc/synthesizer/case.lux b/new-luxc/source/luxc/synthesizer/case.lux index 91f339bdf..15cb6eca3 100644 --- a/new-luxc/source/luxc/synthesizer/case.lux +++ b/new-luxc/source/luxc/synthesizer/case.lux @@ -6,26 +6,12 @@ (coll [list "list/" Fold<List>])) (meta [code "code/" Eq<Code>])) (luxc (lang ["la" analysis] - ["ls" synthesis]) - (synthesizer ["&;" function]))) + ["ls" synthesis]))) (def: #export (path pattern) (-> la;Pattern ls;Path) (case pattern - (#la;BindP register) - (` ("lux case bind" (~ (code;nat register)))) - - (^template [<from> <to>] - (<from> value) - (<to> value)) - ([#la;BoolP code;bool] - [#la;NatP code;nat] - [#la;IntP code;int] - [#la;DegP code;deg] - [#la;FracP code;frac] - [#la;TextP code;text]) - - (#la;TupleP membersP) + (^code [(~@ membersP)]) (case (list;reverse membersP) #;Nil (' ("lux case pop")) @@ -45,11 +31,14 @@ (` ("lux case tuple right" (~ (code;nat last-idx)) (~ (path lastP))))] prevsP)] tuple-path)) - - (#la;VariantP tag num-tags memberP) + + (^code ((~ [_ (#;Nat tag)]) (~ [_ (#;Nat num-tags)]) (~ memberP))) (if (n.= (n.dec num-tags) tag) (` ("lux case variant right" (~ (code;nat tag)) (~ (path memberP)))) - (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP))))))) + (` ("lux case variant left" (~ (code;nat tag)) (~ (path memberP))))) + + _ + pattern)) (def: #export (weave leftP rightP) (-> ls;Path ls;Path ls;Path) diff --git a/new-luxc/source/luxc/synthesizer/function.lux b/new-luxc/source/luxc/synthesizer/function.lux index 4d9970a3f..52aee9a49 100644 --- a/new-luxc/source/luxc/synthesizer/function.lux +++ b/new-luxc/source/luxc/synthesizer/function.lux @@ -1,31 +1,8 @@ (;module: lux - (lux (data (coll [list "list/" Functor<List>]))) (luxc (lang ["la" analysis] - ["ls" synthesis]))) - -(def: #export (environment scope) - (-> Scope (List ls;Variable)) - (|> scope - (get@ [#;captured #;mappings]) - (list/map (function [[_ _ ref]] - (case ref - (#;Local idx) - (nat-to-int idx) - - (#;Captured idx) - (|> idx n.inc nat-to-int (i.* -1)) - ))))) - -(do-template [<name> <comp>] - [(def: #export (<name> var) - (-> ls;Variable Bool) - (<comp> 0 var))] - - [self? i.=] - [local? i.>] - [captured? i.<] - ) + ["ls" synthesis] + [";L" variable #+ Variable]))) (do-template [<name> <comp> <ref>] [(def: #export (<name> arity) @@ -37,27 +14,15 @@ ) (def: #export (adjust-var outer var) - (-> ls;Arity ls;Variable ls;Variable) + (-> ls;Arity Variable Variable) (|> outer n.dec nat-to-int (i.+ var))) -(def: #export (to-captured idx) - (-> Nat Int) - (|> idx n.inc nat-to-int (i.* -1))) - -(def: #export (captured-idx idx) - (-> Int Nat) - (|> idx (i.* -1) int-to-nat n.dec)) - -(def: #export (to-local idx) - (-> Nat Int) - (nat-to-int idx)) - (def: #export (unfold-apply apply) (-> la;Analysis [la;Analysis (List la;Analysis)]) (loop [apply apply args (list)] (case apply - (#la;Apply arg func) + (^code ("lux apply" (~ arg) (~ func))) (recur func (#;Cons arg args)) _ diff --git a/new-luxc/source/luxc/synthesizer/loop.lux b/new-luxc/source/luxc/synthesizer/loop.lux index 8599db981..0070fcd5d 100644 --- a/new-luxc/source/luxc/synthesizer/loop.lux +++ b/new-luxc/source/luxc/synthesizer/loop.lux @@ -6,8 +6,8 @@ (coll [list "list/" Functor<List>])) (meta [code] [syntax])) - (luxc (lang ["ls" synthesis]) - (synthesizer ["&&;" function]))) + (luxc (lang ["ls" synthesis] + [";L" variable #+ Variable Register]))) (def: #export (contains-self-reference? exprS) (-> ls;Synthesis Bool) @@ -19,7 +19,7 @@ (list;any? contains-self-reference? membersS) (^ [_ (#;Form (list [_ (#;Int var)]))]) - (&&function;self? var) + (variableL;self? var) (^ [_ (#;Form (list [_ (#;Text "lux case")] inputS pathS))]) (or (contains-self-reference? inputS) @@ -40,7 +40,7 @@ (list;any? (function [captured] (case captured (^ [_ (#;Form (list [_ (#;Int var)]))]) - (&&function;self? var) + (variableL;self? var) _ false)) @@ -109,8 +109,8 @@ ))) (def: #export (adjust env outer-offset exprS) - (-> (List ls;Variable) ls;Register ls;Synthesis ls;Synthesis) - (let [resolve-captured (: (-> ls;Variable ls;Variable) + (-> (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))))] @@ -161,7 +161,7 @@ (` ((~ (code;text procedure)) (~@ (list/map recur argsS)))) (^ [_ (#;Form (list [_ (#;Int var)]))]) - (if (&&function;captured? var) + (if (variableL;captured? var) (` ((~ (code;int (resolve-captured var))))) (` ((~ (code;int (|> outer-offset nat-to-int (i.+ var))))))) diff --git a/new-luxc/source/luxc/synthesizer/structure.lux b/new-luxc/source/luxc/synthesizer/structure.lux deleted file mode 100644 index 403817c53..000000000 --- a/new-luxc/source/luxc/synthesizer/structure.lux +++ /dev/null @@ -1,28 +0,0 @@ -(;module: - lux - (luxc (lang ["la" analysis]))) - -(def: #export (unfold-tuple tuple) - (-> la;Analysis (List la;Analysis)) - (case tuple - (#la;Product left right) - (#;Cons left (unfold-tuple right)) - - _ - (list tuple))) - -(def: #export (unfold-variant variant) - (-> (Either la;Analysis la;Analysis) [Nat Bool la;Analysis]) - (loop [so-far +0 - variantA variant] - (case variantA - (#;Left valueA) - (case valueA - (#la;Sum choice) - (recur (n.inc so-far) choice) - - _ - [so-far false valueA]) - - (#;Right valueA) - [(n.inc so-far) true valueA]))) diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux index 01ad101fa..3ce9f2678 100644 --- a/new-luxc/source/luxc/synthesizer/variable.lux +++ b/new-luxc/source/luxc/synthesizer/variable.lux @@ -1,22 +1,20 @@ (;module: lux - (lux (data [bool "B/" Eq<Bool>] - [text "T/" Eq<Text>] - [number] - (coll [list "L/" Functor<List> Fold<List> Monoid<List>] + (lux (data [number] + (coll [list "list/" Fold<List> Monoid<List>] ["s" set]))) (luxc (lang ["la" analysis] - ["ls" synthesis]) - (synthesizer ["&;" function]))) + ["ls" synthesis] + [";L" variable #+ Variable]))) (def: (bound-vars path) - (-> ls;Path (List ls;Variable)) + (-> ls;Path (List Variable)) (case path (#ls;BindP register) (list (nat-to-int register)) (^or (#ls;SeqP pre post) (#ls;AltP pre post)) - (L/compose (bound-vars pre) (bound-vars post)) + (list/compose (bound-vars pre) (bound-vars post)) _ (list))) @@ -31,24 +29,24 @@ (path-bodies post) (#ls;AltP pre post) - (L/compose (path-bodies pre) (path-bodies post)) + (list/compose (path-bodies pre) (path-bodies post)) _ (list))) (def: (non-arg? arity var) - (-> ls;Arity ls;Variable Bool) - (and (&function;local? var) + (-> ls;Arity Variable Bool) + (and (variableL;local? var) (n.> arity (int-to-nat var)))) -(type: Tracker (s;Set ls;Variable)) +(type: Tracker (s;Set Variable)) (def: init-tracker Tracker (s;new number;Hash<Int>)) (def: (unused-vars current-arity bound exprS) - (-> ls;Arity (List ls;Variable) ls;Synthesis (List ls;Variable)) + (-> ls;Arity (List Variable) ls;Synthesis (List Variable)) (let [tracker (loop [exprS exprS - tracker (L/fold s;add init-tracker bound)] + tracker (list/fold s;add init-tracker bound)] (case exprS (#ls;Variable var) (if (non-arg? current-arity var) @@ -59,14 +57,14 @@ (recur memberS tracker) (#ls;Tuple membersS) - (L/fold recur tracker membersS) + (list/fold recur tracker membersS) (#ls;Call funcS argsS) - (L/fold recur (recur funcS tracker) argsS) + (list/fold recur (recur funcS tracker) argsS) (^or (#ls;Recur argsS) (#ls;Procedure name argsS)) - (L/fold recur tracker argsS) + (list/fold recur tracker argsS) (#ls;Let offset inputS outputS) (|> tracker (recur inputS) (recur outputS)) @@ -75,16 +73,16 @@ (|> tracker (recur testS) (recur thenS) (recur elseS)) (#ls;Loop offset initsS bodyS) - (recur bodyS (L/fold recur tracker initsS)) + (recur bodyS (list/fold recur tracker initsS)) (#ls;Case inputS outputPS) - (let [tracker' (L/fold s;add - (recur inputS tracker) - (bound-vars outputPS))] - (L/fold recur tracker' (path-bodies 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) - (L/fold s;remove tracker env) + (list/fold s;remove tracker env) _ tracker |