Commits

Paweł Wieczorek committed d1915d2

implemented BetaContraction

  • Participants
  • Parent commits 3669e4b

Comments (0)

Files changed (3)

src/Analysis/CWCPS/CWCPS_VariableUsageAnalysis.ml

     module Type = struct
 
         type t =
-            BoundBy_FixDef of label * variable * variable list * expression
+            BoundBy_FixDef of label * variable list * expression
 
         let equal (a : t) b = a = b
 
     let __analyze = function
         | EXPR_Fix (reclabel, definitions, in_expr) ->
             let f (deflabel, defname, defargs, defbody) =
-                (defname, BoundBy_FixDef (deflabel, defname, defargs, defbody))
+                (defname, BoundBy_FixDef (deflabel, defargs, defbody))
                 in
 
             List.map f definitions
 (*************************************************************************************************
  ************************************************************************************************)
 
+include Combined
+
 let analyze = Combined.analyze
 
 
             Util.print_words_ln [ "-"; "transform BetaContraction" ];
             let res = CWCPS_BetaContraction.bottomup res in
             CWCPS_driver.pretty_expr res;
+            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
+            let res = CWCPS_RemoveDeadCode.bottomup res in
+            CWCPS_driver.pretty_expr res;
+            let res = CWCPS_BetaContraction.bottomup res in
+            CWCPS_driver.pretty_expr res;
+            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
+            let res = CWCPS_RemoveDeadCode.bottomup res in
+            CWCPS_driver.pretty_expr res;
+            let res = CWCPS_BetaContraction.bottomup res in
+            CWCPS_driver.pretty_expr res;
+            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
+            let res = CWCPS_RemoveDeadCode.bottomup res in
+            CWCPS_driver.pretty_expr res;
+            let res = CWCPS_BetaContraction.bottomup res in
+            CWCPS_driver.pretty_expr res;
+            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
+            let res = CWCPS_RemoveDeadCode.bottomup res in
+            CWCPS_driver.pretty_expr res;
+            Util.print_words_ln [ "-"; "transform ConstantFolding" ];
+            let res = CWCPS_ConstantFolding.topdown res in
+            CWCPS_driver.pretty_expr res;
+            Util.print_words_ln [ "-"; "transform RemoveDeadCode" ];
+            let res = CWCPS_RemoveDeadCode.bottomup res in
+            CWCPS_driver.pretty_expr res;
             ()
         with
             | Parsing.Parse_error ->

src/Transformation/CWCPS/CWCPS_BetaContraction.ml

 open CWCPS_AST
 open CWCPS_Transformation
 open Batteries
+open CWCPS_VariableUsageAnalysis
 
 (*************************************************************************************************
  * Unused definitions
 
 module BetaContraction = struct
 
+    let try_beta_reduction fname actual_args = function
+        | Some (BoundByAnalysis.BoundBy_FixDef (_, formal_args, body)) ->
+            Formatter.print_document
+                [ Formatter.Word "beta"
+                ; Formatter.Var fname
+                ];
+            let sb = List.combine formal_args actual_args in
+            Transformation.Replace (subst sb body)
+            
+        | _ ->
+            Transformation.NoChange
+
     let transformation variable_usage = function
+        | EXPR_App (label, VEXPR_Variable fname, actual_args)
+          when variable_usage.usage_count fname = 1 && variable_usage.known fname ->
+            Formatter.print_document
+                [ Formatter.Word "check"
+                ; Formatter.Var fname
+                ];
+            let bby = variable_usage.bound_by fname in
+            try_beta_reduction fname actual_args bby
 
-        (* optimalize unused fixs *)
-            
         | _ ->
             Transformation.NoChange
 end