mlton/codegen/amd64-codegen/peephole.fun

   1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  * Copyright (C) 1997-2000 NEC Research Institute.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 functor Peephole(T : PEEPHOLE_TYPES): PEEPHOLE =
  10   struct
  11     open T
  12
  13     datatype statement_border = Empty
  14                               | EmptyOrNonEmpty
  15     type statement_element = (int * int option) * (statement_type -> bool)
  16     type transfer_element = transfer_type -> bool
  17
  18     val One : (statement_type -> bool) -> statement_element
  19       = fn p => ((1, SOME 1), p)
  20     val All : (statement_type -> bool) -> statement_element
  21       = fn p => ((0, NONE), p)
  22
  23     type template = {start: statement_border,
  24                      statements: statement_element list,
  25                      finish: statement_border,
  26                      transfer: transfer_element}
  27
  28     type match = {entry: entry_type,
  29                   profileLabel: profileLabel_type,
  30                   start: statement_type list,
  31                   statements: statement_type list list,
  32                   finish: statement_type list,
  33                   transfer: transfer_type}
  34
  35     type rewriter = match -> block option
  36
  37     type callback = bool -> unit
  38
  39     type optimization = {template: template,
  40                          rewriter: rewriter,
  41                          callback: callback}
  42
  43     datatype match_state
  44       = Start of {block: block}
  45       | Continue of {remaining: optimization list,
  46                      match: match}
  47       | Done of {block: block}
  48
  49     type find_state = {remaining: optimization list,
  50                        state: {entry: entry_type,
  51                                profileLabel: profileLabel_type,
  52                                start: statement_type list,
  53                                finish: statement_type list,
  54                                transfer: transfer_type}}
  55
  56     fun split (l, p)
  57       = case l
  58           of [] => ([],[])
  59            | l as h::t => if p h
  60                             then let
  61                                     val (tt,ff) = split (t, p)
  62                                  in
  63                                     (h::tt,ff)
  64                                  end
  65                             else ([],l)
  66
  67     val rec matcher' : {template_statement: statement_element,
  68                         statement: statement_type list,
  69                         finish: statement_type list} ->
  70                        {statement: statement_type list,
  71                         finish: statement_type list} option
  72       = fn (* Zero *)
  73            {template_statement = ((0, SOME 0), _),
  74             statement,
  75             finish}
  76          => SOME {statement = List.rev statement,
  77                   finish = finish}
  78          | (* ZeroOrOne *)
  79            {template_statement = ((0, SOME 1), p),
  80             statement,
  81             finish}
  82          => (case finish
  83                of [] => SOME {statement = List.rev statement,
  84                               finish = finish}
  85                 | (statement'::finish')
  86                 => if p statement'
  87                      then SOME {statement = List.rev (statement'::statement),
  88                                 finish = finish'}
  89                      else SOME {statement = List.rev statement,
  90                                 finish = finish})
  91          | (* One *)
  92            {template_statement = ((1, SOME 1), p),
  93             statement,
  94             finish}
  95          => (case finish
  96                of [] => NONE
  97                 | (statement'::finish')
  98                 => if p statement'
  99                      then SOME {statement = List.rev (statement'::statement),
 100                                 finish = finish'}
 101                      else NONE)
 102          | (* *)
 103            {template_statement = ((0, SOME i), p),
 104             statement,
 105             finish}
 106          => (case finish
 107                of [] => SOME {statement = List.rev statement,
 108                               finish = finish}
 109                 | (statement'::finish')
 110                 => if p statement'
 111                      then matcher' {template_statement = ((0, SOME (i-1)), p),
 112                                     statement = statement'::statement,
 113                                     finish = finish'}
 114                      else SOME {statement = List.rev statement,
 115                                 finish = finish})
 116          | (* All *)
 117            {template_statement = ((0, NONE), p),
 118             statement,
 119             finish}
 120          => let
 121               val (statement',finish') = split (finish, p)
 122             in
 123               SOME {statement = List.fold(statement,
 124                                           statement',
 125                                           op ::),
 126                     finish = finish'}
 127             end
 128          | {template_statement = ((min, max), p),
 129             statement,
 130             finish = (statement'::finish')}
 131          => if p statement'
 132               then matcher' {template_statement
 133                              = ((Int.max(min-1,0),
 134                                  Option.map(max,fn i => i - 1)), p),
 135                              statement = statement'::statement,
 136                              finish = finish'}
 137               else NONE
 138          | _ => NONE
 139
 140     val rec matcher : {template_statements: statement_element list,
 141                        statements: statement_type list list,
 142                        finish: statement_type list} ->
 143                       {statements: statement_type list list,
 144                        finish: statement_type list} option
 145       = fn {template_statements = [],
 146             statements,
 147             finish}
 148          => SOME {statements = List.rev statements,
 149                   finish = finish}
 150          | {template_statements = (template_statement::template_statements),
 151             statements,
 152             finish}
 153          => (case matcher' {template_statement = template_statement,
 154                             statement = [],
 155                             finish = finish}
 156                of NONE => NONE
 157                 | SOME {statement, finish}
 158                 => matcher {template_statements = template_statements,
 159                             statements = statement::statements,
 160                             finish = finish})
 161
 162     fun peepholeBlock' {optimizations: optimization list,
 163                         match_state: match_state}
 164       = let
 165           fun next {remaining: optimization list,
 166                     state as {entry, profileLabel, start, finish, transfer}} :
 167                    find_state option
 168             = (case remaining
 169                  of [] => NONE
 170                   | _::nil
 171                   => (case finish
 172                         of [] => NONE
 173                          | statement::finish
 174                          => SOME {remaining = optimizations,
 175                                   state = {entry = entry,
 176                                            profileLabel = profileLabel,
 177                                            start = statement::start,
 178                                            finish = finish,
 179                                            transfer = transfer}})
 180                   | _::remaining
 181                   => SOME {remaining = remaining,
 182                            state = state})
 183
 184           fun findMatch' (find_state
 185                           as {remaining as {template = {start
 186                                                         = template_start,
 187                                                         statements
 188                                                         = template_statements,
 189                                                         finish
 190                                                         = template_finish,
 191                                                         transfer
 192                                                         = template_transfer},
 193                                             ...}::_,
 194                               state = {entry,
 195                                        profileLabel,
 196                                        start,
 197                                        finish,
 198                                        transfer}}) :
 199                          match_state
 200             = let
 201                 fun loop ()
 202                   = (case next find_state
 203                        of SOME find_state => findMatch' find_state
 204                         | NONE
 205                         => Done {block = T {entry = entry,
 206                                             profileLabel = profileLabel,
 207                                             statements = List.fold(start,
 208                                                                    finish,
 209                                                                    op ::),
 210                                             transfer = transfer}})
 211               in
 212                 if not (template_transfer transfer)
 213                   then loop ()
 214                 else if template_start = Empty
 215                         andalso
 216                         not (List.isEmpty start)
 217                      then loop ()
 218                 else case matcher {template_statements = template_statements,
 219                                    statements = [],
 220                                    finish = finish}
 221                        of NONE => loop ()
 222                         | SOME {statements, finish}
 223                         => if template_finish = Empty
 224                               andalso
 225                               not (List.isEmpty finish)
 226                              then loop ()
 227                              else Continue {remaining = remaining,
 228                                             match
 229                                             = {entry = entry,
 230                                                profileLabel = profileLabel,
 231                                                start = start,
 232                                                statements = statements,
 233                                                finish = finish,
 234                                                transfer = transfer}}
 235               end
 236             | findMatch' _ = Error.bug "Peephole.peepholeBlock'.findMatch'"
 237
 238           fun findMatch (match_state: match_state) : match_state
 239             = case match_state
 240                 of Start {block = T {entry, profileLabel,
 241                                      statements, transfer}}
 242                  => let
 243                       val find_state
 244                         = {remaining = optimizations,
 245                            state = {entry = entry,
 246                                     profileLabel = profileLabel,
 247                                     start = [],
 248                                     finish = statements,
 249                                     transfer = transfer}}
 250                     in
 251                       findMatch' find_state
 252                     end
 253                  | Continue {remaining,
 254                              match = {entry,
 255                                       profileLabel,
 256                                       start,
 257                                       statements,
 258                                       finish,
 259                                       transfer},
 260                              ...}
 261                  => let
 262                       val finish = List.foldr(statements,
 263                                               finish,
 264                                               op @)
 265                       val find_state
 266                         = {remaining = remaining,
 267                            state = {entry = entry,
 268                                     profileLabel = profileLabel,
 269                                     start = start,
 270                                     finish = finish,
 271                                     transfer = transfer}}
 272                     in
 273                       case next find_state
 274                         of NONE => Done {block
 275                                          = T {entry = entry,
 276                                               profileLabel = profileLabel,
 277                                               statements = List.fold(start,
 278                                                                      finish,
 279                                                                      op ::),
 280                                               transfer = transfer}}
 281                          | SOME find_state => findMatch' find_state
 282                     end
 283                | Done _ => match_state
 284
 285           fun peepholeBlock'' {match_state: match_state,
 286                                changed: bool}
 287             = case findMatch match_state
 288                 of match_state as Continue {remaining = {rewriter,
 289                                                          callback,
 290                                                          ...}::_,
 291                                             match}
 292                  => (case rewriter match
 293                        of SOME block
 294                         => (callback true;
 295                             peepholeBlock'' {match_state
 296                                              = Start {block = block},
 297                                              changed = true})
 298                         | NONE
 299                         => (callback false;
 300                             peepholeBlock'' {match_state = match_state,
 301                                              changed = changed}))
 302                  | Done {block} => {block = block, changed = changed}
 303                  | _ => Error.bug "Peephole.peepholeBlock''"
 304         in
 305           case optimizations
 306             of [] => (case match_state
 307                         of Start {block = block} => {block = block,
 308                                                      changed = false}
 309                          | _ => Error.bug "Peephole.peepholeBlock'")
 310              | _ => peepholeBlock'' {match_state = match_state,
 311                                      changed = false}
 312         end
 313
 314     fun peepholeBlock {block: block,
 315                        optimizations: optimization list}
 316       = peepholeBlock' {optimizations = optimizations,
 317                         match_state = Start {block = block}}
 318
 319     fun peepholeBlocks {blocks: block list,
 320                         optimizations: optimization list}
 321       = let
 322           val {blocks, changed}
 323             = List.foldr
 324               (blocks,
 325                {blocks = [], changed = false},
 326                fn (block,{blocks,changed})
 327                 => let
 328                      val {block = block',
 329                           changed = changed'}
 330                        = peepholeBlock' {optimizations = optimizations,
 331                                          match_state = Start {block = block}}
 332                    in
 333                      {blocks = block'::blocks,
 334                       changed = changed orelse changed'}
 335                    end)
 336         in
 337           {blocks = blocks,
 338            changed = changed}
 339         end
 340   end