Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/1561cd8246f541fe2887a30004a4a453dedc2762 >--------------------------------------------------------------- commit 1561cd8246f541fe2887a30004a4a453dedc2762 Author: Max Bolingbroke <[email protected]> Date: Tue Oct 11 13:43:26 2011 +0100 Combine two calls to 'ord' (seems to be just slightly faster) >--------------------------------------------------------------- GHC/IO/Encoding/Failure.hs | 28 ++++++++++------------------ 1 files changed, 10 insertions(+), 18 deletions(-) diff --git a/GHC/IO/Encoding/Failure.hs b/GHC/IO/Encoding/Failure.hs index 4d45c46..f1e03dd 100644 --- a/GHC/IO/Encoding/Failure.hs +++ b/GHC/IO/Encoding/Failure.hs @@ -90,29 +90,21 @@ isSurrogate :: Char -> Bool isSurrogate c = (0xD800 <= x && x <= 0xDBFF) || (0xDC00 <= x && x <= 0xDFFF) where x = ord c --- | We use some private-use characters for roundtripping unknown bytes through a String -{-# INLINE isRoundtripEscapeChar #-} -isRoundtripEscapeChar :: Char -> Bool -isRoundtripEscapeChar c = 0xEF00 <= x && x < 0xF000 - where x = ord c - --- | We use some surrogate characters for roundtripping unknown bytes through a String -{-# INLINE isRoundtripEscapeSurrogateChar #-} -isRoundtripEscapeSurrogateChar :: Char -> Bool -isRoundtripEscapeSurrogateChar c = 0xDC00 <= x && x < 0xDD00 - where x = ord c - --- Private use characters (in Strings) --> lone surrogates (in Buffer CharBufElem) +-- | Private use characters (in Strings) --> lone surrogates (in Buffer CharBufElem) +-- (We use some private-use characters for roundtripping unknown bytes through a String) {-# INLINE surrogatifyRoundtripCharacter #-} surrogatifyRoundtripCharacter :: Char -> Char -surrogatifyRoundtripCharacter c | isRoundtripEscapeChar c = chr (ord c - (0xEF00 - 0xDC00)) - | otherwise = c +surrogatifyRoundtripCharacter c | 0xEF00 <= x && x < 0xF000 = chr (x - (0xEF00 - 0xDC00)) + | otherwise = c + where x = ord c --- Lone surrogates (in Buffer CharBufElem) --> private use characters (in Strings) +-- | Lone surrogates (in Buffer CharBufElem) --> private use characters (in Strings) +-- (We use some surrogate characters for roundtripping unknown bytes through a String) {-# INLINE desurrogatifyRoundtripCharacter #-} desurrogatifyRoundtripCharacter :: Char -> Char -desurrogatifyRoundtripCharacter c | isRoundtripEscapeSurrogateChar c = chr (ord c - (0xDC00 - 0xEF00)) - | otherwise = c +desurrogatifyRoundtripCharacter c | 0xDC00 <= x && x < 0xDD00 = chr (x - (0xDC00 - 0xEF00)) + | otherwise = c + where x = ord c -- Bytes (in Buffer Word8) --> lone surrogates (in Buffer CharBufElem) {-# INLINE escapeToRoundtripCharacterSurrogate #-} _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
