mlton/ssa/combine-conversions.fun

   1 (* Copyright (C) 2009 Wesley W. Tersptra.
   2  *
   3  * MLton is released under a BSD-style license.
   4  * See the file MLton-LICENSE for details.
   5  *)
   6
   7 functor CombineConversions (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM =
   8 struct
   9
  10 open S
  11
  12 (*
  13  * This pass looks for and simplifies nested calls to (signed)
  14  * extension/truncation.
  15  *
  16  * It processes each block in dfs order (visiting defs before uses):
  17  *   If the statement is not a PrimApp Word_extdToWords, skip it.
  18  *   After processing a conversion, it tags the Var for subsequent
  19  *   use.
  20  *   When inspecting a conversion, check if the Var operand is also
  21  *   the result of a conversion.  If it is, try to combine the two
  22  *   operations.  Repeatedly simplify until hitting either a
  23  *   non-conversion Var or a case where the conversion cannot be
  24  *   simplified.
  25  *
  26  * The optimization rules are very simple:
  27  *    x1 : word<W1> = ...
  28  *    x2 : word<W2> = Word_extdToWord (W1, W2, {signed=s1}) x1
  29  *    x3 : word<W3> = Word_extdToWord (W2, W3, {signed=s2}) x2
  30  *
  31  *    If W1 = W2, then there is no conversions before x_1.
  32  *    This is guaranteed because W2 = W3 will always trigger optimization.
  33  *
  34  *    Case W1 <= W3 <= W2:
  35  *       x3 = Word_extdToWord (W1, W3, {signed=s1}) x1
  36  *    Case W1 <  W2 <  W3 AND (NOT s1 OR s2):
  37  *       x3 = Word_extdToWord (W1, W3, {signed=s1}) x1
  38  *    Case W1 =  W2 <  W3:
  39  *       unoptimized
  40  *       because there are no conversions past W1 and x2 = x1
  41  *
  42  *    Case W3 <= W2 <= W1:
  43  *    Case W3 <= W1 <= W2:
  44  *       x_3 = Word_extdToWord (W1, W3, {signed=_}) x1
  45  *       because W3 <= W1 && W3 <= W2, just clip x1
  46  *
  47  *    Case W2 < W1 <= W3:
  48  *    Case W2 < W3 <= W1:
  49  *       unoptimized
  50  *       because W2 < W1 && W2 < W3, has truncation effect
  51  *
  52  *    Case W1 < W2 < W3 AND s1 AND (NOT s2):
  53  *       unoptimized
  54  *       because each conversion affects the result separately
  55  *)
  56
  57 val { get : Var.t -> ((WordSize.t
  58                        * WordSize.t
  59                        * {signed:bool})
  60                       * Var.t) option,
  61       set, ... } =
  62    Property.getSetOnce (Var.plist, Property.initConst NONE)
  63
  64 fun rules x3 (conversion as ((W2, W3, {signed=s2}), x2)) =
  65    let
  66       val { <, <=, ... } = Relation.compare WordSize.compare
  67
  68       fun stop () = set (x3, SOME conversion)
  69       fun loop ((W1, _, {signed=s1}), x1) =
  70          rules x3 ((W1, W3, {signed=s1}), x1)
  71    in
  72       case get x2 of
  73          NONE => stop ()
  74        | SOME (prev as ((W1, _, {signed=s1}), _)) =>
  75             if W1 <= W3 andalso W3 <= W2 then loop prev else
  76             if W1 <  W2 andalso W2 <  W3 andalso (not s1 orelse s2)
  77                then loop prev else
  78             if W3 <= W1 andalso W3 <= W2 then loop prev else
  79             (* If W2=W3, we never reach here *)
  80             stop ()
  81    end
  82
  83 fun markStatement stmt =
  84    case stmt of
  85       Statement.T { exp = Exp.PrimApp { args, prim, targs=_ },
  86                     ty = _,
  87                     var = SOME v } =>
  88         (case Prim.name prim of
  89             Prim.Name.Word_extdToWord a => rules v (a, Vector.first args)
  90           | _ => ())
  91     | _ => ()
  92
  93 fun mapStatement stmt =
  94    let
  95       val Statement.T { exp, ty, var } = stmt
  96       val exp =
  97          case Option.map (var, get) of
  98             SOME (SOME (prim as (W2, W3, _), x2)) =>
  99                if WordSize.equals (W2, W3)
 100                then Exp.Var x2
 101                else Exp.PrimApp { args  = Vector.new1 x2,
 102                                   prim  = Prim.wordExtdToWord prim,
 103                                   targs = Vector.new0 () }
 104           | _ => exp
 105    in
 106       Statement.T { exp = exp, ty = ty, var = var }
 107    end
 108
 109 fun transform program =
 110    let
 111       val Program.T { datatypes, functions, globals, main } = program
 112       val shrink = shrinkFunction {globals = globals}
 113
 114       val functions =
 115          List.revMap
 116          (functions, fn f =>
 117           let
 118              (* Traverse blocks in dfs order, marking their statements *)
 119              fun markBlock (Block.T {statements, ... }) =
 120                 (Vector.foreach (statements, markStatement); fn () => ())
 121              val () = Function.dfs (f, markBlock)
 122
 123              (* Map the statements using the marks *)
 124              val {args, blocks, mayInline, name, raises, returns, start} =
 125                 Function.dest f
 126
 127              fun mapBlock block =
 128                 let
 129                    val Block.T {args, label, statements, transfer} = block
 130                 in
 131                    Block.T {args = args,
 132                             label = label,
 133                             statements = Vector.map (statements, mapStatement),
 134                             transfer = transfer}
 135                 end
 136
 137              val f =
 138                 Function.new {args = args,
 139                               blocks = Vector.map (blocks, mapBlock),
 140                               mayInline = mayInline,
 141                               name = name,
 142                               raises = raises,
 143                               returns = returns,
 144                               start = start}
 145
 146              val f = shrink f
 147           in
 148              f
 149           end)
 150
 151       val () = Vector.foreach (globals, Statement.clear)
 152    in
 153       Program.T { datatypes = datatypes,
 154                   functions = functions,
 155                   globals = globals,
 156                   main = main }
 157    end
 158
 159 end