Commits

Paweł Wieczorek  committed a042bfd

cleaning in module names

  • Participants
  • Parent commits 2ac488c
  • Branches basic_tests_infastructure

Comments (0)

Files changed (11)

 open Command
 open Batteries
 open MiniML_to_CWCPS
-open CWCPS_ConstantFolding
-open CWCPS_RemoveDeadCode
-open CWCPS_BetaContraction
-open CWCPS_EtaReduction
+open CWCPS_ConstantFoldingOptimization
+open CWCPS_RemoveDeadCodeOptimization
+open CWCPS_BetaContractionOptimization
+open CWCPS_EtaConversionTransformation
 open CWCPS_ConditionalJumpsOptimization
 open CWCPS_RecordUsageOptimization
-open CWCPS_UncurryFunctions
+open CWCPS_UncurryFunctionsTransformation
 open Algebra_Monoid
 open Enumerators
 

File src/Transformation/CWCPS/CWCPS_BetaContraction.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-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)) ->
-            let sb = List.combine formal_args actual_args in
-            Replace (subst sb body)
-            
-        | _ ->
-            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 ->
-            let bby = variable_usage.bound_by fname in
-            try_beta_reduction fname actual_args bby
-
-        | _ ->
-            NoChange
-end
-
-(*************************************************************************************************
- * 
- ************************************************************************************************)
-
-let bottomup_transformations = 
-    [ BetaContraction.transformation
-    ]
-
-let transform = bottomups_with_analysis
-    CWCPS_VariableUsageAnalysis.analyze
-    bottomup_transformations 
-

File src/Transformation/CWCPS/CWCPS_BetaContractionOptimization.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+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)) ->
+            let sb = List.combine formal_args actual_args in
+            Replace (subst sb body)
+            
+        | _ ->
+            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 ->
+            let bby = variable_usage.bound_by fname in
+            try_beta_reduction fname actual_args bby
+
+        | _ ->
+            NoChange
+end
+
+(*************************************************************************************************
+ * 
+ ************************************************************************************************)
+
+let bottomup_transformations = 
+    [ BetaContraction.transformation
+    ]
+
+let transform = bottomups_with_analysis
+    CWCPS_VariableUsageAnalysis.analyze
+    bottomup_transformations 
+

