X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FExts.hs;h=661f5aa275934b6bb43909afd65606ef6f69d72c;hb=fde8cdfd9c57da52b2116884dba6d2b3c7c2fb14;hp=5c3c4957e9a928cf49b8175cf9a54917a4cd791b;hpb=72e4fe7801d2d8ab5b243cbb430272b45010f59d;p=ghc-base.git

diff --git a/GHC/Exts.hs b/GHC/Exts.hs
index 5c3c495..661f5aa 100644
--- a/GHC/Exts.hs
+++ b/GHC/Exts.hs
@@ -19,6 +19,9 @@ module GHC.Exts
         Char(..),
         Ptr(..), FunPtr(..),
 
+        -- * The maximum tuple size
+        maxTupleSize,
+
         -- * Primitive operations
         module GHC.Prim,
         shiftL#, shiftRL#, iShiftL#, iShiftRA#, iShiftRL#,
@@ -38,7 +41,10 @@ module GHC.Exts
         lazy, inline,
 
         -- * Transform comprehensions
-        Down(..), groupWith, sortWith, the
+        Down(..), groupWith, sortWith, the,
+
+        -- * Event logging
+        traceEvent
 
        ) where
 
@@ -46,13 +52,18 @@ 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
+maxTupleSize = 62
 
 -- | The 'Down' type allows you to reverse sort order conveniently.  A value of type
 -- @'Down' a@ contains a value of type @a@ (represented as @'Down' a@).
@@ -86,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', () #)