GHC/Exts.hs (original) (raw)

module GHC.Exts (

    Int(..),Word(..),Float(..),Double(..),
    Char(..),
    Ptr(..), FunPtr(..),

    
    maxTupleSize,

    
    module GHC.Prim,
    shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
    uncheckedShiftL64#, uncheckedShiftRL64#,
    uncheckedIShiftL64#, uncheckedIShiftRA64#,

    
    build, augment,

    
    IsString(..),

    
    breakpoint, breakpointCond,

    
    lazy, inline,

    
    Down(..), groupWith, sortWith, the,

    
    traceEvent,

    
    SpecConstrAnnotation(..),

    
    currentCallStack,

    
    Constraint
   ) where

import Prelude

import GHC.Prim import GHC.Base import GHC.Magic import GHC.Word import GHC.Int import GHC.Ptr import GHC.Stack import Data.String import Data.List import Data.Data import Data.Ord import qualified Debug.Trace

maxTupleSize :: Int maxTupleSize = 62

the :: Eq a => [a] -> a the (x:xs) | all (x ==) xs = x | otherwise = error "GHC.Exts.the: non-identical elements" the [] = error "GHC.Exts.the: empty list"

sortWith :: Ord b => (a -> b) -> [a] -> [a] sortWith f = sortBy (\x y -> compare (f x) (f y))

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

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

traceEvent :: String -> IO () traceEvent = Debug.Trace.traceEventIO

data SpecConstrAnnotation = NoSpecConstr | ForceSpecConstr deriving( Data, Typeable, Eq )