File src/Transformation/CWCPS/CWCPS_ConstantFolding.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open CWCPS_AST
-open CWCPS_Transformation
-open Batteries
-
-(*************************************************************************************************
- * Arithmetic Simplifier
- ************************************************************************************************)
-
-module ArithmeticSimplifier = struct
-
-    let substitute_vexpr result i = Substitute [ (result, i) ]
-
-    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
-
-
-    let transform_binary = function
-
-        (* compute *)
-
-        | (PRIMOP_Add, VEXPR_Integer a, VEXPR_Integer b, result) ->
-            substitute_int result (a+b)
-
-        | (PRIMOP_Sub, VEXPR_Integer a, VEXPR_Integer b, result) ->
-            substitute_int result (a-b)
-
-        | (PRIMOP_Mul, VEXPR_Integer a, VEXPR_Integer b, result) ->
-            substitute_int result (a*b)
-
-        | (PRIMOP_Div, VEXPR_Integer a, VEXPR_Integer b, result) when b <> 0 ->
-            substitute_int result (a/b)
-
-        | (PRIMOP_Mod, VEXPR_Integer a, VEXPR_Integer b, result) when b <> 0 ->
-            substitute_int result (a mod b)
-
-        (* zeros and ones *)
-
-        | (PRIMOP_Add, a, VEXPR_Integer 0, result) 
-        | (PRIMOP_Add, VEXPR_Integer 0, a, result) ->
-            substitute_vexpr result a
-
-        | (PRIMOP_Mul, a, VEXPR_Integer 1, result) 
-        | (PRIMOP_Mul, VEXPR_Integer 1, a, result) ->
-            substitute_vexpr result a
-
-        | (PRIMOP_Mul, a, VEXPR_Integer 0, result) 
-        | (PRIMOP_Mul, VEXPR_Integer 0, a, result) ->
-            substitute_int result 0
-
-        | (PRIMOP_Div, a, VEXPR_Integer 1, result) ->
-            substitute_vexpr result a
-
-        | (PRIMOP_Mod, a, VEXPR_Integer 1, result) ->
-            substitute_int result 0
-
-        (* other *)
-
-        | _ ->
-            NoChange
-
-    let transform_node = function
-        | EXPR_ArithmeticBinaryPrimOp (label, primop, arg1, arg2, result, in_expr) ->
-            transform_binary (primop, arg1, arg2, result)
-
-        | EXPR_ArithmeticUnaryPrimOp (label, primop, arg, result, branch) ->
-            NoChange
-
-        | _ ->
-            NoChange
-
-
-    let transform_expression = topdown transform_node
-
-end
-
-(*************************************************************************************************
- * Bitwise Arithmetic Simplifier
- ************************************************************************************************)
-
-module BitwiseArithmeticSimplifier = struct
-
-    let substitute_vexpr result i = Substitute [ (result, i) ]
-
-    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
-
-
-    let transform_binary = function
-
-        (* compute *)
-
-        | (PRIMOP_And, VEXPR_Integer a, VEXPR_Integer b, result) ->
-            substitute_int result (a land b)
-
-        | (PRIMOP_Or, VEXPR_Integer a, VEXPR_Integer b, result) ->
-            substitute_int result (a lor b)
-
-        | (PRIMOP_Xor, VEXPR_Integer a, VEXPR_Integer b, result) ->
-            substitute_int result (a lxor b)
-
-        (* zeros and ones *)
-
-        | (PRIMOP_And, a, VEXPR_Integer 0, result) 
-        | (PRIMOP_And, VEXPR_Integer 0, a, result) ->
-            substitute_vexpr result a
-
-        | (PRIMOP_Or, a, VEXPR_Integer 0, result) 
-        | (PRIMOP_Or, VEXPR_Integer 0, a, result) ->
-            substitute_vexpr result a
-
-        | (PRIMOP_Xor, a, VEXPR_Integer 0, result) 
-        | (PRIMOP_Xor, VEXPR_Integer 0, a, result) ->
-            substitute_vexpr result a
-
-        (* other *)
-
-        | _ ->
-            NoChange
-
-    let transform_node = function
-        | EXPR_ArithmeticBinaryPrimOp (label, primop, arg1, arg2, result, in_expr) ->
-            transform_binary (primop, arg1, arg2, result)
-
-        | EXPR_ArithmeticUnaryPrimOp (label, primop, arg, result, branch) ->
-            NoChange
-
-        | _ ->
-            NoChange
-
-
-    let transform_expression = topdown transform_node
-
-end
-
-(*************************************************************************************************
- * Bitwise Arithmetic Simplifier
- ************************************************************************************************)
-
-module ConditionSimplifier = struct
-
-    let substitute_vexpr result i = Substitute [ (result, i) ]
-
-    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
-
-    let transform_condition = function
-        | (primop, VEXPR_Integer a, VEXPR_Integer b, then_branch, else_branch) ->
-            if eval_condition_primitive_operation primop a b
-            then Replace then_branch
-            else Replace else_branch
-
-        | _ ->
-            NoChange
-
-    let transform_node = function
-        | EXPR_ConditionPrimOp (label, primop, val1, val2, then_branch, else_branch) ->
-            transform_condition (primop, val1, val2, then_branch, else_branch)
-
-        | _ ->
-            NoChange
-
-    let transform_expression = topdown transform_node
-
-end
-
-(*************************************************************************************************
- * Switch Simplifier
- ************************************************************************************************)
-
-module SwitchSimplifier = struct
-
-    let substitute_vexpr result i = Substitute [ (result, i) ]
-
-    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
-
-    let transform_node = function
-        | EXPR_Switch (label, VEXPR_Integer sel, default_branch, branches) ->
-            begin try
-                Replace (List.nth branches sel)
-            with Failure "nth" ->
-                Replace default_branch
-            end
-
-        | _ ->
-            NoChange
-
-
-    let transform_expression = topdown transform_node
-
-end
-
-(*************************************************************************************************
- * Constant folding
- ************************************************************************************************)
-
-let topdown_transformations = 
-    [ ArithmeticSimplifier.transform_node
-    ; BitwiseArithmeticSimplifier.transform_node
-    ; SwitchSimplifier.transform_node
-    ]
-
-let transform = topdowns topdown_transformations 
-
-

