Commits

Anonymous committed 6986bad

Setをimperativeに変更

  • Participants
  • Parent commits ab976e2

Comments (0)

Files changed (1)

File src/reg_alloc.ml

   G.fold_vertex (fun v acc -> v :: acc) g []
 ;;
 
-module TS = Set.Make (struct
+module ISet (Ord : Set.OrderedType) = struct
+  module S = Set.Make (Ord) ;;
+
+  type t = S.t ref ;;
+  
+  let create () = ref S.empty ;;
+  let add set v = set := S.add v !set ;;
+  let mem set v = S.mem v !set ;;
+
+  let iter ~f set = S.iter f !set ;;
+
+  let min_elt set = S.min_elt !set ;;
+
+  let remove set v = set := S.remove v !set ;;
+
+  let is_empty set = S.is_empty !set ;;
+
+  let fold ~f ~init set = S.fold f !set init ;;
+
+  let cardinal set = S.cardinal !set ;;
+
+  let of_list es = ref (List.fold_left es ~init:S.empty ~f:(fun acc e -> S.add e acc)) ;;
+end
+;;
+
+module TS = ISet (struct
   type t = Temp.temp ;;
   let compare = compare ;;
-end)
-;;
+end) ;;
 
-module MS = Set.Make (struct
+module MS = ISet (struct
   type t = Assem.move ;;
   let compare = compare ;;
 end)
 ;;
 
-let ts_of_list xs = List.fold_left xs ~init:TS.empty ~f:(fun acc x -> TS.add x acc)
-let ms_of_list xs = List.fold_left xs ~init:MS.empty ~f:(fun acc x -> MS.add x acc) 
-
 type color = 
 | InReg of Temp.temp
 | InMem of int ;;
       else (n :: init, pre)) igraph ([], []) in
     List.iter precolored ~f:(fun v ->
       prerr_endline @@ Frame.to_string v);
-    {precolored = ts_of_list precolored ; initial = ts_of_list initial;
-     simplify_w = TS.empty;
-     freeze_w = TS.empty;
-     spill_w = TS.empty;
-     spilled = TS.empty;
-     coalesced = TS.empty;
-     colored = TS.empty;
-     select_stack = TS.empty} in
+    {precolored = TS.of_list precolored ; initial = TS.of_list initial;
+     simplify_w = TS.create ();
+     freeze_w = TS.create ();
+     spill_w = TS.create ();
+     spilled = TS.create ();
+     coalesced = TS.create ();
+     colored = TS.create ();
+     select_stack = TS.create ()} in
 
   let degrees = create_tbl () in
   G.iter_vertex (fun v ->
-    if not @@ TS.mem v node.precolored then
+    if not @@ TS.mem node.precolored v then
       T.add degrees v (G.in_degree igraph v)) igraph;
   
     (* move命令管理 *)
     let worklistMoves = List.filter_map instrs ~f:(function
     | MOVE i -> Some i
     | _ -> None) in
-    {worklist = ms_of_list worklistMoves;
-     constraint_ = MS.empty;
-     frozen = MS.empty;
-     coalesced = MS.empty;
-     active = MS.empty}
+    {worklist = MS.of_list worklistMoves;
+     constraint_ = MS.create ();
+     frozen = MS.create ();
+     coalesced = MS.create ();
+     active = MS.create ()}
   in
 
   (* その他の色情報管理 *)
   in
 
   let move_related n =
-    not (TS.mem n node.precolored) &&
+    not (TS.mem node.precolored n) &&
       List.exists (T.find color.move_list n) ~f:(fun mv ->
-        MS.mem mv move.active || MS.mem mv move.worklist )
+        MS.mem move.active mv || MS.mem move.worklist mv)
   in
   
   let make_worklist () =
     TS.iter (fun v ->
       printf "v = %s\n" @@ Temp.make_string v;
       if G.out_degree igraph v >= Frame.k then
-        node.spill_w <- TS.add v node.spill_w
+        TS.add node.spill_w v
       else if move_related v then
-        node.freeze_w <- TS.add v node.freeze_w
+        TS.add node.freeze_w v
       else
-        node.simplify_w <- TS.add v node.simplify_w) node.initial
+        TS.add node.simplify_w v) node.initial
   in
   
   let enable_moves nodes =
     List.iter nodes ~f:(fun v ->
       let mvs = T.find color.move_list v in
       List.iter mvs ~f:(fun mv ->
-        if MS.mem mv move.active then begin
-          move.active <- MS.remove mv move.active;
-          move.worklist <- MS.add mv move.worklist
+        if MS.mem move.active mv then begin
+          MS.remove move.active mv;
+          MS.add move.worklist mv
         end)) in
 
   let adj_check v =
