1da8e25c4ea02027836c4be2f2a57bc44b0aa91a
[ghc-hetmet.git] / ghc / lib / ghc / Unsafe.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1994-1996
3 %
4
5 \section[Unsafe]{Module @Unsafe@}
6
7 These functions have their own module because we definitely don't want
8 them to be inlined.
9
10 \begin{code}
11 {-# OPTIONS -fno-implicit-prelude #-}
12
13 module Unsafe
14         ( unsafePerformIO, 
15           unsafeInterleaveIO, 
16           unsafeInterleaveST,
17           trace,
18           runST
19         ) where
20 \end{code}
21
22 \begin{code}
23 import PrelBase
24 import IOBase
25 import STBase
26 import Addr
27 import {-# SOURCE #-} Error ( error )
28 \end{code}
29
30 %*********************************************************
31 %*                                                      *
32 \subsection{Unsafe @IO@ operations}
33 %*                                                      *
34 %*********************************************************
35
36 \begin{code}
37 unsafePerformIO :: IO a -> a
38 unsafePerformIO (IO m)
39   = case m realWorld# of
40       IOok _ r   -> r
41       IOfail _ e -> error ("unsafePerformIO: I/O error: " ++ show e ++ "\n")
42
43 unsafeInterleaveIO :: IO a -> IO a
44 unsafeInterleaveIO (IO m) = IO ( \ s ->
45         let
46             IOok _ r = m s
47         in
48         IOok s r)
49
50 {-# GENERATE_SPECS _trace a #-}
51 trace :: String -> a -> a
52 trace string expr
53   = unsafePerformIO (
54         ((_ccall_ PreTraceHook sTDERR{-msg-}):: IO ())  >>
55         fputs sTDERR string                             >>
56         ((_ccall_ PostTraceHook sTDERR{-msg-}):: IO ()) >>
57         return expr )
58   where
59     sTDERR = (``stderr'' :: Addr)
60 \end{code}
61
62 \begin{code}
63 unsafeInterleaveST :: ST s a -> ST s a
64 unsafeInterleaveST (ST m) = ST ( \ s ->
65     let
66         STret _ r = m s
67     in
68     STret s r)
69
70 \end{code}
71
72 Definition of runST
73 ~~~~~~~~~~~~~~~~~~~
74
75 SLPJ 95/04: Why @runST@ must not have an unfolding; consider:
76 \begin{verbatim}
77 f x =
78   runST ( \ s -> let
79                     (a, s')  = newArray# 100 [] s
80                     (_, s'') = fill_in_array_or_something a x s'
81                   in
82                   freezeArray# a s'' )
83 \end{verbatim}
84 If we inline @runST@, we'll get:
85 \begin{verbatim}
86 f x = let
87         (a, s')  = newArray# 100 [] realWorld#{-NB-}
88         (_, s'') = fill_in_array_or_something a x s'
89       in
90       freezeArray# a s''
91 \end{verbatim}
92 And now the @newArray#@ binding can be floated to become a CAF, which
93 is totally and utterly wrong:
94 \begin{verbatim}
95 f = let
96     (a, s')  = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
97     in
98     \ x ->
99         let (_, s'') = fill_in_array_or_something a x s' in
100         freezeArray# a s''
101 \end{verbatim}
102 All calls to @f@ will share a {\em single} array!  End SLPJ 95/04.
103
104 \begin{code}
105 runST :: (All s => ST s a) -> a
106 runST st = 
107   case st of
108         ST m -> case m realWorld# of
109                         STret _ r -> r
110 \end{code}