X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FExts.hs;h=661f5aa275934b6bb43909afd65606ef6f69d72c;hb=0bf2fdab482da7a287ef09f18e7656abe62256d0;hp=7dc604f9eccc9e61316daac14f6f5d05b50171f6;hpb=81013c3eff32c6f2959e88fc0f73a77d9d35ca77;p=ghc-base.git diff --git a/GHC/Exts.hs b/GHC/Exts.hs index 7dc604f..661f5aa 100644 --- a/GHC/Exts.hs +++ b/GHC/Exts.hs @@ -41,7 +41,10 @@ module GHC.Exts lazy, inline, -- * Transform comprehensions - Down(..), groupWith, sortWith, the + Down(..), groupWith, sortWith, the, + + -- * Event logging + traceEvent ) where @@ -49,13 +52,14 @@ import Prelude import GHC.Prim import GHC.Base +import GHC.Magic import GHC.Word import GHC.Int -import GHC.Num -import GHC.Float +-- import GHC.Float import GHC.Ptr import Data.String import Data.List +import Foreign.C -- XXX This should really be in Data.Tuple, where the definitions are maxTupleSize :: Int @@ -93,8 +97,16 @@ 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 xs = groupByFBCore xs +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 msg = do + withCString msg $ \(Ptr p) -> IO $ \s -> + case traceEvent# p s of s' -> (# s', () #)