civicaml/phases/peephole.ml

open Types
open Util

let rec strip_comments = function
    | Comment _ :: tl -> strip_comments tl
    | InlineComment (EmptyLine, _) :: tl -> strip_comments tl
    | InlineComment (instr, _) :: tl -> strip_comments (instr :: tl)
    | hd :: tl -> hd :: (strip_comments tl)
    | [] -> []

let rec peephole = function
    (* Constant load before branch becomes a jump when the branch condition
     * matches the loaded value ... *)
    | LoadImm (BoolVal b) :: Branch (cond, tgt) :: tl when cond = b ->
        InlineComment (Jump tgt, "branch -> jump") :: (peephole tl)

    (* ... otherwise, both instructions can be removed *)
    | LoadImm (BoolVal _) :: Branch (_, tgt) :: tl ->
        InlineComment (EmptyLine, "load + branch removed") :: peephole tl

    (* Transform addition/subtraction by constant to increment/decrement:
     * iload L          |   iload L
     * iloadc[_ ]C      |   iloadc_1
     * i{add,sub}       |   i{add,sub}
     * istore L         |   istore L
     *     |                  |
     *     v                  v
     * i{inc,dec} L C   |   i{inc,dec}_1 L
     *)
    | (Load (Int, Current, index) :: LoadImm (IntVal i) :: Op (Add, Int) ::
            Store (Int, Current, store) :: tl
    |  LoadImm (IntVal i) :: Load (Int, Current, index) :: Op (Add, Int) ::
            Store (Int, Current, store) :: tl) when store = index ->
        InlineComment (Inc (index, i), "add -> inc") :: (peephole tl)

    | (Load (Int, Current, index) :: LoadImm (IntVal i) :: Op (Sub, Int) ::
            Store (Int, Current, store) :: tl
    |  LoadImm (IntVal i) :: Load (Int, Current, index) :: Op (Sub, Int) ::
            Store (Int, Current, store) :: tl) when store = index ->
        InlineComment (Dec (index, i), "sub -> dec") :: (peephole tl)

    | hd :: tl -> hd :: (peephole tl)
    | [] -> []

let rec phase input =
    log_line 1 "- Peephole optimization";
    match input with
    | Assembly instrs -> Assembly (peephole (strip_comments instrs))
    | _ -> raise (InvalidInput "peephole")