(.module: lux (lux (data [library [number]] (coll [list "list/" Mix Monoid] ["s" set]))) (luxc (lang ["la" analysis] ["ls" synthesis] ["[0]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/composite (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/composite (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/mix s.has init-tracker bound)] (case exprS {#ls.Variable var} (if (non-arg? current-arity var) (s.lacks var tracker) tracker) {#ls.Variant tag last? memberS} (recur memberS tracker) {#ls.Tuple membersS} (list/mix recur tracker membersS) {#ls.Call funcS argsS} (list/mix recur (recur funcS tracker) argsS) (^or {#ls.Recur argsS} {#ls.Procedure name argsS}) (list/mix 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/mix recur tracker initsS)) {#ls.Case inputS outputPS} (let [tracker' (list/mix s.has (recur inputS tracker) (bound-vars outputPS))] (list/mix recur tracker' (path-bodies outputPS))) {#ls.Function arity env bodyS} (list/mix s.lacks 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)]))