ghc/lib/std/PrelUnsafe.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[PrelUnsafe]{Module @PrelUnsafe@}
   6
   7 These functions have their own module because we definitely don't want
   8 them to be inlined. The reason is that we may end up turning an action
   9 into a constant when it is not:
  10
  11   new :: IORef Int
  12   new =
  13    let
  14     foo = unsafePerformIO getNextValue
  15    in
  16    newIORef foo
  17
  18 If unsafePerformIO is inlined here, the application of getNextValue to the realWorld#
  19 token might be floated out, leaving us with
  20
  21   foo' = getNextValue realWorld#
  22
  23   new :: IORef Int
  24   new = newIORef foo'
  25
  26 which is not what we want.
  27
  28 \begin{code}
  29 {-# OPTIONS -fno-implicit-prelude #-}
  30
  31 module PrelUnsafe
  32         ( unsafePerformIO,
  33           unsafeInterleaveIO,
  34           trace,
  35         ) where
  36 \end{code}
  37
  38 \begin{code}
  39 import PrelBase
  40 import PrelIOBase
  41 import PrelAddr
  42 import {-# SOURCE #-} PrelErr ( error )
  43 \end{code}
  44
  45 %*********************************************************
  46 %*                                                      *
  47 \subsection{Unsafe @IO@ operations}
  48 %*                                                      *
  49 %*********************************************************
  50
  51 \begin{code}
  52 unsafePerformIO :: IO a -> a
  53 unsafePerformIO (IO m)
  54   = case m realWorld# of
  55       IOok _ r   -> r
  56       IOfail _ e -> error ("unsafePerformIO: I/O error: " ++ show e ++ "\n")
  57
  58 unsafeInterleaveIO :: IO a -> IO a
  59 unsafeInterleaveIO (IO m) = IO ( \ s ->
  60         let
  61          res =
  62            case m s of
  63              IOok _ r   -> r
  64              IOfail _ e -> error ("unsafeInterleaveIO: I/O error: " ++ show e ++ "\n")
  65         in
  66         IOok s res
  67     )
  68
  69
  70 trace :: String -> a -> a
  71 trace string expr
  72   = unsafePerformIO (
  73         ((_ccall_ PreTraceHook sTDERR{-msg-}):: IO ())  >>
  74         fputs sTDERR string                             >>
  75         ((_ccall_ PostTraceHook sTDERR{-msg-}):: IO ()) >>
  76         return expr )
  77   where
  78     sTDERR = (``stderr'' :: Addr)
  79 \end{code}