Commits

Paweł Wieczorek committed 2fbab97

temporary

Comments (0)

Files changed (2)

src/Language/CWCPS/CWCPS_AST.ml

  ************************************************************************************************)
 
 module VariableSet = Set.Make(VariableOrderedType)
+module VariableMap = Map.Make(VariableOrderedType)
 
 let free_variable_of_value_expression = function
     | VEXPR_Variable v ->

src/Transformation/CWCPS/CWCPS_NaiveClosureConversion.ml

 
 open Batteries
 open CWCPS_AST
-open CWCPS_Transformation
 
-module MachineDependent(ArchitectureSpecification : module type of Architecture_Specification) = struct
 
-    
-    let does_definition_need_closure f_need_closure (_, name, _, _) = f_need_closure name
+(*
 
-    let generate_closure f_vriables xs = 
-        let 
 
-    let rec convert_node f_variables f_need_closure = function
-        | EXPR_Fix(reclabel, definitions, in_expr) ->
-            let (definitions_with_closure, definitions_without_closure) =
-                List.partition (does_definition_need_closure f_need_closure) definitions
-                in
+ *)
 
-            let changed_definitions = generate_closure f_variables definitions_with_closure in
-            Replace (EXPR_Fix (reclabel, changed_definitions @ definitions_without_closure, in_expr))
+let rec transform_value_expression access_map vexpr continuation  = match vexpr with
+    | VEXPR_Variable variable
+      when VariableMap.mem variable access_map ->
+        let (closure_vexpr, offset) = VariableMap.find variable access_map in
+        EXPR_Select(get_new_label (), offset, closure_vexpr, variable, continuation vexpr)
 
-        | _ ->
-            raise Exit
+    | _ ->
+        continuation vexpr
 
 
-end
+let rec transform access_map = function
+    | EXPR_Fix(reclabel, definitions, in_expr) ->
+        EXPR_Fix(reclabel, definitions, in_expr) 
+
+    | EXPR_App (label, fun_val, arg_vals) ->
+        EXPR_App (label, fun_val, arg_vals) 
+        
+    | EXPR_Switch (label, sel_val, default_branch, branches) ->
+        let default_branch = transform access_map default_branch in
+        let branches       = List.map (transform access_map) branches in
+        transform_value_expression access_map sel_val (fun sel_val ->
+            EXPR_Switch (label, sel_val, default_branch, branches)
+            )
+
+    | EXPR_ArithmeticBinaryPrimOp (label, primop, arg1, arg2, result, in_expr) ->
+        let in_expr = transform access_map in_expr in
+        transform_value_expression access_map arg1 (fun arg1 ->
+            transform_value_expression access_map arg2 (fun arg2 ->
+                EXPR_ArithmeticBinaryPrimOp (label, primop, arg1, arg2, result, in_expr) 
+            )
+        )
+
+    | EXPR_ArithmeticUnaryPrimOp (label, primop, arg, result, in_expr) ->
+        let in_expr = transform access_map in_expr in
+        transform_value_expression access_map arg (fun arg ->
+            EXPR_ArithmeticUnaryPrimOp (label, primop, arg, result, in_expr)
+        )
+
+    | EXPR_ConditionPrimOp (label, primop, arg1, arg2, then_branch, else_branch) ->
+        let then_branch = transform access_map then_branch in
+        let else_branch = transform access_map else_branch in
+        transform_value_expression access_map arg1 (fun arg1 ->
+            transform_value_expression access_map arg2 (fun arg2 ->
+                EXPR_ConditionPrimOp (label, primop, arg1, arg2, then_branch, else_branch)
+            )
+        )
+
+    | EXPR_Offset (label, offset, value, result, in_expr) ->
+        let in_expr = transform access_map in_expr in
+        transform_value_expression access_map value (fun value ->
+            EXPR_Offset (label, offset, value, result, in_expr)
+        )
+
+    | EXPR_Select (label, offset, value, result, in_expr) ->
+        let in_expr = transform access_map in_expr in
+        transform_value_expression access_map value (fun value ->
+            EXPR_Select (label, offset, value, result, in_expr)
+        )
+
+    | EXPR_Record (label, fields, result, in_expr) ->
+        EXPR_Record (label, fields, result, in_expr)
+