diff options
author | Eduardo Julian | 2017-11-01 00:04:43 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-01 00:04:43 -0400 |
commit | 71d7a4c7206155e09f3e1e1d8699561ea6967382 (patch) | |
tree | 866b104d1552fe71ff52b0241f7e2fd260ff77bf /new-luxc/source/luxc/lang/synthesis/variable.lux | |
parent | 7cc935bd3d2e716bfeb006badeeaa8bb05927d11 (diff) |
- Re-organized synthesis.
Diffstat (limited to 'new-luxc/source/luxc/lang/synthesis/variable.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/synthesis/variable.lux | 98 |
1 files changed, 98 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/synthesis/variable.lux b/new-luxc/source/luxc/lang/synthesis/variable.lux new file mode 100644 index 000000000..3ce9f2678 --- /dev/null +++ b/new-luxc/source/luxc/lang/synthesis/variable.lux @@ -0,0 +1,98 @@ +(;module: + lux + (lux (data [number] + (coll [list "list/" Fold<List> Monoid<List>] + ["s" set]))) + (luxc (lang ["la" analysis] + ["ls" synthesis] + [";L" variable #+ Variable]))) + +(def: (bound-vars path) + (-> ls;Path (List Variable)) + (case path + (#ls;BindP register) + (list (nat-to-int register)) + + (^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)) + (case path + (#ls;ExecP body) + (list body) + + (#ls;SeqP pre post) + (path-bodies 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)))) + +(type: Tracker (s;Set Variable)) + +(def: init-tracker Tracker (s;new number;Hash<Int>)) + +(def: (unused-vars current-arity bound exprS) + (-> ls;Arity (List Variable) ls;Synthesis (List Variable)) + (let [tracker (loop [exprS exprS + tracker (list/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) + (list/fold recur tracker membersS) + + (#ls;Call funcS argsS) + (list/fold recur (recur funcS tracker) argsS) + + (^or (#ls;Recur argsS) + (#ls;Procedure name argsS)) + (list/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 (list/fold recur tracker initsS)) + + (#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) + + _ + 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)])) |