haskell/encoding
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Decoding arrays are unboxed (thus strict) now

Browse Source 
darcs-hash:20090225075818-a4fee-f558e4bde484482e0987c8623c3b2ec54ac4e394
This commit is contained in:
Henning Guenther 2009-02-24 23:58:18 -08:00
parent 3b3f042529
commit 6eb2d51ee2
2 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Data/Encoding/Base.hs
View File

@ -6,7 +6,7 @@ import Data.Encoding.ByteSource
import Data.Encoding.ByteSink import Data.Encoding.ByteSink
import Control.Throws import Control.Throws
import Data.Array as Array import Data.Array.Unboxed as Array
import Data.Map as Map hiding ((!)) import Data.Map as Map hiding ((!))
import Data.Word import Data.Word
import Data.Char import Data.Char
@ -64,17 +64,19 @@ encodeWithMap2 mp c = case Map.lookup c mp of
encodeableWithMap :: Map Char a -> Char -> Bool encodeableWithMap :: Map Char a -> Char -> Bool
encodeableWithMap = flip Map.member encodeableWithMap = flip Map.member
decodeWithArray :: ByteSource m => Array Word8 (Maybe Char) -> m Char decodeWithArray :: ByteSource m => UArray Word8 Int -> m Char
decodeWithArray arr = do decodeWithArray arr = do
w <- fetchWord8 w <- fetchWord8
case arr!w of let res = arr!w
Nothing -> throwException $ IllegalCharacter w if res < 0
Just c -> return c then throwException $ IllegalCharacter w
else return $ chr res
decodeWithArray2 :: ByteSource m => Array (Word8,Word8) (Maybe Char) -> m Char decodeWithArray2 :: ByteSource m => UArray (Word8,Word8) Int -> m Char
decodeWithArray2 arr = do decodeWithArray2 arr = do
w1 <- fetchWord8 w1 <- fetchWord8
w2 <- fetchWord8 w2 <- fetchWord8
case arr!(w1,w2) of let res = arr!(w1,w2)
Nothing -> throwException $ IllegalCharacter w1 if res < 0
Just c -> return c then throwException $ IllegalCharacter w1
else return $ chr res

13
Data/Encoding/Helper/Template.hs
View File

@ -6,7 +6,7 @@ import Data.Bits
import Data.Char import Data.Char
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Data.Map as Map (fromList,lookup) import Data.Map as Map (fromList,lookup)
import Data.Array import Data.Array.Unboxed
import Data.Typeable import Data.Typeable
import Language.Haskell.TH import Language.Haskell.TH
@ -27,10 +27,11 @@ makeJISInstance name file = do
encodingInstance :: Name -> Name -> Name -> String -> Exp -> Exp -> [Dec] encodingInstance :: Name -> Name -> Name -> String -> Exp -> Exp -> [Dec]
encodingInstance enc dec able name mp arr encodingInstance enc dec able name mp arr
= [ DataD [] rname [] [NormalC rname []] [''Show,''Eq,''Typeable] = [ DataD [] rname [] [NormalC rname []] [''Show,''Eq,''Typeable]
, ValD (VarP rmp) (NormalB mp) []
, InstanceD [] (AppT (ConT ''Encoding) (ConT rname)) , InstanceD [] (AppT (ConT ''Encoding) (ConT rname))
[FunD 'encodeChar [FunD 'encodeChar
[Clause [WildP] (NormalB $ AppE (VarE enc) (VarE rmp)) [Clause [WildP] (NormalB $ AppE (VarE enc) (VarE rmp))
[ValD (VarP rmp) (NormalB mp) []] []
] ]
,FunD 'decodeChar ,FunD 'decodeChar
[Clause [WildP] (NormalB $ AppE (VarE dec) (VarE rarr)) [Clause [WildP] (NormalB $ AppE (VarE dec) (VarE rarr))
@ -38,14 +39,14 @@ encodingInstance enc dec able name mp arr
] ]
,FunD 'encodeable ,FunD 'encodeable
[Clause [WildP] (NormalB $ AppE (VarE able) (VarE rmp)) [Clause [WildP] (NormalB $ AppE (VarE able) (VarE rmp))
[ValD (VarP rmp) (NormalB mp) []] []
] ]
] ]
] ]
where where
rname = mkName name rname = mkName name
rarr = mkName "arr" rarr = mkName "arr"
rmp = mkName "mp" rmp = mkName ("decoding_map_"++name)
createCharArray :: [(Integer,Maybe Char)] -> Integer -> Integer -> Q Exp createCharArray :: [(Integer,Maybe Char)] -> Integer -> Integer -> Q Exp
createCharArray lst f t = createArray (map (\(x,y) -> createCharArray lst f t = createArray (map (\(x,y) ->
@ -64,8 +65,8 @@ integerExp :: Integer -> Exp
integerExp i = LitE $ IntegerL i integerExp i = LitE $ IntegerL i
mbCharToExp :: Maybe Char -> Exp mbCharToExp :: Maybe Char -> Exp
mbCharToExp Nothing = ConE 'Nothing mbCharToExp Nothing = LitE (IntegerL (-1))
mbCharToExp (Just c) = AppE (ConE 'Just) (LitE $ CharL c) mbCharToExp (Just c) = LitE (IntegerL $ fromIntegral $ ord c)
createArray :: [(Exp,Exp)] -> Exp -> Exp -> Q Exp createArray :: [(Exp,Exp)] -> Exp -> Exp -> Q Exp
createArray lst from to createArray lst from to