blob: 927ec84e316d4c8ea2e1f0e26746ea998333124c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(.module:
lux
(lux (data [library
[number]]
(coll [list "list/" Mix<List> Monoid<List>]
["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<Int>))
(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)]))
|
