1 module PreludeBuiltin (
13 import List ( (++), foldr, takeWhile )
14 import TyArray ( Array(..) )
15 import PreludeErrIO ( errorIO )
16 import PreludeGlaST -- state transformer stuff
17 import PreludeDialogueIO ( appendChan# )
18 #ifndef __PARALLEL_HASKELL__
19 import PreludeGlaMisc ( deRefStablePtr )
21 import PS ( _PackedString, _unpackPS )
22 import Stdio ( _FILE )
25 ---------------------------------------------------------------
27 packCString# :: [Char] -> ByteArray#
29 packCString# str = packString# str -- ToDo: more satisfactorily
32 ---------------------------------------------------------------
33 -- ******** defns of `error' and `trace' using Glasgow IO *****
34 -- No specialised versions are required for these bottoming Ids
37 error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
39 error__ :: (_FILE -> PrimIO ()) -> String -> a
42 #ifdef __PARALLEL_HASKELL__
43 = errorIO (msg_hdr sTDERR{-msg hdr-} `seqPrimIO`
44 _ccall_ fflush sTDERR `seqPrimIO`
45 appendChan# sTDERR s `seqPrimIO`
46 _ccall_ fflush sTDERR `seqPrimIO`
47 _ccall_ stg_exit (1::Int)
50 = errorIO (msg_hdr sTDERR{-msg hdr-} `seqPrimIO`
51 _ccall_ fflush sTDERR `seqPrimIO`
52 appendChan# sTDERR s `seqPrimIO`
53 _ccall_ fflush sTDERR `seqPrimIO`
54 _ccall_ getErrorHandler `thenPrimIO` \ errorHandler ->
55 if errorHandler == (-1::Int)
56 then _ccall_ stg_exit (1::Int)
58 _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
59 `thenPrimIO` \ osptr ->
60 _ccall_ decrementErrorCount `thenPrimIO` \ () ->
61 deRefStablePtr osptr `thenPrimIO` \ oact ->
64 #endif {- !parallel -}
66 sTDERR = (``stderr'' :: _FILE)
68 absent# = error "Oops! The program has entered an `absent' argument!\n"
70 parError# = error "Oops! Entered parError# (a GHC bug -- please report it!)\n"
72 ---------------------------------------------------------------
73 _runST m = case m (S# realWorld#) of
76 ---------------------------------------------------------------
77 -- Used for compiler-generated error message;
78 -- encoding saves bytes of string junk.
80 patError# :: String -> a
83 = error__ (\ x -> _ccall_ PatErrorHdrHook x) (expand (encoded_msg ++ "\n"))
86 expand ('%':next:rest)
91 'D' -> "No default method for \""
92 'N' -> ": non-exhaustive guards"
93 'F' -> "incomplete pattern(s) to match in function \""
94 'L' -> "pattern-matching failed in lambda"
95 'C' -> "pattern-matching failed in case"
96 '~' -> ": pattern-match failed on an irrefutable pattern"
98 _ -> error ("BAD call to builtin patError#:" ++ (next:rest))
100 decoded ++ expand rest
102 expand (c:rest) = c : expand rest
104 ---------------------------------------------------------------
105 -- ******** defn of `_trace' using Glasgow IO *******
107 --{-# GENERATE_SPECS _trace a #-}
108 _trace :: String -> a -> a
111 = unsafePerformPrimIO (
112 ((_ccall_ PreTraceHook sTDERR{-msg-})::PrimIO ()) `seqPrimIO`
113 appendChan# sTDERR string `seqPrimIO`
114 ((_ccall_ PostTraceHook sTDERR{-msg-})::PrimIO ()) `seqPrimIO`
117 sTDERR = (``stderr'' :: _FILE)