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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
|
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE MagicHash, UnboxedTuples, TypeFamilies, DeriveDataTypeable,
MultiParamTypeClasses, FlexibleInstances, NoImplicitPrelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Exts
-- Copyright : (c) The University of Glasgow 2002
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc@haskell.org
-- Stability : internal
-- Portability : non-portable (GHC Extensions)
--
-- GHC Extensions: this is the Approved Way to get at GHC-specific extensions.
--
-- Note: no other base module should import this module.
-----------------------------------------------------------------------------
module GHC.Exts
(
-- * Representations of some basic types
Int(..),Word(..),Float(..),Double(..),
Char(..),
Ptr(..), FunPtr(..),
-- * The maximum tuple size
maxTupleSize,
-- * Primitive operations
module GHC.Prim,
module GHC.Prim.Ext,
shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
uncheckedShiftL64#, uncheckedShiftRL64#,
uncheckedIShiftL64#, uncheckedIShiftRA64#,
isTrue#,
-- * Compat wrapper
atomicModifyMutVar#,
-- * Resize functions
--
-- | Resizing arrays of boxed elements is currently handled in
-- library space (rather than being a primop) since there is not
-- an efficient way to grow arrays. However, resize operations
-- may become primops in a future release of GHC.
resizeSmallMutableArray#,
-- * Fusion
build, augment,
-- * Overloaded string literals
IsString(..),
-- * Debugging
breakpoint, breakpointCond,
-- * Ids with special behaviour
inline, noinline, lazy, oneShot,
-- * Running 'RealWorld' state thread
runRW#,
-- * Safe coercions
--
-- | These are available from the /Trustworthy/ module "Data.Coerce" as well
--
-- @since 4.7.0.0
Data.Coerce.coerce, Data.Coerce.Coercible,
-- * Very unsafe coercion
unsafeCoerce#,
-- * Equality
type (~~),
-- * Representation polymorphism
GHC.Prim.TYPE, RuntimeRep(..), VecCount(..), VecElem(..),
-- * Transform comprehensions
Down(..), groupWith, sortWith, the,
-- * Event logging
traceEvent,
-- * SpecConstr annotations
SpecConstrAnnotation(..),
-- * The call stack
currentCallStack,
-- * The Constraint kind
Constraint,
-- * The Any type
Any,
-- * Overloaded lists
IsList(..)
) where
import GHC.Prim hiding ( coerce, TYPE )
import qualified GHC.Prim
import qualified GHC.Prim.Ext
import GHC.Base hiding ( coerce )
import GHC.Word
import GHC.Int
import GHC.Ptr
import GHC.Stack
import qualified Data.Coerce
import Data.String
import Data.OldList
import Data.Data
import Data.Ord
import Data.Version ( Version(..), makeVersion )
import qualified Debug.Trace
import Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export
import Control.Applicative (ZipList(..))
-- XXX This should really be in Data.Tuple, where the definitions are
maxTupleSize :: Int
maxTupleSize = 62
-- | 'the' ensures that all the elements of the list are identical
-- and then returns that unique element
the :: Eq a => [a] -> a
the (x:xs)
| all (x ==) xs = x
| otherwise = errorWithoutStackTrace "GHC.Exts.the: non-identical elements"
the [] = errorWithoutStackTrace "GHC.Exts.the: empty list"
-- | The 'sortWith' function sorts a list of elements using the
-- user supplied function to project something out of each element
sortWith :: Ord b => (a -> b) -> [a] -> [a]
sortWith f = sortBy (\x y -> compare (f x) (f y))
-- | The 'groupWith' function uses the user supplied function which
-- projects an element out of every list element in order to first sort the
-- input list and then to form groups by equality on these projected elements
{-# INLINE groupWith #-}
groupWith :: Ord b => (a -> b) -> [a] -> [[a]]
groupWith f xs = build (\c n -> groupByFB c n (\x y -> f x == f y) (sortWith f xs))
{-# INLINE [0] groupByFB #-} -- See Note [Inline FB functions] in GHC.List
groupByFB :: ([a] -> lst -> lst) -> lst -> (a -> a -> Bool) -> [a] -> lst
groupByFB c n eq xs0 = groupByFBCore xs0
where groupByFBCore [] = n
groupByFBCore (x:xs) = c (x:ys) (groupByFBCore zs)
where (ys, zs) = span (eq x) xs
-- -----------------------------------------------------------------------------
-- tracing
traceEvent :: String -> IO ()
traceEvent = Debug.Trace.traceEventIO
{-# DEPRECATED traceEvent "Use 'Debug.Trace.traceEvent' or 'Debug.Trace.traceEventIO'" #-} -- deprecated in 7.4
{- **********************************************************************
* *
* SpecConstr annotation *
* *
********************************************************************** -}
-- Annotating a type with NoSpecConstr will make SpecConstr
-- not specialise for arguments of that type.
-- This data type is defined here, rather than in the SpecConstr module
-- itself, so that importing it doesn't force stupidly linking the
-- entire ghc package at runtime
data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr
deriving ( Data -- ^ @since 4.3.0.0
, Eq -- ^ @since 4.3.0.0
)
{- **********************************************************************
* *
* The IsList class *
* *
********************************************************************** -}
-- | The 'IsList' class and its methods are intended to be used in
-- conjunction with the OverloadedLists extension.
--
-- @since 4.7.0.0
class IsList l where
-- | The 'Item' type function returns the type of items of the structure
-- @l@.
type Item l
-- | The 'fromList' function constructs the structure @l@ from the given
-- list of @Item l@
fromList :: [Item l] -> l
-- | The 'fromListN' function takes the input list's length as a hint. Its
-- behaviour should be equivalent to 'fromList'. The hint can be used to
-- construct the structure @l@ more efficiently compared to 'fromList'. If
-- the given hint does not equal to the input list's length the behaviour of
-- 'fromListN' is not specified.
fromListN :: Int -> [Item l] -> l
fromListN _ = fromList
-- | The 'toList' function extracts a list of @Item l@ from the structure @l@.
-- It should satisfy fromList . toList = id.
toList :: l -> [Item l]
-- | @since 4.7.0.0
instance IsList [a] where
type (Item [a]) = a
fromList = id
toList = id
-- | @since 4.15.0.0
instance IsList (ZipList a) where
type Item (ZipList a) = a
fromList = ZipList
toList = getZipList
-- | @since 4.9.0.0
instance IsList (NonEmpty a) where
type Item (NonEmpty a) = a
fromList (a:as) = a :| as
fromList [] = errorWithoutStackTrace "NonEmpty.fromList: empty list"
toList ~(a :| as) = a : as
-- | @since 4.8.0.0
instance IsList Version where
type (Item Version) = Int
fromList = makeVersion
toList = versionBranch
-- | Be aware that 'fromList . toList = id' only for unfrozen 'CallStack's,
-- since 'toList' removes frozenness information.
--
-- @since 4.9.0.0
instance IsList CallStack where
type (Item CallStack) = (String, SrcLoc)
fromList = fromCallSiteList
toList = getCallStack
-- | An implementation of the old @atomicModifyMutVar#@ primop in
-- terms of the new 'atomicModifyMutVar2#' primop, for backwards
-- compatibility. The type of this function is a bit bogus. It's
-- best to think of it as having type
--
-- @
-- atomicModifyMutVar#
-- :: MutVar# s a
-- -> (a -> (a, b))
-- -> State# s
-- -> (# State# s, b #)
-- @
--
-- but there may be code that uses this with other two-field record
-- types.
atomicModifyMutVar#
:: MutVar# s a
-> (a -> b)
-> State# s
-> (# State# s, c #)
atomicModifyMutVar# mv f s =
case unsafeCoerce# (atomicModifyMutVar2# mv f s) of
(# s', _, ~(_, res) #) -> (# s', res #)
-- | Resize a mutable array to new specified size. The returned
-- 'SmallMutableArray#' is either the original 'SmallMutableArray#'
-- resized in-place or, if not possible, a newly allocated
-- 'SmallMutableArray#' with the original content copied over.
--
-- To avoid undefined behaviour, the original 'SmallMutableArray#' shall
-- not be accessed anymore after a 'resizeSmallMutableArray#' has been
-- performed. Moreover, no reference to the old one should be kept in order
-- to allow garbage collection of the original 'SmallMutableArray#' in
-- case a new 'SmallMutableArray#' had to be allocated.
--
-- @since 4.14.0.0
resizeSmallMutableArray#
:: SmallMutableArray# s a -- ^ Array to resize
-> Int# -- ^ New size of array
-> a
-- ^ Newly created slots initialized to this element.
-- Only used when array is grown.
-> State# s
-> (# State# s, SmallMutableArray# s a #)
resizeSmallMutableArray# arr0 szNew a s0 =
case getSizeofSmallMutableArray# arr0 s0 of
(# s1, szOld #) -> if isTrue# (szNew <# szOld)
then case shrinkSmallMutableArray# arr0 szNew s1 of
s2 -> (# s2, arr0 #)
else if isTrue# (szNew ># szOld)
then case newSmallArray# szNew a s1 of
(# s2, arr1 #) -> case copySmallMutableArray# arr0 0# arr1 0# szOld s2 of
s3 -> (# s3, arr1 #)
else (# s1, arr0 #)
|