summary refs log tree commit diff
path: root/source/mod_student/constant_folding.ml
blob: bad5f80cf4c23bc5b9f3d7c596d242c67bee53af (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
open Xi_lib
open Ir
open Ir_utils
   

module Make(T:Iface.COMPILER_TOOLBOX) = struct

  module Implementation(M:sig
    val cfg : ControlFlowGraph.t 
    val proc : procedure
   end) = struct

    open M
       open Analysis

    let cfa = T.ConstantFoldingAnalysis.analyse proc

    let rewrite_instr (knwl,instr)=
      let knwl = Knowledge.pre knwl in
      let knwl = Ir.RegMap.fold (fun key v m ->
                     match v with
                     |None -> m
                     |Some v -> Ir.RegMap.add key (E_Int v) m) knwl Ir.RegMap.empty in
      subst_expr_instr knwl instr
    let rewrite_label l =
      if l = (ControlFlowGraph.entry_label cfg) || l = (ControlFlowGraph.exit_label cfg) then ()
      else
        match Hashtbl.find cfa l with
        |Simple _ -> ()
        |Complex {body;_} -> ControlFlowGraph.set_block cfg l (List.map rewrite_instr body)
      
            
    let rewrite () = 
      Logger.extra_debug begin fun () ->
        Logger.dump_constant_folding "before-optimization" cfg cfa;
        end;
      let labels = ControlFlowGraph.labels cfg in
      List.iter rewrite_label labels
      
  end


  let fold_constants proc = 
    let module Instance = Implementation(struct
      let proc = proc
      let cfg = cfg_of_procedure proc
    end) in
    Instance.rewrite ()

end