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

   1 module VRegister where
   2
   3 import Ix
   4 import Register
   5 import Cell
   6 import Trans
   7
   8
   9 -- Begin Signature -------------------------------------------------
  10
  11 {-
  12   Given two register sets, VRegister facilitates the mapping
  13   between them.  See the P6 model for an example of register renaming
  14   with VRegister
  15 -}
  16
  17 data Virtual r v
  18    = Real r
  19    | Virtual v (Maybe r)
  20         deriving (Read,Show,Ord)
  21
  22 isReal          :: Virtual a b -> Bool
  23 isVirtual       :: Virtual a b -> Bool
  24
  25 {-instance (Ix a, Ix b,Bounded a,Bounded b) => Ix (Virtual a b)-}
  26 {-instance (Enum a,Bounded a,Enum b,Bounded b) => Enum (Virtual a b)-}
  27 {-instance (Bounded a,Bounded b) => Bounded (Virtual a b)-}
  28 {-instance (Register a,Register b) => Register (Virtual a b)-}
  29 {-instance Eq Virtual r v-}
  30 {-instance Register Int-}
  31
  32
  33
  34
  35 -- End Signature -------------------------------------------------
  36
  37 instance Register Int where
  38         pc = error "Int does not have a PC"
  39         specpc = error "Int does not have a SPECPC"
  40         isspecpc _ = False
  41         ispc _ = False
  42
  43
  44
  45 virtual x = Virtual x Nothing
  46
  47 isReal (Real _) = True
  48 isReal  _       = False
  49
  50 isVirtual (Virtual _ _) = True
  51 isVirtual  _       = False
  52
  53 -----------------------Instances--------------------------------
  54
  55 instance (Eq a,Eq b) => Eq (Virtual a b) where
  56   (Virtual x _) == (Virtual y _) = x == y
  57   (Real x) == (Real y) = x == y
  58   _ == _  = False
  59   (Virtual x _) /= (Virtual y _) = x /= y
  60   (Real x) /= (Real y) = x /= y
  61   _ /= _  = True
  62
  63 instance (Register a,Register b) => Register (Virtual a b) where
  64   readOnly (Virtual v x) = readOnly v
  65   readOnly (Real v) = readOnly v
  66   ispc (Virtual n (Just x)) = ispc x
  67   ispc (Real x) = ispc x
  68   isspecpc (Virtual n (Just x)) = isspecpc x
  69   isspecpc (Real x) = isspecpc x
  70   pc = Real pc
  71   specpc = Real specpc
  72
  73
  74 instance (Ix a, Ix b,Bounded a,Bounded b) => Ix (Virtual a b) where
  75 --  range :: (a,a) -> [a]
  76     range (Real r, Real r')       = map Real $ range (r,r')
  77     range (Virtual r _, Virtual r' _) = map (\x -> Virtual x Nothing) $ range (r,r')
  78     range (Real r, Virtual r' _) = range1 ++ range2
  79          where range1 = map Real $ range (r,maxBound)
  80                range2 = map (\x -> Virtual x Nothing) $ range (minBound,r')
  81     range (Virtual r _, Real r') = []
  82 --  index :: (a,a) -> a -> Int
  83     index (Virtual r _,Virtual r' _) (Virtual r'' _) = index (r,r') r''
  84     index (Real r,Real r') (Real r'') = index (r,r') r''
  85     index (Virtual r _,Virtual r' _) _ = error "index: Real Reg out of range"
  86     index (Real r,Real r') _ = error "index: Virtual Reg out of range"
  87     index (Virtual r _,Real r') _ = error "index: Virtual Reg out of range"
  88     index (Real r,Virtual r' _) (Real x) = index(r,maxBound) x
  89     index (Real r,Virtual r' _) (Virtual x _) = index(minBound,r') x
  90 --  inRange :: (a,a) -> a -> Bool
  91     inRange (Virtual x _,Virtual y _) (Virtual z _) = inRange (x,y) z
  92     inRange (Real x,Real y) (Real z) = inRange (x,y) z
  93     inRange (Virtual x _,Virtual y _) _ = False
  94     inRange (Real x,Real y) _ = False
  95     inRange (Virtual x _,Real y) _ = False
  96     inRange (Real y,_) (Real r) = inRange (y,maxBound) r
  97     inRange (_,Virtual y _) (Virtual r _) = inRange (minBound,y) r
  98
  99
 100 instance (Enum a,Bounded a,Enum b,Bounded b) => Enum (Virtual a b) where
 101 --  toEnum :: Int -> a
 102 --  toEnum = Virtual . toEnum
 103     toEnum x = error "Virtual.toEnum"
 104
 105 --  fromEnum :: a -> Int
 106 --  fromEnum (Virtual x) = fromEnum x
 107     fromEnum x = error "Virtual.fromEnum"
 108
 109 --  enumFrom :: a -> [a]
 110     enumFrom (Virtual x _) = map virtual (enumFrom x)
 111     enumFrom (Real x) = map Real (enumFrom x) ++ enumFrom (virtual minBound)
 112
 113 --  enumFromThen :: a -> a -> [a]
 114     enumFromThen  _ _ = error "Virtual.enumFromThen"
 115
 116 --  enumFromTo :: a -> a -> [a]
 117     enumFromTo (Virtual x _) (Virtual y _)
 118               = map virtual (enumFromTo x y)
 119     enumFromTo (Real x) (Real y)
 120               = map Real (enumFromTo x y)
 121     enumFromTo (Real x) (Virtual y z)
 122               = enumFrom (Real x) ++
 123                 enumFromTo (Virtual minBound Nothing) (Virtual y z)
 124 --  enumFromThenTo :: a -> a -> a -> [a]
 125     enumFromThenTo _ _ _ = error "Virtual.enumFromThenTo"
 126
 127 instance (Bounded a,Bounded b) => Bounded (Virtual a b) where
 128 -- minBound :: a
 129    minBound = Real minBound
 130 -- maxBound :: a
 131    maxBound = Virtual maxBound Nothing
 132