File src/Transformation/CWCPS/CWCPS_ConstantFoldingOptimization.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open CWCPS_AST
+open CWCPS_Transformation
+open Batteries
+
+(*************************************************************************************************
+ * Arithmetic Simplifier
+ ************************************************************************************************)
+
+module ArithmeticSimplifier = struct
+
+    let substitute_vexpr result i = Substitute [ (result, i) ]
+
+    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
+
+
+    let transform_binary = function
+
+        (* compute *)
+
+        | (PRIMOP_Add, VEXPR_Integer a, VEXPR_Integer b, result) ->
+            substitute_int result (a+b)
+
+        | (PRIMOP_Sub, VEXPR_Integer a, VEXPR_Integer b, result) ->
+            substitute_int result (a-b)
+
+        | (PRIMOP_Mul, VEXPR_Integer a, VEXPR_Integer b, result) ->
+            substitute_int result (a*b)
+
+        | (PRIMOP_Div, VEXPR_Integer a, VEXPR_Integer b, result) when b <> 0 ->
+            substitute_int result (a/b)
+
+        | (PRIMOP_Mod, VEXPR_Integer a, VEXPR_Integer b, result) when b <> 0 ->
+            substitute_int result (a mod b)
+
+        (* zeros and ones *)
+
+        | (PRIMOP_Add, a, VEXPR_Integer 0, result) 
+        | (PRIMOP_Add, VEXPR_Integer 0, a, result) ->
+            substitute_vexpr result a
+
+        | (PRIMOP_Mul, a, VEXPR_Integer 1, result) 
+        | (PRIMOP_Mul, VEXPR_Integer 1, a, result) ->
+            substitute_vexpr result a
+
+        | (PRIMOP_Mul, a, VEXPR_Integer 0, result) 
+        | (PRIMOP_Mul, VEXPR_Integer 0, a, result) ->
+            substitute_int result 0
+
+        | (PRIMOP_Div, a, VEXPR_Integer 1, result) ->
+            substitute_vexpr result a
+
+        | (PRIMOP_Mod, a, VEXPR_Integer 1, result) ->
+            substitute_int result 0
+
+        (* other *)
+
+        | _ ->
+            NoChange
+
+    let transform_node = function
+        | EXPR_ArithmeticBinaryPrimOp (label, primop, arg1, arg2, result, in_expr) ->
+            transform_binary (primop, arg1, arg2, result)
+
+        | EXPR_ArithmeticUnaryPrimOp (label, primop, arg, result, branch) ->
+            NoChange
+
+        | _ ->
+            NoChange
+
+
+    let transform_expression = topdown transform_node
+
+end
+
+(*************************************************************************************************
+ * Bitwise Arithmetic Simplifier
+ ************************************************************************************************)
+
+module BitwiseArithmeticSimplifier = struct
+
+    let substitute_vexpr result i = Substitute [ (result, i) ]
+
+    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
+
+
+    let transform_binary = function
+
+        (* compute *)
+
+        | (PRIMOP_And, VEXPR_Integer a, VEXPR_Integer b, result) ->
+            substitute_int result (a land b)
+
+        | (PRIMOP_Or, VEXPR_Integer a, VEXPR_Integer b, result) ->
+            substitute_int result (a lor b)
+
+        | (PRIMOP_Xor, VEXPR_Integer a, VEXPR_Integer b, result) ->
+            substitute_int result (a lxor b)
+
+        (* zeros and ones *)
+
+        | (PRIMOP_And, a, VEXPR_Integer 0, result) 
+        | (PRIMOP_And, VEXPR_Integer 0, a, result) ->
+            substitute_vexpr result a
+
+        | (PRIMOP_Or, a, VEXPR_Integer 0, result) 
+        | (PRIMOP_Or, VEXPR_Integer 0, a, result) ->
+            substitute_vexpr result a
+
+        | (PRIMOP_Xor, a, VEXPR_Integer 0, result) 
+        | (PRIMOP_Xor, VEXPR_Integer 0, a, result) ->
+            substitute_vexpr result a
+
+        (* other *)
+
+        | _ ->
+            NoChange
+
+    let transform_node = function
+        | EXPR_ArithmeticBinaryPrimOp (label, primop, arg1, arg2, result, in_expr) ->
+            transform_binary (primop, arg1, arg2, result)
+
+        | EXPR_ArithmeticUnaryPrimOp (label, primop, arg, result, branch) ->
+            NoChange
+
+        | _ ->
+            NoChange
+
+
+    let transform_expression = topdown transform_node
+
+end
+
+(*************************************************************************************************
+ * Bitwise Arithmetic Simplifier
+ ************************************************************************************************)
+
+module ConditionSimplifier = struct
+
+    let substitute_vexpr result i = Substitute [ (result, i) ]
+
+    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
+
+    let transform_condition = function
+        | (primop, VEXPR_Integer a, VEXPR_Integer b, then_branch, else_branch) ->
+            if eval_condition_primitive_operation primop a b
+            then Replace then_branch
+            else Replace else_branch
+
+        | _ ->
+            NoChange
+
+    let transform_node = function
+        | EXPR_ConditionPrimOp (label, primop, val1, val2, then_branch, else_branch) ->
+            transform_condition (primop, val1, val2, then_branch, else_branch)
+
+        | _ ->
+            NoChange
+
+    let transform_expression = topdown transform_node
+
+end
+
+(*************************************************************************************************
+ * Switch Simplifier
+ ************************************************************************************************)
+
+module SwitchSimplifier = struct
+
+    let substitute_vexpr result i = Substitute [ (result, i) ]
+
+    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
+
+    let transform_node = function
+        | EXPR_Switch (label, VEXPR_Integer sel, default_branch, branches) ->
+            begin try
+                Replace (List.nth branches sel)
+            with Failure "nth" ->
+                Replace default_branch
+            end
+
+        | _ ->
+            NoChange
+
+
+    let transform_expression = topdown transform_node
+
+end
+
+(*************************************************************************************************
+ * Constant folding
+ ************************************************************************************************)
+
+let topdown_transformations = 
+    [ ArithmeticSimplifier.transform_node
+    ; BitwiseArithmeticSimplifier.transform_node
+    ; SwitchSimplifier.transform_node
+    ]
+
+let transform = topdowns topdown_transformations 
+
+

