% -*- mode: Noweb; noweb-code-mode: sml-mode -*-
<<patrew.sig>>=
signature RTL_PATTERN_REWRITE = sig
  val apply : RtlPattern.operator * RtlPattern.exp list -> RtlPattern.exp
end
@ 
Should modify this code so that in relational operators, literal
integers are always on the right.
<<patrew.sml>>=
structure RtlPatternRewrite : RTL_PATTERN_REWRITE = struct
  structure P = RtlPattern
  structure PGE = PatternGuardExp

  val zero = IntInf.fromInt 0
  val one  = IntInf.fromInt 1
  val two  = IntInf.fromInt 2
  fun pow2 n = IntInf.pow (two, n)
  fun mask n = IntInf.- (pow2 n, one)

  fun modw w n = IntInf.mod (n, pow2 w)
  fun iszero n = IntInf.compare (n, zero) = EQUAL

  fun ne (n, m) = IntInf.compare (n, m) <> EQUAL
  fun eq (n, m) = IntInf.compare (n, m) =  EQUAL

  fun baseAdd w (x, y) = P.APP (("add", [w]), [x, y])

  fun add w (P.INT (n, _), P.INT (m, _)) = P.INT (modw w (IntInf.+ (n, m)), w)
    | add w (x as P.INT (n, _), y) = if iszero n then y else baseAdd w (x, y)
    | add w (x, y as P.INT (n, _)) = if iszero n then x else baseAdd w (x, y)
    | add w (x, y) = baseAdd w (x, y)

  fun iscomzero (P.APP (("com", _), [P.INT (m, _)])) = iszero m
    | iscomzero _ = false
  fun baseAnd w (x, y) = P.APP (("and", [w]), [x, y])

  fun and' w (x as P.INT (n, _), y as P.INT (m, _)) = 
        if iszero n then x else if iszero m then y else baseAnd w (x, y)
    | and' w (x as P.INT (n, _), y) = 
         if iszero n then x else if iscomzero y then x else baseAnd w (x, y)
    | and' w (x, y as P.INT (n, _)) = 
         if iszero n then y else if iscomzero x then y else baseAnd w (x, y)
    | and' w (x, y) = baseAnd w (x, y)

  fun baseOr w (x, y) = P.APP (("or", [w]), [x, y])

  fun or w (x as P.INT (n, _), y as P.INT (m, _)) = 
         if iszero n then y else if iszero m then x else baseOr w (x, y)
    | or w (x as P.INT (n, _), y) = 
         if iszero n then y else if iscomzero y then y else baseOr w (x, y)
    | or w (x, y as P.INT (n, _)) = 
         if iszero n then x else if iscomzero x then x else baseOr w (x, y)
    | or w (x, y) = baseOr w (x, y)

  fun baseXor w (x, y) = P.APP (("xor", [w]), [x, y])

  fun xor w (x as P.INT (n, _), y as P.INT (m, _)) = 
         if iszero n then y else if iszero m then x else baseXor w (x, y)
    | xor w (x as P.INT (n, _), y) = 
         if iszero n then y else if iscomzero y then y else baseXor w (x, y)
    | xor w (x, y as P.INT (n, _)) = 
         if iszero n then x else if iscomzero x then x else baseXor w (x, y)
    | xor w (x, y) = baseXor w (x, y)

  fun lift $ ints (P.INT (n, _), P.INT (m, _)) = P.BOOL (ints (n, m))
    | lift $ _ (x, y) = P.APP ($, [x, y])

  fun apply (("add", [w]), [x, y]) = add  w (x, y)
    | apply (("and", [w]), [x, y]) = and' w (x, y)
    | apply (("or",  [w]), [x, y]) = or   w (x, y)
    | apply (("xor", [w]), [x, y]) = xor  w (x, y)
    | apply ($ as ("ne", [w]), [x, y]) = lift $ ne (x, y)
    | apply ($ as ("eq", [w]), [x, y]) = lift $ eq (x, y)
    | apply (("conjoin",  []), l) = foldr PGE.conjoin PGE.true' l
    | apply (("not",  []), [p])   = PGE.negate p
    | apply args = P.APP args

end