diff options
author | Eduardo Julian | 2017-07-02 15:52:36 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-07-02 15:52:36 -0400 |
commit | c0acd75d41ed0e927ec318d4b12c0ec4f5f2e1d3 (patch) | |
tree | 2dce468eaee847cfb6ab51cd21b7bebffb3b2478 /new-luxc/source/luxc/synthesizer/variable.lux | |
parent | 38d5f05977c54770195129df5ede2c91be4a32af (diff) |
- Adjusted compiler to the new lack of Char type.
- WIP: PM/case synthesis.
Diffstat (limited to 'new-luxc/source/luxc/synthesizer/variable.lux')
-rw-r--r-- | new-luxc/source/luxc/synthesizer/variable.lux | 100 |
1 files changed, 100 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/synthesizer/variable.lux b/new-luxc/source/luxc/synthesizer/variable.lux new file mode 100644 index 000000000..3a48cb3f2 --- /dev/null +++ b/new-luxc/source/luxc/synthesizer/variable.lux @@ -0,0 +1,100 @@ +(;module: + lux + (lux (data [bool "B/" Eq<Bool>] + [text "T/" Eq<Text>] + [number] + (coll [list "L/" Functor<List> Fold<List> Monoid<List>] + ["s" set]))) + (luxc (lang ["la" analysis] + ["ls" synthesis]) + (synthesizer ["&;" function]))) + +(def: (bound-vars path) + (-> ls;Path (List ls;Variable)) + (case path + (#ls;BindP register) + (list (nat-to-int register)) + + (^or (#ls;SeqP pre post) (#ls;AltP pre post)) + (L/append (bound-vars pre) (bound-vars post)) + + _ + (list))) + +(def: (path-bodies path) + (-> ls;Path (List ls;Synthesis)) + (case path + (#ls;ExecP body) + (list body) + + (#ls;SeqP pre post) + (path-bodies post) + + (#ls;AltP pre post) + (L/append (path-bodies pre) (path-bodies post)) + + _ + (list))) + +(def: (non-arg? arity var) + (-> ls;Arity ls;Variable Bool) + (and (&function;local? var) + (n.> arity (int-to-nat var)))) + +(type: Tracker (s;Set ls;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)) + (let [tracker (loop [exprS exprS + tracker (L/fold s;add init-tracker bound)] + (case exprS + (#ls;Variable var) + (if (non-arg? current-arity var) + (s;remove var tracker) + tracker) + + (#ls;Variant tag last? memberS) + (recur memberS tracker) + + (#ls;Tuple membersS) + (L/fold recur tracker membersS) + + (#ls;Call funcS argsS) + (L/fold recur (recur funcS tracker) argsS) + + (^or (#ls;Recur argsS) + (#ls;Procedure name argsS)) + (L/fold recur tracker argsS) + + (#ls;Let offset inputS outputS) + (|> tracker (recur inputS) (recur outputS)) + + (#ls;If testS thenS elseS) + (|> tracker (recur testS) (recur thenS) (recur elseS)) + + (#ls;Loop offset initsS bodyS) + (recur bodyS (L/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))) + + (#ls;Function arity env bodyS) + (L/fold s;remove tracker env) + + _ + tracker + ))] + (s;to-list tracker))) + +## (def: (optimize-register-use current-arity [pathS bodyS]) +## (-> 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)] +## [(|> pathS (clean-pattern adjusted) simplify-pattern) +## (clean-expression adjusted bodyS)])) |