ghc/tests/programs/jeff-bug/RAT.hs

   1 module RAT where
   2
   3 import LazyST
   4
   5 import Prelude hiding (read)
   6 import Hawk
   7 import DLX
   8 import qualified Trans
   9 import Utils
  10
  11 new      :: Register a => ST s (RAT s a b)
  12 write    :: Register a => RAT s a b -> a -> b -> ST s ()
  13 remove   :: Register a => RAT s a b -> a -> ST s ()
  14 read     :: Register a => RAT s a b -> a -> ST s (Maybe b)
  15 clear    :: Register a => RAT s a b -> ST s ()
  16
  17 type RAT s a b = (STArray s a (Maybe b),a,a)
  18
  19 clear (xs,x1,x2)
  20   = do { mapM (\x -> writeSTArray xs x Nothing) [x1 .. x2]
  21        ; return ()
  22        }
  23
  24 replace rat (Reg r x)
  25   = do { a <- read rat r
  26        ; let res = do { v <- a
  27                       ; return (Reg (Virtual v (Just r)) x)
  28                       }
  29                    `catchEx` Reg (Real r) x
  30        ; return res
  31        }
  32 replace rat x = return $ convert x
  33
  34
  35 new
  36   = do { x <- newSTArray (minBound,maxBound) Nothing
  37        ; return (x,minBound,maxBound)
  38        }
  39
  40 write (xy,_,_) x y = writeSTArray xy x (return y)
  41 remove (xy,_,_) x = writeSTArray xy x Nothing
  42 read  (xy,_,_) x = readSTArray xy x