mlton/backend/parallel-move.fun

   1 (* Copyright (C) 1999-2005 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 ParallelMove (S: PARALLEL_MOVE_STRUCTS): PARALLEL_MOVE =
  10 struct
  11
  12 open S
  13
  14 fun ('register, 'statement) move {moves, equals, move, interfere, temp}
  15    : 'statement list =
  16    let
  17       val mvs =
  18          List.fold (moves, [], fn (mv as {src, dst}, mvs) =>
  19                    if equals (src, dst)
  20                       then mvs
  21                    else mv :: mvs)
  22       fun loopTop (mvs, moves) = loop (mvs, [], moves, false)
  23       and loop (mvs, hard, moves, changed) =
  24          case mvs of
  25             [] =>
  26                (case hard of
  27                    [] => List.rev moves
  28                  | {src, dst} :: hard' =>
  29                       if changed
  30                          then loopTop (hard, moves)
  31                       else
  32                          let
  33                             val (hard, moves) =
  34                                List.fold
  35                                (hard', ([], moves),
  36                                 fn (mv as {src = s, dst = d}, (hard, moves)) =>
  37                                 if interfere (dst, s)
  38                                    then let val temp = temp s
  39                                         in ({src = temp, dst = d} :: hard,
  40                                             move {dst = temp, src = s}
  41                                             :: moves)
  42                                         end
  43                                 else (mv :: hard, moves))
  44                             val moves = move {src = src, dst = dst} :: moves
  45                          in loopTop (hard, moves)
  46                          end)
  47           | (mv as {src, dst}) :: mvs =>
  48                let
  49                   fun isHard l =
  50                      List.exists (l, fn {src, dst = _} =>
  51                                  interfere (dst, src))
  52                in if isHard mvs orelse isHard hard
  53                      then loop (mvs, mv :: hard, moves, changed)
  54                   else loop (mvs, hard,
  55                             move {src = src, dst = dst} :: moves,
  56                             true)
  57                end
  58    in loopTop (mvs, [])
  59    end
  60
  61 end