summary refs log tree commit diff
path: root/source/xi_lib/analysis_domain.ml
blob: 9f49a3ead2087ea1dca53f3a50ee60e8ebf934d1 (plain) (blame)
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
module MapWithTop(M:Map.S) = struct

  type 'v t =
    | Top
    | Map of 'v M.t

  let equal a b = match a,b with
    | Top, Top ->
      true
    | Top, _
    | _, Top ->
      false
    | Map a, Map b ->
      M.equal (=) a b

  let less_or_equal a b = match a,b with
    | _, Top ->
      true

    | Top, _ ->
      false

    | Map a, Map b ->
      let check (k, v) = 
        match M.find_opt k b with
        | Some v' -> v = v'
        | None -> false
      in
      let a_items = M.to_seq a in
      let checks = Seq.map check a_items in
      Seq.fold_left (&&) true checks

  let greater_or_equal a b = less_or_equal b a

  let unhask dfl = function 
    | Top -> dfl
    | Map m -> m

end

module SetWithTop(M:Set.S) = struct

  type t =
    | Top
    | Set of M.t

  let equal a b = match a,b with
    | Top, Top ->
      true
    | Top, _
    | _, Top ->
      false
    | Set a, Set b ->
      M.equal a b

  let less_or_equal a b = match a,b with
    | _, Top ->
      true

    | Top, _ ->
      false

    | Set a, Set b ->
      M.subset a b

  let greater_or_equal a b = less_or_equal b a

  let unhask dfl = function 
    | Top -> dfl
    | Set m -> m

end


module LiveVariables = struct

  type domain = Ir.RegSet.t

  type table = domain Analysis.BlockKnowledge.table

  type block_knowledge = domain Analysis.BlockKnowledge.t

  let string_of_domain x = Ir_utils.string_of_reglist @@ List.of_seq @@ Ir.RegSet.to_seq x
end

module InterferenceGraph = struct

  type graph = Ir.RegGraph.t

end

module ConstantFolding = struct

  type domain = Ir.expr option Ir.RegMap.t

  type table = domain Analysis.BlockKnowledge.table

  type block_knowledge = domain Analysis.BlockKnowledge.t

  let string_of_el = function
    | None -> "T"
    | Some a -> Ir_utils.string_of_expr a

  let string_of_domain dom =
    let f (k,v) = Format.sprintf "%s=%s" (Ir.string_of_reg k) (string_of_el v) in
    let seq = Ir.RegMap.to_seq dom in
    let seq = Seq.map f seq in
    String.concat " " @@ List.of_seq seq

end

module DominatorsAnalysis = struct

  module D = SetWithTop(Ir.LabelSet)

  type t = D.t

  type table = t Analysis.BlockKnowledge.table

  let unhask = D.unhask Ir.LabelSet.empty

end

module NaturalLoops = struct

  type table = (Ir.label, Ir.LabelSet.t) Hashtbl.t

end

module ReachabilityAnalysis = struct

  type table = Ir.LabelSet.t Analysis.BlockKnowledge.table

end