Commits

Anonymous committed 12b7010

more optimizations

  • Participants
  • Parent commits 4e86c55

Comments (0)

Files changed (1)

File brainfuck/brainfuck.ml

     | Loop of operation list (** loop while the current cell is <> 0 *)
     (* following are optimizations *)
     | Reset                  (** reset the current cell to 0 *)
-    | AddToCell of int       (** add the current cell value the cell distant of n, then reset the current cell *)
-  
+    | AddMultToCell of int * int(** add (current cell value)*n to the cell distant of i, then reset the current cell *)
+    | AddMultToCell2 of int * int * int (** add (curval)*n to the both cells distant of i and j, then reset current *)
+    | CopyMultToCell of int * int (** add curval*n to the cell distant of i, don't reset current *)
+    | AddTo of int * int (** add n to the cell distant of i, without moving *)
+
   let string_of_op ops =
     let open Printf in
     let rec to_string indent = function
             (String.concat "\n" (List.map (to_string ("| "^indent)) nodes))
             indent
       | Reset -> sprintf "%sReset" indent
-      | AddToCell i -> sprintf "%sAddToCell(%d)" indent i
+      | AddMultToCell (n, i) -> sprintf "%sAddMultToCell(%d, %d)" indent n i
+      | AddMultToCell2 (n, i, j) -> sprintf "%sAddMultToCell2(%d, %d, %d)" indent n i j
+      | CopyMultToCell (n, i) -> sprintf "%sCopyMultToCell(%d, %d)" indent n i
+      | AddTo (n, i) -> sprintf "%sAddTo(%d, %d)" indent n i
     in to_string "" ops
   
   let dump ast =
   open ParseTree
   
   let rec group = function
-    | Move a :: Move b :: rest -> group (Move (a + b) :: rest)
-    | Add a :: Add b :: rest -> group (Add (a + b) :: rest)
+    | Move a :: Move b :: rest -> 
+      let lst = if a + b <> 0 then Move (a + b) :: rest else rest in  
+      group lst
+    | Add a :: Add b :: rest -> 
+      let lst = if a + b <> 0 then Add (a + b) :: rest else rest in  
+      group lst
     | Loop a :: rest -> (Loop (group a)) :: (group rest)
     | other :: rest -> other :: (group rest)
     | [] -> []
-  
+
   (** replace known loops with faster operations *)
   let rec unroll ast =
     let replace = function
       | [Add (-1)] -> Reset
-      | [Move a; Add 1; Move b; Add (-1)] when a = -b -> AddToCell a
+      | [Move a; Add n; Move b; Add (-1)] 
+        when a = -b -> AddMultToCell (n, a)
+      | [Move a; Add n1; Move b; Add n2; Move c; Add (-1)] 
+        when a + b = -c && n1 = n2 -> AddMultToCell2 (n1, a, a+b)           
       | other -> Loop (unroll other)
     in 
     match ast with
     | Loop ops :: rest -> replace ops :: unroll rest  
     | other :: rest -> other :: (unroll rest)
     | [] -> []
-  
-  let optimize ast = 
-    let ast = group ast in
-    unroll ast
+
+  (** replace move, add and revert back to a distant add *)
+  let in_place_adds ast =
+    let rec loop = function
+      | Move i :: Add n :: Move j :: rest 
+        when i = -j -> AddTo (n, i) :: loop rest
+      | Loop ops :: rest -> Loop (loop ops) :: loop rest  
+      | other :: rest -> other :: loop rest
+      | [] -> []
+    in loop ast
+
+  (** some mult are copies, don't need to reset *)
+  let replace_moves_with_copy ast =
+    let rec loop = function
+      | AddMultToCell2(n1, i, j) :: Move(k) :: AddMultToCell(n2, l) :: rest 
+        when n1 = n2 && j = k && j = -l -> CopyMultToCell (n1, i) :: Move j :: loop rest
+      | Loop ops :: rest -> Loop (loop ops) :: loop rest  
+      | other :: rest -> other :: loop rest
+      | [] -> []
+    in loop ast
+   
+   (** more unrolling *)    
+   let rec shortcut_loops ast =
+    let replace = function
+        (* we need to keep the loop in case the current cell is already 0 ! *)
+      | [Move a; Reset; Move b; Add (-1)] 
+        when a = -b -> Loop [Move a; Reset; Move b; Reset] 
+      | other -> Loop (shortcut_loops other)
+    in 
+    match ast with
+    | Loop ops :: rest -> replace ops :: shortcut_loops rest  
+    | other :: rest -> other :: (shortcut_loops rest)
+    | [] -> []
+
+  let (<<) f1 f2 = fun x -> f1 (f2 x)
+
+  let optimize = 
+    let first_pass = replace_moves_with_copy << in_place_adds << unroll << group
+    and second_pass = group << shortcut_loops
+    in second_pass << first_pass
   
 end
 
           done
       (* optimizations *)
       | Reset -> memory.(!pointer) <- 0
-      | AddToCell i -> 
-        memory.(!pointer + i) <- memory.(!pointer + i) + memory.(!pointer);
+      | AddMultToCell (n, i) -> 
+        memory.(!pointer + i) <- memory.(!pointer + i) + (memory.(!pointer)*n);
         memory.(!pointer) <- 0 
+      | AddMultToCell2 (n, i, j) ->
+        memory.(!pointer + i) <- memory.(!pointer + i) + (memory.(!pointer)*n);
+        memory.(!pointer + j) <- memory.(!pointer + j) + (memory.(!pointer)*n);
+        memory.(!pointer) <- 0 
+      | CopyMultToCell (n, i) -> 
+        memory.(!pointer + i) <- memory.(!pointer + i) + (memory.(!pointer)*n)
+      | AddTo (n, i) -> memory.(!pointer + i) <- memory.(!pointer + i) + n
     in
     List.iter exec_node ast
 end