blob: 3ce9f26782756497fd1d82f6dd632ec658079358 (
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
|
(;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)]))
|