File src/Transformation/CWCPS/CWCPS_EtaConversionTransformation.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open CWCPS_AST
+open CWCPS_Transformation
+open Batteries
+
+(*************************************************************************************************
+ * Unused definitions
+ ************************************************************************************************)
+
+module EtaReduction = struct
+
+    let transform_definition sb (deflabel, defname, defargs, inexpr) =
+        let expected_args = List.map (fun v -> VEXPR_Variable v) defargs in
+        match inexpr with
+            | EXPR_App (_, (VEXPR_Variable _ as fname'), actual_args)
+            | EXPR_App (_, (VEXPR_TopContinuation _ as fname'), actual_args) 
+              when expected_args = actual_args ->
+                (defname, fname') :: sb
+
+            | _ -> 
+                sb
+
+    let transform_node = function
+        | EXPR_Fix (reclabel, definitions, in_expr) ->
+            let sb = List.fold_left transform_definition [] definitions in
+            Substitute sb
+
+        | _ ->
+            NoChange
+
+end
+
+(*************************************************************************************************
+ * 
+ ************************************************************************************************)
+
+let topdown_transformations = 
+    [ EtaReduction.transform_node
+    ]
+
+let transform = topdowns
+        topdown_transformations 
+

File src/Transformation/CWCPS/CWCPS_EtaReduction.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open CWCPS_AST
-open CWCPS_Transformation
-open Batteries
-
-(*************************************************************************************************
- * Unused definitions
- ************************************************************************************************)
-
-module EtaReduction = struct
-
-    let transform_definition sb (deflabel, defname, defargs, inexpr) =
-        let expected_args = List.map (fun v -> VEXPR_Variable v) defargs in
-        match inexpr with
-            | EXPR_App (_, (VEXPR_Variable _ as fname'), actual_args)
-            | EXPR_App (_, (VEXPR_TopContinuation _ as fname'), actual_args) 
-              when expected_args = actual_args ->
-                (defname, fname') :: sb
-
-            | _ -> 
-                sb
-
-    let transform_node = function
-        | EXPR_Fix (reclabel, definitions, in_expr) ->
-            let sb = List.fold_left transform_definition [] definitions in
-            Substitute sb
-
-        | _ ->
-            NoChange
-
-end
-
-(*************************************************************************************************
- * 
- ************************************************************************************************)
-
-let topdown_transformations = 
-    [ EtaReduction.transform_node
-    ]
-
-let transform = topdowns
-        topdown_transformations 
-

File src/Transformation/CWCPS/CWCPS_RemoveDeadCode.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open CWCPS_AST
-open CWCPS_Transformation
-open Batteries
-
-(*************************************************************************************************
- * Unused definitions
- ************************************************************************************************)
-
-module UnusedDefinitions = struct
-
-    let substitute_vexpr result i = Substitute [ (result, i) ]
-
-    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
-
-    let is_var_used usage_count var = usage_count var > 0
-
-    let try_remove_definition usage_count var in_expr =
-        if is_var_used usage_count var
-        then NoChange 
-        else Replace in_expr
-
-    let transform_node usage_count = function
-
-        (* optimalize unused fixs *)
-
-        | EXPR_Fix (reclabel, [], in_expr) ->
-            Replace in_expr
-
-        | EXPR_Fix (reclabel, definitions, in_expr) ->
-            let definitions' = List.filter (is_var_used usage_count  -| get_name_from_fixdef) definitions in
-            begin match definitions' with
-            | [] ->
-                Replace in_expr
-
-            | _ ->
-                if List.length definitions = List.length definitions'
-                then NoChange
-                else Replace (EXPR_Fix (reclabel, definitions', in_expr))
-            end
-
-        (* unused result of arithmetic operations *)
-
-        | EXPR_ArithmeticBinaryPrimOp (_, _, _, _, result, in_expr) 
-        | EXPR_ArithmeticUnaryPrimOp (_, _, _, result, in_expr) 
-        | EXPR_Select(_, _, _, result, in_expr)
-        | EXPR_Offset(_, _, _, result, in_expr)
-        | EXPR_Record(_, _, result, in_expr) ->
-            try_remove_definition usage_count result in_expr 
-
-            
-        | _ ->
-            NoChange
-end
-
-(*************************************************************************************************
- * 
- ************************************************************************************************)
-
-let bottomup_transformations = 
-    [ UnusedDefinitions.transform_node
-    ]
-
-let transform = bottomups_with_analysis
-        CWCPS_VariableUsageAnalysis.UsageCountingAnalysis.analyze
-        bottomup_transformations 
-

File src/Transformation/CWCPS/CWCPS_RemoveDeadCodeOptimization.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open CWCPS_AST
+open CWCPS_Transformation
+open Batteries
+
+(*************************************************************************************************
+ * Unused definitions
+ ************************************************************************************************)
+
+module UnusedDefinitions = struct
+
+    let substitute_vexpr result i = Substitute [ (result, i) ]
+
+    let substitute_int result i   = substitute_vexpr result (VEXPR_Integer i)
+
+    let is_var_used usage_count var = usage_count var > 0
+
+    let try_remove_definition usage_count var in_expr =
+        if is_var_used usage_count var
+        then NoChange 
+        else Replace in_expr
+
+    let transform_node usage_count = function
+
+        (* optimalize unused fixs *)
+
+        | EXPR_Fix (reclabel, [], in_expr) ->
+            Replace in_expr
+
+        | EXPR_Fix (reclabel, definitions, in_expr) ->
+            let definitions' = List.filter (is_var_used usage_count  -| get_name_from_fixdef) definitions in
+            begin match definitions' with
+            | [] ->
+                Replace in_expr
+
+            | _ ->
+                if List.length definitions = List.length definitions'
+                then NoChange
+                else Replace (EXPR_Fix (reclabel, definitions', in_expr))
+            end
+
+        (* unused result of arithmetic operations *)
+
+        | EXPR_ArithmeticBinaryPrimOp (_, _, _, _, result, in_expr) 
+        | EXPR_ArithmeticUnaryPrimOp (_, _, _, result, in_expr) 
+        | EXPR_Select(_, _, _, result, in_expr)
+        | EXPR_Offset(_, _, _, result, in_expr)
+        | EXPR_Record(_, _, result, in_expr) ->
+            try_remove_definition usage_count result in_expr 
+
+            
+        | _ ->
+            NoChange
+end
+
+(*************************************************************************************************
+ * 
+ ************************************************************************************************)
+
+let bottomup_transformations = 
+    [ UnusedDefinitions.transform_node
+    ]
+
+let transform = bottomups_with_analysis
+        CWCPS_VariableUsageAnalysis.UsageCountingAnalysis.analyze
+        bottomup_transformations 
+

File src/Transformation/CWCPS/CWCPS_UncurryFunctions.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open CWCPS_AST
-open CWCPS_Transformation
-open Batteries
-open Enumerators
-
-(*************************************************************************************************
- * Fetching Reducer
- ************************************************************************************************)
-
-module UncurryFunctions = struct
-    open CWCPS_VariableUsageAnalysis.BoundByAnalysis
-
-    (*
-     * let
-     *      fix f x1 ... xn c = 
-     *          let
-     *              fix g y1 ... yn = body in
-     *              and <<nested_defs>>
-     *              in
-     *          g c
-     *      and <<defs>>
-     * in program
-     *
-     * is transformed into
-     *
-     * let
-     *      fix f x1 ... xn c =
-     *          let fix g y1 ... yn = f' x1 ... xn c g y1 ... yn in
-     *          c g
-     *
-     *      and f' x1 ... xn c g y1 ... yn =
-     *          let fix <<nested_defs>> in
-     *          body
-     *      and <<defs>>
-     *
-     * in program
-     *)
-
-    let construct_forwarder variable_enumerator f f_args g g_args c =
-        let f_args' = List.map (fun _ -> get_next_variable_from_enumerator variable_enumerator) f_args in
-        let g_args' = List.map (fun _ -> get_next_variable_from_enumerator variable_enumerator) g_args in
-        let f'      = get_next_variable_from_enumerator variable_enumerator in
-        let g'      = get_next_variable_from_enumerator variable_enumerator in
-
-        let definition_of_g' =
-            ( get_new_label ()
-            , g'
-            , g_args'
-            , EXPR_App (get_new_label (), VEXPR_Variable f', 
-                        List.map (fun s -> VEXPR_Variable s) (f_args' @ [g'] @ g_args'))
-            ) in
-
-        raise Exit
-
-    let uncurry_definition variable_enumerator = function
-        | (definition_label, definition_name, definition_formal_arguments,
-                EXPR_Fix (subreclabel, nested_definitions,
-                    EXPR_App (app_label, VEXPR_Variable called_function, [VEXPR_Variable passed_function])))
-          when List.mem called_function definition_formal_arguments ->
-
-            begin try
-
-                let is_definition_of_called_function (_, name, _, _) = name = passed_function in
-
-                let (_, _, passed_function_formal_arguments, passed_function_body) =
-                    List.find is_definition_of_called_function nested_definitions
-                    in
-
-                let forwarder = construct_forwarder variable_enumerator
-                    definition_name definition_formal_arguments
-                    passed_function passed_function_formal_arguments
-                    called_function
-                    in
-
-                [forwarder]
-            with Not_found ->
-                []
-            end
-
-        | def ->
-            [def]
-
-    let construct_fix label definitions in_expr new_definitions = 
-        if definitions = new_definitions
-        then NoChange
-        else Replace (EXPR_Fix(label, new_definitions, in_expr))
-
-    let transform_node variable_enumerator = function
-        | EXPR_Fix(reclabel, definitions, in_expr) ->
-            definitions
-            |> List.map (uncurry_definition variable_enumerator)
-            |> List.concat
-            |> construct_fix reclabel definitions in_expr
-
-        | _ ->
-            NoChange
-
-end
-
-(*************************************************************************************************
- * Constant folding
- ************************************************************************************************)
-
-let topdown_transformations = 
-    [ UncurryFunctions.transform_node
-    ]
-
-let transform = 
-    topdowns_with_dummy_variable_enumerator topdown_transformations
-

File src/Transformation/CWCPS/CWCPS_UncurryFunctionsTransformation.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open CWCPS_AST
+open CWCPS_Transformation
+open Batteries
+open Enumerators
+
+(*************************************************************************************************
+ * Fetching Reducer
+ ************************************************************************************************)
+
+module UncurryFunctions = struct
+    open CWCPS_VariableUsageAnalysis.BoundByAnalysis
+
+    (*
+     * let
+     *      fix f x1 ... xn c = 
+     *          let
+     *              fix g y1 ... yn = body in
+     *              and <<nested_defs>>
+     *              in
+     *          g c
+     *      and <<defs>>
+     * in program
+     *
+     * is transformed into
+     *
+     * let
+     *      fix f x1 ... xn c =
+     *          let fix g y1 ... yn = f' x1 ... xn c g y1 ... yn in
+     *          c g
+     *
+     *      and f' x1 ... xn c g y1 ... yn =
+     *          let fix <<nested_defs>> in
+     *          body
+     *      and <<defs>>
+     *
+     * in program
+     *)
+
+    let construct_forwarder variable_enumerator f f_args g g_args c =
+        let f_args' = List.map (fun _ -> get_next_variable_from_enumerator variable_enumerator) f_args in
+        let g_args' = List.map (fun _ -> get_next_variable_from_enumerator variable_enumerator) g_args in
+        let f'      = get_next_variable_from_enumerator variable_enumerator in
+        let g'      = get_next_variable_from_enumerator variable_enumerator in
+
+        let definition_of_g' =
+            ( get_new_label ()
+            , g'
+            , g_args'
+            , EXPR_App (get_new_label (), VEXPR_Variable f', 
+                        List.map (fun s -> VEXPR_Variable s) (f_args' @ [g'] @ g_args'))
+            ) in
+
+        raise Exit
+
+    let uncurry_definition variable_enumerator = function
+        | (definition_label, definition_name, definition_formal_arguments,
+                EXPR_Fix (subreclabel, nested_definitions,
+                    EXPR_App (app_label, VEXPR_Variable called_function, [VEXPR_Variable passed_function])))
+          when List.mem called_function definition_formal_arguments ->
+
+            begin try
+
+                let is_definition_of_called_function (_, name, _, _) = name = passed_function in
+
+                let (_, _, passed_function_formal_arguments, passed_function_body) =
+                    List.find is_definition_of_called_function nested_definitions
+                    in
+
+                let forwarder = construct_forwarder variable_enumerator
+                    definition_name definition_formal_arguments
+                    passed_function passed_function_formal_arguments
+                    called_function
+                    in
+
+                [forwarder]
+            with Not_found ->
+                []
+            end
+
+        | def ->
+            [def]
+
+    let construct_fix label definitions in_expr new_definitions = 
+        if definitions = new_definitions
+        then NoChange
+        else Replace (EXPR_Fix(label, new_definitions, in_expr))
+
+    let transform_node variable_enumerator = function
+        | EXPR_Fix(reclabel, definitions, in_expr) ->
+            definitions
+            |> List.map (uncurry_definition variable_enumerator)
+            |> List.concat
+            |> construct_fix reclabel definitions in_expr
+
+        | _ ->
+            NoChange
+
+end
+
+(*************************************************************************************************
+ * Constant folding
+ ************************************************************************************************)
+
+let topdown_transformations = 
+    [ UncurryFunctions.transform_node
+    ]
+
+let transform = 
+    topdowns_with_dummy_variable_enumerator topdown_transformations
+