-    not (TS.mem v node.select_stack || TS.mem v node.coalesced) in
+    not (TS.mem node.select_stack v || TS.mem node.coalesced v) in
   
   let simplify () =
     let v = TS.min_elt node.simplify_w in
-    node.simplify_w <- TS.remove v node.simplify_w;
-    node.select_stack <- TS.add v node.select_stack;
+    TS.remove node.simplify_w v;
+    TS.add node.select_stack v;
     G.iter_succ (fun adj ->
-      if not @@ TS.mem adj node.precolored && adj_check adj then
+      if not @@ TS.mem node.precolored adj && adj_check adj then
         let d = T.find degrees adj in
         if d = Frame.k then begin
           enable_moves (adj :: G.succ igraph adj);
-          node.spill_w <- TS.remove adj node.spill_w;
+          TS.remove node.spill_w adj;
           if move_related adj then
-            node.freeze_w <- TS.add adj node.freeze_w
+            TS.add node.freeze_w adj
           else
-            node.simplify_w <- TS.add adj node.simplify_w
+            TS.add node.simplify_w adj
         end;
         update degrees adj (fun v -> v - 1);
     ) igraph v;
     G.fold_succ (fun t acc ->
       if adj_check t then
         acc && (T.find degrees v < Frame.k ||
-                  TS.mem t node.precolored ||
+                  TS.mem node.precolored t ||
                   G.mem_edge igraph t u)
       else acc) igraph v true
   in
   let conservative u v =
     let g = igraph in
     (G.fold_succ (fun t acc ->
-      if not @@ TS.mem t node.precolored && adj_check t then
+      if not @@ TS.mem node.precolored t && adj_check t then
         acc + if T.find degrees t >= Frame.k then 1 else 0
       else acc) g u 0 +
        G.fold_succ (fun t acc ->
-         if not @@ TS.mem t node.precolored && adj_check t then
+         if not @@ TS.mem node.precolored t && adj_check t then
            acc + if T.find degrees t >= Frame.k then 1 else 0
          else acc) g v 0) < Frame.k
   in
 
   let rec get_alias v =
-    if TS.mem v node.coalesced then get_alias (T.find color.alias v)
+    if TS.mem node.coalesced v then get_alias (T.find color.alias v)
     else v in
 
   let add_worklist u =
-    if (not @@ TS.mem u node.precolored  &&
+    if (not @@ TS.mem node.precolored u &&
           not @@ move_related u &&
           T.find degrees u < Frame.k) then begin
-      node.freeze_w <- TS.remove u node.freeze_w;
-      node.simplify_w <- TS.add u node.simplify_w
+      TS.remove node.freeze_w u;
+      TS.add node.simplify_w u
     end in
 
   let combine u v =
-    begin if TS.mem v node.freeze_w then 
-        node.freeze_w <- TS.remove v node.freeze_w
+    begin if TS.mem node.freeze_w v then 
+        TS.remove node.freeze_w v
       else
-        node.spill_w <- TS.remove v node.spill_w end;
-    node.coalesced <- TS.add v node.coalesced;
+        TS.remove node.spill_w v end;
+    TS.add node.coalesced v;
     T.add color.alias v  u;
     update color.move_list u (fun mvs -> mvs @ T.find color.move_list v);
     enable_moves [v];
 
     G.iter_succ (fun t ->
-      if not (TS.mem t node.precolored) then begin
+      if not (TS.mem node.precolored t) then begin
         if adj_check t then
           if T.find degrees t = Frame.k then begin
             enable_moves (t :: G.succ igraph t);
-            node.spill_w <- TS.add t node.spill_w;
+            TS.add node.spill_w t;
             if move_related t then
-              node.freeze_w <- TS.add t node.freeze_w
+              TS.add node.freeze_w t
             else
-              node.simplify_w <- TS.add t node.simplify_w
+              TS.add node.simplify_w t
           end;
         update degrees t (fun d -> d - 1);
       end;
       G.add_edge igraph t u) igraph v;
       (* igraph := G.remove_vertex !igraph v;*)
     
-    if (not @@ TS.mem u node.precolored &&
+    if (not @@ TS.mem node.precolored u &&
           T.find degrees u >= Frame.k &&
-          TS.mem u node.freeze_w) then begin
-      node.freeze_w <- TS.remove u node.freeze_w;
-      node.spill_w <- TS.add u node.spill_w
+          TS.mem node.freeze_w u) then begin
+      TS.remove node.freeze_w u;
+      TS.add node.spill_w u
     end in
   
   let coalesce () =
     
     let open Assem in
     let x, y = get_alias mv.mv_src, get_alias mv.mv_dst in
-    let u, v = if TS.mem y node.precolored then y, x
+    let u, v = if TS.mem node.precolored y then y, x
       else x, y in
 
-    move.worklist <- MS.remove mv move.worklist;
+    MS.remove move.worklist mv;
     
     if u = v then begin
-      move.coalesced <- MS.add mv move.coalesced;
+      MS.add move.coalesced mv;
       add_worklist u
-    end else if TS.mem v node.precolored || G.mem_edge igraph u v then begin
-      move.constraint_ <- MS.add mv move.constraint_;
+    end else if TS.mem node.precolored v || G.mem_edge igraph u v then begin
+      MS.add move.constraint_ mv;
       add_worklist u;
       add_worklist v;
-    end else if ((TS.mem u node.precolored && ok_adj u v) ||
-                    (not (TS.mem u node.precolored && conservative u v))) then begin
-      move.coalesced <- MS.add mv move.coalesced;
+    end else if ((TS.mem node.precolored u && ok_adj u v) ||
+                    (not (TS.mem node.precolored u && conservative u v))) then begin
+      MS.add move.coalesced mv;
       combine u v;
       add_worklist u;
     end else begin
-      move.active <- MS.add mv move.active
+      MS.add move.active mv
     end in
 
   let freeze_moves u =
     let open Assem in
     T.find color.move_list u
     |> List.iter ~f:(fun mv ->
-      if MS.mem mv move.active || MS.mem mv move.worklist then begin
+      if MS.mem move.active mv || MS.mem move.worklist mv then begin
         let x, y = mv.mv_src, mv.mv_dst in
         let v = if get_alias x = get_alias y then get_alias x else get_alias y in
-        move.active <- MS.remove mv move.active;
-        move.frozen <- MS.add mv move.frozen;
+        MS.remove move.active mv;
+        MS.add move.frozen mv;
         
-        if not (TS.mem v node.precolored) &&
+        if not (TS.mem node.precolored v) &&
           (List.exists (T.find color.move_list v) ~f:(fun mv ->
-            MS.mem mv move.active || MS.mem mv move.worklist) &&
+            MS.mem move.active mv || MS.mem move.worklist mv) &&
              T.find degrees v < Frame.k)  then begin
-          node.freeze_w <- TS.remove v node.freeze_w;
-          node.simplify_w <- TS.add v node.simplify_w
+            TS.remove node.freeze_w v;
+            TS.add node.simplify_w v
         end
       end) in
   
   let freeze () =
     let u = TS.min_elt node.freeze_w in
