Repository : ssh://darcs.haskell.org//srv/darcs/packages/ghc-prim On branch : ghc-generics
http://hackage.haskell.org/trac/ghc/changeset/e94e44729833a51dc39970746ea90dd992f2189d >--------------------------------------------------------------- commit e94e44729833a51dc39970746ea90dd992f2189d Author: Jose Pedro Magalhaes <[email protected]> Date: Tue May 3 11:49:11 2011 +0200 Add new module GHC.CString with functions relating to CString (moved from GHC.Base). Updated the base type modules so that the Generics flag is on (the CString functions are required because the generic representation uses strings). >--------------------------------------------------------------- GHC/CString.hs | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ GHC/Ordering.hs | 5 +- GHC/Tuple.hs | 5 +- GHC/Types.hs | 13 ++++-- GHC/Unit.hs | 3 +- ghc-prim.cabal | 1 + 6 files changed, 143 insertions(+), 10 deletions(-) diff --git a/GHC/CString.hs b/GHC/CString.hs new file mode 100644 index 0000000..d51eaf6 --- /dev/null +++ b/GHC/CString.hs @@ -0,0 +1,126 @@ + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.CString +-- Copyright : (c) The University of Glasgow 2011 +-- License : see libraries/ghc-prim/LICENSE +-- +-- Maintainer : [email protected] +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- GHC C strings definitions (previously in GHC.Base). +-- Use GHC.Exts from the base package instead of importing this +-- module directly. +-- +----------------------------------------------------------------------------- + +{-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# OPTIONS_GHC -XNoGenerics #-} +{-# OPTIONS_GHC -XBangPatterns #-} + +module GHC.CString ( + unpackCString#, unpackAppendCString#, unpackFoldrCString# + , unpackCStringUtf8#, unpackNBytes# + ) where + +import {-# SOURCE #-} GHC.Types +import GHC.Prim + +----------------------------------------------------------------------------- +-- Unpacking C strings} +----------------------------------------------------------------------------- + +-- This code is needed for virtually all programs, since it's used for +-- unpacking the strings of error messages. + +-- Used to be in GHC.Base, but was moved to ghc-prim because the new generics +-- stuff uses Strings in the representation, so to give representations for +-- ghc-prim types we need unpackCString# + +unpackCString# :: Addr# -> [Char] +{-# NOINLINE unpackCString# #-} + -- There's really no point in inlining this, ever, cos + -- the loop doesn't specialise in an interesting + -- But it's pretty small, so there's a danger that + -- it'll be inlined at every literal, which is a waste +unpackCString# addr + = unpack 0# + where + unpack nh + | ch `eqChar#` '\0'# = [] + | True = C# ch : unpack (nh +# 1#) + where + !ch = indexCharOffAddr# addr nh + +unpackAppendCString# :: Addr# -> [Char] -> [Char] +{-# NOINLINE unpackAppendCString# #-} + -- See the NOINLINE note on unpackCString# +unpackAppendCString# addr rest + = unpack 0# + where + unpack nh + | ch `eqChar#` '\0'# = rest + | True = C# ch : unpack (nh +# 1#) + where + !ch = indexCharOffAddr# addr nh + +unpackFoldrCString# :: Addr# -> (Char -> a -> a) -> a -> a + +-- Usually the unpack-list rule turns unpackFoldrCString# into unpackCString# + +-- It also has a BuiltInRule in PrelRules.lhs: +-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) +-- = unpackFoldrCString# "foobaz" c n + +{-# NOINLINE unpackFoldrCString# #-} +-- At one stage I had NOINLINE [0] on the grounds that, unlike +-- unpackCString#, there *is* some point in inlining +-- unpackFoldrCString#, because we get better code for the +-- higher-order function call. BUT there may be a lot of +-- literal strings, and making a separate 'unpack' loop for +-- each is highly gratuitous. See nofib/real/anna/PrettyPrint. + +unpackFoldrCString# addr f z + = unpack 0# + where + unpack nh + | ch `eqChar#` '\0'# = z + | True = C# ch `f` unpack (nh +# 1#) + where + !ch = indexCharOffAddr# addr nh + +unpackCStringUtf8# :: Addr# -> [Char] +unpackCStringUtf8# addr + = unpack 0# + where + unpack nh + | ch `eqChar#` '\0'# = [] + | ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#) + | ch `leChar#` '\xDF'# = + C# (chr# (((ord# ch -# 0xC0#) `uncheckedIShiftL#` 6#) +# + (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) : + unpack (nh +# 2#) + | ch `leChar#` '\xEF'# = + C# (chr# (((ord# ch -# 0xE0#) `uncheckedIShiftL#` 12#) +# + ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 6#) +# + (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) : + unpack (nh +# 3#) + | True = + C# (chr# (((ord# ch -# 0xF0#) `uncheckedIShiftL#` 18#) +# + ((ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12#) +# + ((ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#` 6#) +# + (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) : + unpack (nh +# 4#) + where + !ch = indexCharOffAddr# addr nh + +unpackNBytes# :: Addr# -> Int# -> [Char] +unpackNBytes# _addr 0# = [] +unpackNBytes# addr len# = unpack [] (len# -# 1#) + where + unpack acc i# + | i# <# 0# = acc + | True = + case indexCharOffAddr# addr i# of + ch -> unpack (C# ch : acc) (i# -# 1#) diff --git a/GHC/Ordering.hs b/GHC/Ordering.hs index 95831de..6b5942e 100644 --- a/GHC/Ordering.hs +++ b/GHC/Ordering.hs @@ -1,11 +1,12 @@ {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} +{-# OPTIONS_GHC -XGenerics #-} module GHC.Ordering where --- We need Inl etc behind the scenes for the Ordering definition +-- We need generics behind the scenes for the Ordering definition import GHC.Generics () +import GHC.CString () default () diff --git a/GHC/Tuple.hs b/GHC/Tuple.hs index 4ddc0eb..5179b84 100644 --- a/GHC/Tuple.hs +++ b/GHC/Tuple.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} +{-# OPTIONS_GHC -XGenerics #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Tuple @@ -16,8 +16,9 @@ module GHC.Tuple where --- We need Inl etc behind the scenes for the tuple definitions +-- We need generics behind the scenes for the tuple definitions import GHC.Generics () +import GHC.CString () default () -- Double and Integer aren't available yet diff --git a/GHC/Types.hs b/GHC/Types.hs index ca63c31..a9bf57f 100644 --- a/GHC/Types.hs +++ b/GHC/Types.hs @@ -15,13 +15,17 @@ ----------------------------------------------------------------------------- {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} +{-# OPTIONS_GHC -XGenerics #-} -module GHC.Types (Bool(..), Char(..), Int(..), Float(..), Double(..), IO(..)) where +module GHC.Types ( + Bool(..), Char(..), Int(..) + , Float(..), Double(..), IO(..) + ) where import GHC.Prim --- We need Inl etc behind the scenes for the type definitions -import GHC.Generics () -- JPM: Do we really need this? +-- We need generics behind the scenes for the type definitions +import GHC.Generics () +import GHC.CString () infixr 5 : @@ -72,4 +76,3 @@ at some point, directly or indirectly, from @Main.main@. or the '>>' and '>>=' operations from the 'Monad' class. -} newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) - diff --git a/GHC/Unit.hs b/GHC/Unit.hs index 62d2d28..2d7176d 100644 --- a/GHC/Unit.hs +++ b/GHC/Unit.hs @@ -1,10 +1,11 @@ {-# OPTIONS_GHC -XNoImplicitPrelude #-} -{-# OPTIONS_GHC -XNoGenerics #-} +{-# OPTIONS_GHC -XGenerics #-} module GHC.Unit where import GHC.Generics () +import GHC.CString () default () diff --git a/ghc-prim.cabal b/ghc-prim.cabal index 04e45cd..b092806 100644 --- a/ghc-prim.cabal +++ b/ghc-prim.cabal @@ -32,6 +32,7 @@ Library { GHC.Tuple GHC.Types GHC.Unit + GHC.CString if flag(include-ghc-prim) { exposed-modules: GHC.Prim _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
