ghc/tests/programs/areid_pass/Main.hs

   1 module Main ( main ) where
   2
   3 main = do_actions [
   4          sleep 5,
   5          wrapup (_ccall_ printf ``"%d\n"'' (pass (14::Int)))
   6         ]
   7
   8 do_actions :: [IO ()] -> IO ()
   9 do_actions = foldr thenIO_ (returnIO ())
  10
  11 class Wrapper a where
  12  wrapup :: IO_Int# -> IO a
  13
  14 instance Wrapper () where
  15   wrapup a = a `thenIO_Int#` \ _ -> returnIO ()
  16
  17 instance Wrapper Int where
  18   wrapup a = a `thenIO_Int#` \ x# -> returnIO (I# x#)
  19
  20 instance Wrapper Char where
  21   wrapup a = a `thenIO_Int#` \ x# -> returnIO (toEnum (I# x#))
  22
  23 instance Wrapper Bool where
  24   wrapup a = a `thenIO_Int#` \ x# -> returnIO (x# /=# 0#)
  25
  26 class Pass a where
  27   pass :: a -> Int#
  28
  29 instance Pass Int where
  30   pass (I# i#) = i#
  31
  32 instance Pass Char where
  33   pass c = pass (fromEnum c)
  34
  35 instance Pass Bool where
  36   pass True = 0#
  37   pass False = 1#
  38
  39 sleep :: Int -> IO ()
  40 usleep :: Int -> IO ()
  41
  42 sleep t = wrapup (ccall sleep (pass t))
  43 usleep t = wrapup (ccall usleep (pass t))
  44