-    node.freeze_w <- TS.remove u node.freeze_w;
-    node.simplify_w <- TS.add u node.simplify_w;
+    TS.remove node.freeze_w u;
+    TS.add node.simplify_w u;
     freeze_moves u in
 
   let select_spill () =
     let m = TS.min_elt node.spill_w in
-    node.spill_w <- TS.remove m node.spill_w;
-    node.simplify_w <- TS.add m node.simplify_w;
+    TS.remove node.spill_w m;
+    TS.add node.simplify_w m;
     freeze_moves m in
 
   let assign_colors () =
     TS.iter (fun v ->
       printf "v@assign = %s\n" @@ Temp.make_string v;
-      let regs = ref @@ ts_of_list Frame.regs in
+      let regs = ref @@ TS.of_list Frame.regs in
       G.iter_succ (fun w ->
         let w = get_alias w in
-        if (TS.mem w node.colored ||
-              TS.mem w node.precolored) then begin
+        if (TS.mem node.colored w ||
+              TS.mem node.precolored w) then begin
           if T.mem color.color w then
-            regs := match T.find color.color w with
-            | InReg t -> TS.remove t !regs 
-            | InMem _ -> !regs ;
+            match T.find color.color w with
+            | InReg t -> TS.remove !regs t
         end) igraph v;
       if TS.is_empty !regs then
-        node.spilled <- TS.add v node.spilled
+        TS.add node.spilled v
       else begin
-        node.colored <- TS.add v node.colored;
+        TS.add node.colored v;
         let c = TS.min_elt !regs in
         T.add color.color v (InReg c);
       end) node.select_stack;
-    node.select_stack <- TS.empty;
+    node.select_stack <- TS.create ();
 
     TS.iter (fun v ->
       if T.mem color.color (get_alias v) then
         T.add color.color v (T.find color.color (get_alias v))) node.coalesced in
 
   let rewrite_program () =
-    TS.fold (fun v i ->
+    TS.fold node.spilled ~init:0 ~f:(fun v i ->
       Printf.eprintf "v@rewrite=%s\n" @@ Temp.make_string v;
       let i = Frame.alloc_local_stack frame in
       T.add color.color v (InMem i);
-      i + Frame.word_size) node.spilled 0 |> ignore in
+      i + Frame.word_size) |> ignore in
 
   let print () =
     if debug then begin