(.using 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} (again memberS tracker) {ls.#Tuple membersS} (list/mix again tracker membersS) {ls.#Call funcS argsS} (list/mix again (again funcS tracker) argsS) (^or {ls.#Again argsS} {ls.#Procedure name argsS}) (list/mix again tracker argsS) {ls.#Let offset inputS outputS} (|> tracker (again inputS) (again outputS)) {ls.#If testS thenS elseS} (|> tracker (again testS) (again thenS) (again elseS)) {ls.#Loop offset initsS bodyS} (again bodyS (list/mix again tracker initsS)) {ls.#Case inputS outputPS} (let [tracker' (list/mix s.has (again inputS tracker) (bound-vars outputPS))] (list/mix again 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)]))