← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/base/GHC/Pack.lhs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

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