1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
{-# LANGUAGE MagicHash, NoImplicitPrelude, BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.CString
-- Copyright : (c) The University of Glasgow 2011
-- License : see libraries/ghc-prim/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- GHC C strings definitions (previously in GHC.Base).
-- Use GHC.Exts from the base package instead of importing this
-- module directly.
--
-----------------------------------------------------------------------------
module GHC.CString (
unpackCString#, unpackAppendCString#, unpackFoldrCString#,
unpackCStringUtf8#, unpackNBytes#
) where
import GHC.Types
import GHC.Prim
-----------------------------------------------------------------------------
-- Unpacking C strings
-----------------------------------------------------------------------------
-- This code is needed for virtually all programs, since it's used for
-- unpacking the strings of error messages.
-- Used to be in GHC.Base, but was moved to ghc-prim because the new generics
-- stuff uses Strings in the representation, so to give representations for
-- ghc-prim types we need unpackCString#
{-
Note [Inlining unpackCString#]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There's really no point in ever inlining things like unpackCString# as the loop
doesn't specialise in an interesting way and we can't deforest the list
constructors (we'd want to use unpackFoldrCString# for this). Moreover, it's
pretty small, so there's a danger that it'll be inlined at every literal, which
is a waste.
Moreover, inlining early may interfere with a variety of rules that are supposed
to match unpackCString#,
* BuiltInRules in PrelRules.hs; e.g.
eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)
= s1 == s2
* unpacking rules; e.g. in GHC.Base,
unpackCString# a
= build (unpackFoldrCString# a)
* stream fusion rules; e.g. in the `text` library,
unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
= unpackCString# a
-}
unpackCString# :: Addr# -> [Char]
{-# NOINLINE unpackCString# #-}
unpackCString# addr
= unpack 0#
where
unpack nh
| isTrue# (ch `eqChar#` '\0'#) = []
| True = C# ch : unpack (nh +# 1#)
where
!ch = indexCharOffAddr# addr nh
unpackAppendCString# :: Addr# -> [Char] -> [Char]
{-# NOINLINE unpackAppendCString# #-}
-- See the NOINLINE note on unpackCString#
unpackAppendCString# addr rest
= unpack 0#
where
unpack nh
| isTrue# (ch `eqChar#` '\0'#) = rest
| True = C# ch : unpack (nh +# 1#)
where
!ch = indexCharOffAddr# addr nh
unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a
-- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString#
-- It also has a BuiltInRule in PrelRules.hs:
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)
-- = unpackFoldrCString# "foobaz" c n
{-# NOINLINE unpackFoldrCString# #-}
-- At one stage I had NOINLINE [0] on the grounds that, unlike
-- unpackCString#, there *is* some point in inlining
-- unpackFoldrCString#, because we get better code for the
-- higher-order function call. BUT there may be a lot of
-- literal strings, and making a separate 'unpack' loop for
-- each is highly gratuitous. See nofib/real/anna/PrettyPrint.
unpackFoldrCString# addr f z
= unpack 0#
where
unpack nh
| isTrue# (ch `eqChar#` '\0'#) = z
| True = C# ch `f` unpack (nh +# 1#)
where
!ch = indexCharOffAddr# addr nh
-- There's really no point in inlining this for the same reasons as
-- unpackCString. See Note [Inlining unpackCString#] above for details.
unpackCStringUtf8# :: Addr# -> [Char]
{-# NOINLINE unpackCStringUtf8# #-}
unpackCStringUtf8# addr
= unpack 0#
where
unpack nh
| isTrue# (ch `eqChar#` '\0'# ) = []
| isTrue# (ch `leChar#` '\x7F'#) = C# ch : unpack (nh +# 1#)
| isTrue# (ch `leChar#` '\xDF'#) =
C# (chr# (((ord# ch -# 0xC0#) `uncheckedIShiftL#` 6#) +#
(ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
unpack (nh +# 2#)
| isTrue# (ch `leChar#` '\xEF'#) =
C# (chr# (((ord# ch -# 0xE0#) `uncheckedIShiftL#` 12#) +#
((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 6#) +#
(ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
unpack (nh +# 3#)
| True =
C# (chr# (((ord# ch -# 0xF0#) `uncheckedIShiftL#` 18#) +#
((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +#
((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#` 6#) +#
(ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
unpack (nh +# 4#)
where
!ch = indexCharOffAddr# addr nh
-- There's really no point in inlining this for the same reasons as
-- unpackCString. See Note [Inlining unpackCString#] above for details.
unpackNBytes# :: Addr# -> Int# -> [Char]
{-# NOINLINE unpackNBytes# #-}
unpackNBytes# _addr 0# = []
unpackNBytes# addr len# = unpack [] (len# -# 1#)
where
unpack acc i#
| isTrue# (i# <# 0#) = acc
| True =
case indexCharOffAddr# addr i# of
ch -> unpack (C# ch : acc) (i# -# 1#)
|
