X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FExts.hs;h=81a9dbb4edb399c29d2fb9fc1e96053332f39572;hb=41e8fba828acbae1751628af50849f5352b27873;hp=7dc604f9eccc9e61316daac14f6f5d05b50171f6;hpb=81013c3eff32c6f2959e88fc0f73a77d9d35ca77;p=ghc-base.git

diff --git a/GHC/Exts.hs b/GHC/Exts.hs
index 7dc604f..81a9dbb 100644
--- a/GHC/Exts.hs
+++ b/GHC/Exts.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Exts
@@ -41,7 +43,13 @@ module GHC.Exts
         lazy, inline,
 
         -- * Transform comprehensions
-        Down(..), groupWith, sortWith, the
+        Down(..), groupWith, sortWith, the,
+
+        -- * Event logging
+        traceEvent,
+
+        -- * SpecConstr annotations
+        SpecConstrAnnotation(..)
 
        ) where
 
@@ -49,13 +57,15 @@ 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
+import Data.Data
 
 -- XXX This should really be in Data.Tuple, where the definitions are
 maxTupleSize :: Int
@@ -93,8 +103,35 @@ 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', () #)
+
+
+
+{- **********************************************************************
+*									*
+*              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, Typeable, Eq )
+