Remove Control.Parallel*, now in package parallel
[packages/random.git] / GHC / Pack.lhs
1 \begin{code}
2 {-# OPTIONS_GHC -fno-implicit-prelude #-}
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module      :  GHC.Pack
6 -- Copyright   :  (c) The University of Glasgow 1997-2002
7 -- License     :  see libraries/base/LICENSE
8 -- 
9 -- Maintainer  :  cvs-ghc@haskell.org
10 -- Stability   :  internal
11 -- Portability :  non-portable (GHC Extensions)
12 --
13 -- This module provides a small set of low-level functions for packing
14 -- and unpacking a chunk of bytes. Used by code emitted by the compiler
15 -- plus the prelude libraries.
16 -- 
17 -- The programmer level view of packed strings is provided by a GHC
18 -- system library PackedString.
19 --
20 -----------------------------------------------------------------------------
21
22 -- #hide
23 module GHC.Pack
24        (
25         -- (**) - emitted by compiler.
26
27         packCString#,      -- :: [Char] -> ByteArray#    (**)
28         unpackCString,
29         unpackCString#,    -- :: Addr# -> [Char]         (**)
30         unpackNBytes#,     -- :: Addr# -> Int# -> [Char] (**)
31         unpackFoldrCString#,  -- (**)
32         unpackAppendCString#,  -- (**)
33        ) 
34         where
35
36 import GHC.Base
37 import GHC.Err ( error )
38 import GHC.List ( length )
39 import GHC.ST
40 import GHC.Num
41 import GHC.Ptr
42
43 data ByteArray ix              = ByteArray        ix ix ByteArray#
44 data MutableByteArray s ix     = MutableByteArray ix ix (MutableByteArray# s)
45
46 unpackCString :: Ptr a -> [Char]
47 unpackCString a@(Ptr addr)
48   | a == nullPtr  = []
49   | otherwise      = unpackCString# addr
50
51 packCString#         :: [Char]          -> ByteArray#
52 packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
53
54 packString :: [Char] -> ByteArray Int
55 packString str = runST (packStringST str)
56
57 packStringST :: [Char] -> ST s (ByteArray Int)
58 packStringST str =
59   let len = length str  in
60   packNBytesST len str
61
62 packNBytesST :: Int -> [Char] -> ST s (ByteArray Int)
63 packNBytesST (I# length#) str =
64   {- 
65    allocate an array that will hold the string
66    (not forgetting the NUL byte at the end)
67   -}
68  new_ps_array (length# +# 1#) >>= \ ch_array ->
69    -- fill in packed string from "str"
70  fill_in ch_array 0# str   >>
71    -- freeze the puppy:
72  freeze_ps_array ch_array length#
73  where
74   fill_in :: MutableByteArray s Int -> Int# -> [Char] -> ST s ()
75   fill_in arr_in# idx [] =
76    write_ps_array arr_in# idx (chr# 0#) >>
77    return ()
78
79   fill_in arr_in# idx (C# c : cs) =
80    write_ps_array arr_in# idx c  >>
81    fill_in arr_in# (idx +# 1#) cs
82
83 -- (Very :-) ``Specialised'' versions of some CharArray things...
84
85 new_ps_array    :: Int# -> ST s (MutableByteArray s Int)
86 write_ps_array  :: MutableByteArray s Int -> Int# -> Char# -> ST s () 
87 freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
88
89 new_ps_array size = ST $ \ s ->
90     case (newByteArray# size s)   of { (# s2#, barr# #) ->
91     (# s2#, MutableByteArray bot bot barr# #) }
92   where
93     bot = error "new_ps_array"
94
95 write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
96     case writeCharArray# barr# n ch s#  of { s2#   ->
97     (# s2#, () #) }
98
99 -- same as unsafeFreezeByteArray
100 freeze_ps_array (MutableByteArray _ _ arr#) len# = ST $ \ s# ->
101     case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->
102     (# s2#, ByteArray 0 (I# len#) frozen# #) }
103 \end{code}