projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Use a proper exception for IOEnvFailure, not just a UserError
[ghc-hetmet.git]
/
compiler
/
utils
/
Encoding.hs
diff --git
a/compiler/utils/Encoding.hs
b/compiler/utils/Encoding.hs
index
152bf3c
..
c790f38
100644
(file)
--- a/
compiler/utils/Encoding.hs
+++ b/
compiler/utils/Encoding.hs
@@
-1,3
+1,7
@@
+{-# OPTIONS_GHC -O #-}
+-- We always optimise this, otherwise performance of a non-optimised
+-- compiler is severely affected
+
-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow, 1997-2006
-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow, 1997-2006
@@
-23,12
+27,11
@@
module Encoding (
zDecodeString
) where
zDecodeString
) where
-#define COMPILING_FAST_STRING
#include "HsVersions.h"
import Foreign
#include "HsVersions.h"
import Foreign
-import Data.Char ( ord, chr, isDigit, digitToInt, isHexDigit )
-import Numeric ( showHex )
-
+import Data.Char ( ord, chr, isDigit, digitToInt, intToDigit,
+ isHexDigit )
+import Numeric ( showIntAtBase )
import Data.Bits
import GHC.Ptr ( Ptr(..) )
import GHC.Base
import Data.Bits
import GHC.Ptr ( Ptr(..) )
import GHC.Base
@@
-134,10
+137,12
@@
countUTF8Chars ptr bytes = go ptr 0
| ptr >= end = return n
| otherwise = do
case utf8DecodeChar# (unPtr ptr) of
| ptr >= end = return n
| otherwise = do
case utf8DecodeChar# (unPtr ptr) of
- (# c, a #) -> go (Ptr a) (n+1)
+ (# _, a #) -> go (Ptr a) (n+1)
+unPtr :: Ptr a -> Addr#
unPtr (Ptr a) = a
unPtr (Ptr a) = a
+utf8EncodeChar :: Char -> Ptr Word8 -> IO (Ptr Word8)
utf8EncodeChar c ptr =
let x = ord c in
case () of
utf8EncodeChar c ptr =
let x = ord c in
case () of
@@
-165,7
+170,7
@@
utf8EncodeChar c ptr =
utf8EncodeString :: Ptr Word8 -> String -> IO ()
utf8EncodeString ptr str = go ptr str
where STRICT2(go)
utf8EncodeString :: Ptr Word8 -> String -> IO ()
utf8EncodeString ptr str = go ptr str
where STRICT2(go)
- go ptr [] = return ()
+ go _ [] = return ()
go ptr (c:cs) = do
ptr' <- utf8EncodeChar c ptr
go ptr' cs
go ptr (c:cs) = do
ptr' <- utf8EncodeChar c ptr
go ptr' cs
@@
-281,6
+286,9
@@
encode_ch c = 'z' : if isDigit (head hex_str) then hex_str
-- eg. strings of unicode characters come out as 'z1234Uz5678U', we
-- could remove the 'U' in the middle (the 'z' works as a separator).
-- eg. strings of unicode characters come out as 'z1234Uz5678U', we
-- could remove the 'U' in the middle (the 'z' works as a separator).
+ showHex = showIntAtBase 16 intToDigit
+ -- needed because prior to GHC 6.2, Numeric.showHex added a "0x" prefix
+
zDecodeString :: EncodedString -> UserString
zDecodeString [] = []
zDecodeString ('Z' : d : rest)
zDecodeString :: EncodedString -> UserString
zDecodeString [] = []
zDecodeString ('Z' : d : rest)
@@
-323,6
+331,7
@@
decode_lower 'v' = '%'
decode_lower ch = {-pprTrace "decode_lower" (char ch)-} ch
-- Characters not having a specific code are coded as z224U (in hex)
decode_lower ch = {-pprTrace "decode_lower" (char ch)-} ch
-- Characters not having a specific code are coded as z224U (in hex)
+decode_num_esc :: Char -> EncodedString -> UserString
decode_num_esc d rest
= go (digitToInt d) rest
where
decode_num_esc d rest
= go (digitToInt d) rest
where
@@
-360,13
+369,13
@@
maybe_tuple :: UserString -> Maybe EncodedString
maybe_tuple "(# #)" = Just("Z1H")
maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
maybe_tuple "(# #)" = Just("Z1H")
maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
- (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
- other -> Nothing
+ (n, '#' : ')' : _) -> Just ('Z' : shows (n+1) "H")
+ _ -> Nothing
maybe_tuple "()" = Just("Z0T")
maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
maybe_tuple "()" = Just("Z0T")
maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
- (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
- other -> Nothing
-maybe_tuple other = Nothing
+ (n, ')' : _) -> Just ('Z' : shows (n+1) "T")
+ _ -> Nothing
+maybe_tuple _ = Nothing
count_commas :: Int -> String -> (Int, String)
count_commas n (',' : cs) = count_commas (n+1) cs
count_commas :: Int -> String -> (Int, String)
count_commas n (',' : cs) = count_commas (n+1) cs