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
|
signature CPS_TREEIFY = sig
datatype treeify = TREEIFY | COMPUTE | DEAD
val usage : CPS.function list -> (CPS.lvar -> treeify)
end
structure CpsNoTreeify : CPS_TREEIFY =
struct
datatype treeify = TREEIFY | COMPUTE | DEAD
val usage = fn _ => fn _ => COMPUTE
end
structure CpsTreeify : CPS_TREEIFY =
struct
structure C = CPS
datatype treeify = TREEIFY | COMPUTE | DEAD
fun error msg = ErrorMsg.impossible ("FPStack." ^ msg)
fun usage fl = let
(* Table to record number of uses *)
exception UseCntTbl
val useCntTbl : treeify Intmap.intmap = Intmap.new(32, UseCntTbl)
val uses = Intmap.mapWithDefault (useCntTbl,DEAD)
val addCntTbl = Intmap.add useCntTbl
fun addUse v =
case uses v
of DEAD => addCntTbl(v, TREEIFY)
| TREEIFY => addCntTbl(v, COMPUTE)
| _ => ()
fun addValue(C.VAR v) = addUse v
| addValue _ = ()
fun addValues [] = ()
| addValues(C.VAR v::vl) = (addUse v; addValues vl)
| addValues(_::vl) = addValues vl
fun cntUsesCps(C.RECORD(_, vl, w, e)) =
(addValues (map #1 vl); cntUsesCps e)
| cntUsesCps(C.SELECT(i, v, x, _, e)) = (addValue v; cntUsesCps e)
| cntUsesCps(C.OFFSET(i, v, x, e)) = (addValue v; cntUsesCps e)
| cntUsesCps(C.APP(v, vl)) = (addValue v; addValues vl)
| cntUsesCps(C.FIX _) = error "pass1: FIX"
| cntUsesCps(C.SWITCH(v, _, el)) = (addValue v; app cntUsesCps el)
| cntUsesCps(C.BRANCH(_, vl, _, c1, c2)) =
(addValues vl; cntUsesCps c1; cntUsesCps c2)
| cntUsesCps(C.SETTER(_, vl, e)) = (addValues vl; cntUsesCps e)
| cntUsesCps(C.LOOKER(looker, vl, x, _, e)) =
(addValues vl;
(* floating subscript cannot move past a floating update.
* For now subscript operations cannot be treeified.
* This is hacked by making it (falsely) used more than once.
*)
case looker
of C.P.numsubscript{kind=C.P.FLOAT _} => (addUse x; addUse x)
| _ => ()
(*esac*);
cntUsesCps e)
| cntUsesCps(C.ARITH(_, vl, _, _, e)) = (addValues vl; cntUsesCps e)
| cntUsesCps(C.PURE(_, vl, _, _, e)) = (addValues vl; cntUsesCps e)
in
app (fn (_, _, _, _, e) => cntUsesCps e) fl;
uses
end
end
|
