From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 30 May 2020 15:19:28 -0400 Subject: Split new-luxc into lux-jvm and lux-r. --- lux-jvm/source/luxc/lang/synthesis/variable.lux | 98 +++++++++++++++++++++++++ 1 file changed, 98 insertions(+) create mode 100644 lux-jvm/source/luxc/lang/synthesis/variable.lux (limited to 'lux-jvm/source/luxc/lang/synthesis/variable.lux') diff --git a/lux-jvm/source/luxc/lang/synthesis/variable.lux b/lux-jvm/source/luxc/lang/synthesis/variable.lux new file mode 100644 index 000000000..f6a45b02e --- /dev/null +++ b/lux-jvm/source/luxc/lang/synthesis/variable.lux @@ -0,0 +1,98 @@ +(.module: + lux + (lux (data [number] + (coll [list "list/" Fold Monoid] + ["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 (.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 Bit) + (and (variableL.local? var) + (n/> arity (.nat var)))) + +(type: Tracker (s.Set Variable)) + +(def: init-tracker Tracker (s.new number.Hash)) + +(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)])) -- cgit v1.2.3