summaryrefslogtreecommitdiff
path: root/libraries/base/GHC/Exts.hs
blob: f5b2498542311141ccd3bd084f7413bb3752b933 (plain)
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
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}

-----------------------------------------------------------------------------
-- |
-- 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
       (
        -- ** Pointer types
        Ptr(..), FunPtr(..),

        -- ** Other primitive types
        module GHC.Types,

        -- ** Legacy interface for arrays of arrays
        module GHC.ArrayArray,

        -- * Primitive operations

        module GHC.Prim,
        module GHC.Prim.Ext,

        -- ** Running 'RealWorld' state thread
        runRW#,

        -- ** Bit shift operations
        shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,

        -- ** Pointer comparison operations
        -- See `Note [Pointer comparison operations]` in primops.txt.pp
        reallyUnsafePtrEquality,
        eqStableName#,
        sameArray#,
        sameMutableArray#,
        sameSmallArray#,
        sameSmallMutableArray#,
        sameByteArray#,
        sameMutableByteArray#,
        sameMVar#,
        sameMutVar#,
        sameTVar#,
        sameIOPort#,

        -- ** 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 lists
        IsList(..),

        -- * Transform comprehensions
        Down(..), groupWith, sortWith, the,

        -- * Strings
        -- ** Overloaded string literals
        IsString(..),

        -- ** CString
        unpackCString#,
        unpackAppendCString#,
        unpackFoldrCString#,
        unpackCStringUtf8#,
        unpackNBytes#,
        cstringLength#,

        -- * Debugging
        -- ** Breakpoints
        breakpoint, breakpointCond,

        -- ** Event logging
        traceEvent,

        -- ** The call stack
        currentCallStack,

        -- * Ids with special behaviour
        inline, noinline, lazy, oneShot, considerAccessible,

        -- * SpecConstr annotations
        SpecConstrAnnotation(..), SPEC (..),

        -- * Coercions
        -- ** Safe coercions
        --
        -- | These are available from the /Trustworthy/ module "Data.Coerce" as well.
        --
        -- @since 4.7.0.0
        Data.Coerce.coerce,

        -- ** Very unsafe coercion
        unsafeCoerce#,

        -- ** Casting class dictionaries with single methods
        WithDict(..),

        -- * The maximum tuple size
        maxTupleSize,
       ) where

import GHC.Prim hiding ( coerce )
import GHC.Types
  hiding ( IO   -- Exported from "GHC.IO"
         , Type -- Exported from "Data.Kind"

           -- GHC's internal representation of 'TyCon's, for 'Typeable'
         , Module, TrName, TyCon, TypeLitSort, KindRep, KindBndr )
import qualified GHC.Prim.Ext
import GHC.ArrayArray
import GHC.Base hiding ( coerce )
import GHC.Ptr
import GHC.Stack
import GHC.IsList (IsList(..)) -- for re-export

import qualified Data.Coerce
import Data.String
import Data.OldList
import Data.Data
import Data.Ord
import qualified Debug.Trace
import Unsafe.Coerce ( unsafeCoerce# ) -- just for re-export

-- XXX This should really be in Data.Tuple, where the definitions are
maxTupleSize :: Int
maxTupleSize = 64

-- | '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
--
-- In general if the user supplied function is expensive to compute then
-- you should probably be using 'Data.List.sortOn', as it only needs
-- to compute it once for each element. 'sortWith', on the other hand
-- must compute the mapping function for every comparison that it performs.
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
                         )



-- | 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 #)

-- | Semantically, @considerAccessible = True@. But it has special meaning
-- to the pattern-match checker, which will never flag the clause in which
-- 'considerAccessible' occurs as a guard as redundant or inaccessible.
-- Example:
--
-- > case (x, x) of
-- >   (True,  True)  -> 1
-- >   (False, False) -> 2
-- >   (True,  False) -> 3 -- Warning: redundant
--
-- The pattern-match checker will warn here that the third clause is redundant.
-- It will stop doing so if the clause is adorned with 'considerAccessible':
--
-- > case (x, x) of
-- >   (True,  True)  -> 1
-- >   (False, False) -> 2
-- >   (True,  False) | considerAccessible -> 3 -- No warning
--
-- Put 'considerAccessible' as the last statement of the guard to avoid get
-- confusing results from the pattern-match checker, which takes \"consider
-- accessible\" by word.
considerAccessible :: Bool
considerAccessible = True