Commits

Paweł Wieczorek committed 1dfe255

added worklist algorithm

Comments (0)

Files changed (4)

src/Language/CWCPS/CWCPS_Eval.ml

         Environment.clone !environment
 
     let change_environment env =
-        environment := env
+        environment := Environment.clone env
 end
 
 (*********************************************************************************************************************
         | EXPR_Fix (_, definitions, inexpression) ->
             let environment = Utils.get_environment_clone () in
             let handle_def (_, variable, argument_variables, expression) =
-                (* TODO: each closure should have own clone of environment !!!!! *)
                 let value   = VAL_Closure (argument_variables, expression, environment) in
                 Environment.put environment variable value;
                 (variable, value) 

src/Language/CWCPS/CWCPS_Parser.mly

     |
     { [] }
 
-    | variables variable
-    { $2 :: $1 }
+    | variable variables
+    { $1 :: $2 }
     ;
 
 

src/Lib/WorklistAlgorithm.ml

+open Batteries
+
+type 'a graph  = ('a, 'a) Hashtbl.t
+
+type ('a, 'b) result = ('a,'b) Hashtbl.t
+
+module Core = struct
+
+
+    let rec loop f eq graph result queue = 
+        let node = Queue.take queue in
+        let old_value  = Hashtbl.find result node in
+        let new_value  = f node old_value in
+        if not (eq old_value new_value)
+        then begin
+            let affected_nodes = Hashtbl.find_all graph node in
+            List.iter (fun x -> Queue.push x queue) affected_nodes;
+            Hashtbl.replace result node new_value
+        end;
+        loop f eq graph result queue
+
+    let compute f eq graph empty first =
+        let queue         = Queue.create () in
+        let result        = Hashtbl.create 512 in
+        let set_empty y x = Hashtbl.replace result x empty; Hashtbl.replace result y empty in
+        Hashtbl.iter set_empty graph;
+        Queue.push first queue;
+        try 
+            loop f eq graph result queue
+        with Queue.Empty ->
+            result
+
+end
+
+module Simple = struct
+
+    let compute f = Core.compute (fun _ -> f)
+
+end
+
+
+module HashtblPackedFunction = struct
+
+    type ('a, 'b) ftype = ('a, 'b -> 'b) Hashtbl.t
+
+    let compute fs eq graph empty first =
+        let f l           = Hashtbl.find l in
+        Core.compute f eq graph empty first
+
+end
 open CWCPS_ConditionalJumpsOptimization
 open CWCPS_RecordUsageOptimization
 open CWCPS_UncurryFunctionsTransformation
+open CWCPS_SizeSavingAnalysis
 open Algebra_Monoid
 open Enumerators
+open WorklistAlgorithm
 
 (************************************************************************************************
  * About command