Constant folding optimization - sources

4 files changed, 65 insertions, 43 deletions

diff --git a/source/mod_student/constant_folding.ml b/source/mod_student/constant_folding.ml
new file mode 100644
index 0000000..3bebcfa
--- /dev/null
+++ b/source/mod_student/constant_folding.ml
@@ -0,0 +1,31 @@
+open Xi_lib
+open Ir
+
+module Make(T:Iface.COMPILER_TOOLBOX) = struct
+
+  module Implementation(M:sig
+    val cfg : ControlFlowGraph.t 
+    val proc : procedure
+   end) = struct
+
+    open M
+
+    let cfa = T.ConstantFoldingAnalysis.analyse proc
+
+    let rewrite () = 
+      Logger.extra_debug begin fun () ->
+        Logger.dump_constant_folding "before-optimization" cfg cfa;
+      end;
+      failwith "not yet implemeneted"
+
+  end
+
+
+  let fold_constants proc = 
+    let module Instance = Implementation(struct
+      let proc = proc
+      let cfg = cfg_of_procedure proc
+    end) in
+    Instance.rewrite ()
+
+end
\ No newline at end of file
diff --git a/source/mod_student/constant_folding_analysis.ml b/source/mod_student/constant_folding_analysis.ml
new file mode 100644
index 0000000..40419cc
--- /dev/null
+++ b/source/mod_student/constant_folding_analysis.ml
@@ -0,0 +1,31 @@
+open Xi_lib
+open Ir
+open Ir_utils
+
+module Make() = struct
+
+  module Implementation(M:sig
+      val cfg: ControlFlowGraph.t
+      val initial: Analysis_domain.ConstantFolding.domain
+    end) = struct
+
+    open M
+
+    let analyse () = 
+      failwith "not yet implemented"
+  end
+
+
+
+  (* Skontruuj wartość ekstremalną *)
+  let make_initial n =
+    failwith "not yet implemented"
+
+  let analyse proc : Xi_lib.Analysis_domain.ConstantFolding.table =
+    let initial = make_initial @@ Ir.formal_parameters_of_procedure proc in
+    let cfg = Ir.cfg_of_procedure proc in
+    let module Instance = Implementation(struct let cfg = cfg let initial = initial end) in 
+    let result = Instance.analyse () in
+    result
+
+end
\ No newline at end of file
diff --git a/source/xi/xi.ml b/source/xi/xi.ml
index b064be6..1d57d99 100644
--- a/source/xi/xi.ml
+++ b/source/xi/xi.ml
@@ -72,7 +72,7 @@ module CommandLine = struct
 
   let cmd =
     let doc = "Compile Xi Program" in
-    let version = "pracownia5-0-geed1995" in
+    let version = "pracownia6-0-g5bf290f" in
     Term.(const compile $ xi_log $ extra_debug $ mod_uwr $ plugin $ reg_descr $ stop_after $ output $ source_file),
     Term.info "xi" ~doc ~version
 
diff --git a/source/xi_lib/analysis_domain.ml b/source/xi_lib/analysis_domain.ml
index 420f509..dba7167 100644
--- a/source/xi_lib/analysis_domain.ml
+++ b/source/xi_lib/analysis_domain.ml
@@ -1,44 +1,4 @@
 
-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 =
@@ -97,7 +57,7 @@ end
 
 module ConstantFolding = struct
 
-  type domain = Ir.expr option Ir.RegMap.t
+  type domain = Int32.t option Ir.RegMap.t
 
   type table = domain Analysis.BlockKnowledge.table
 
@@ -105,7 +65,7 @@ module ConstantFolding = struct
 
   let string_of_el = function
     | None -> "T"
-    | Some a -> Ir_utils.string_of_expr a
+    | Some a -> Int32.to_string a
 
   let string_of_domain dom =
     let f (k,v) = Format.sprintf "%s=%s" (Ir_utils.string_of_reg k) (string_of_el v) in