| 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 |