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

   1 module Probe where
   2 import IO
   3 import Arithmetic
   4 import Cell
   5 import Devices
   6 import Memory
   7 import Trans
   8 import VRegister
   9 import Word
  10 import Signal
  11 import PipeReg
  12
  13 import Trans
  14
  15 import IOExts
  16
  17 import System
  18
  19 -- Begin Signature -------------------------------------------------------
  20
  21 {-
  22    In practice it is nice to be able to place a probe on a signal.
  23    Suppose that "s" is a signal.  'probe "s.output" s' has the
  24    same meaning as 's' --- but s's contents have been written to
  25    the file "s.output".   This function has turned out to be
  26    critical in the development of the Visio Hawk interface.
  27
  28    Some issues to consider:
  29         * probe is a hack --- and it messes with referential
  30           trancparency.  Some Haskell compilers may wreak havoc with
  31           probes.
  32         * probe is pretty careful not to change the strictness
  33           behavior.
  34         * Avoid using probes within unit definitions.  If you duplicate
  35           the use of the unit, the output file will be written to
  36           simultaniously by both units instantiations.  Try using probe
  37           only at the top-level of your microarchitecture.
  38         * Probes are typically stored in a subdirectory "Probes/"
  39 -}
  40
  41
  42 class Show a => Probe a where
  43   probe :: String -> Signal a -> Signal a
  44   outp :: a -> String
  45   probe n (List vals) = List (zipWith (dataOut n) [1..] vals)
  46   outp = show
  47
  48 -- clear the probes subdirectory in UNIX
  49 clearProbes_UNIX :: IO ()
  50
  51 -- clear the probes subdirectory in Microsoft
  52 clearProbes_MS :: IO ()
  53
  54 instance (Show a,Show b) => Probe (a,b)
  55 instance (Show a,Show b,Show c) => Probe (a,b,c)
  56 instance Probe Bool
  57 instance Probe Int
  58 instance Probe Word32
  59 instance Probe Word64
  60 instance Probe Char
  61 instance Probe a => Probe (Maybe a)
  62 {-instance (Probe a, Probe b) => Probe (Virtual a b )-}
  63 {-instance Probe PipeRegCmd-}
  64 {-instance Probe AluOp-}
  65 {-instance Probe a => Probe [a]-}
  66
  67 -- End Signature --------------------------------------------------------
  68
  69 clearProbes_UNIX
  70    = do { system "rm -f Probes/*"
  71         ; return ()
  72         }
  73
  74 clearProbes_MS
  75    = do { system "del \\Q Probes\\*.*"
  76         ; return ()
  77         }
  78
  79 dataOut :: Probe a => String -> Int -> a -> a
  80 dataOut fileName clock val = unsafePerformIO $
  81   do
  82     {h <- openFile ("Probes/" ++ fileName) AppendMode;
  83     hPutStrLn h (rjustify 3 (show clock) ++ ": " ++ outp val);
  84     hClose h;
  85     return val}
  86
  87
  88
  89 instance (Probe a, Probe b) => Probe (Virtual a b ) where
  90    outp (Virtual n (Just r)) = "V"++show n ++ "{" ++ outp r ++"}"
  91    outp (Virtual n Nothing) = "V"++show n
  92    outp (Real r) = outp r
  93
  94
  95 instance Probe PipeRegCmd where
  96    outp Input = "Ok"
  97    outp Kill  = "Kill"
  98    outp Stall = "Stall"
  99
 100 instance Probe AluOp where
 101   outp (Add _) = "+"
 102   outp (Sub _) = "-"
 103   outp (Div _) = "/"
 104   outp (Mult _) = "*"
 105   outp And  = "AND"
 106   outp Or  = "OR"
 107   outp Xor  = "XOR"
 108   outp Not  = "NOT"
 109   outp Input1 = "fst"
 110   outp Input2 = "snd"
 111   outp x = show x
 112
 113
 114
 115 instance Probe a => Probe [a] where
 116    outp [] = "[]"
 117    outp l = "[\t" ++ foldr1 (\x y -> x ++ "\n\t" ++ y) (map outp l) ++ "]"
 118
 119
 120
 121 rjustify n s = reverse (take (max n (length s))
 122                              (reverse s ++ repeat ' '))