From 6eb2d51ee2b1a8821ccee2d564c7ee9b4b71decf Mon Sep 17 00:00:00 2001
From: Henning Guenther <h.guenther@tu-bs.de>
Date: Tue, 24 Feb 2009 23:58:18 -0800
Subject: [PATCH] Decoding arrays are unboxed (thus strict) now

darcs-hash:20090225075818-a4fee-f558e4bde484482e0987c8623c3b2ec54ac4e394
---
 Data/Encoding/Base.hs            | 20 +++++++++++---------
 Data/Encoding/Helper/Template.hs | 13 +++++++------
 2 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/Data/Encoding/Base.hs b/Data/Encoding/Base.hs
index 98934b2..f4318aa 100644
--- a/Data/Encoding/Base.hs
+++ b/Data/Encoding/Base.hs
@@ -6,7 +6,7 @@ import Data.Encoding.ByteSource
 import Data.Encoding.ByteSink
 
 import Control.Throws
-import Data.Array as Array
+import Data.Array.Unboxed as Array
 import Data.Map as Map hiding ((!))
 import Data.Word
 import Data.Char
@@ -64,17 +64,19 @@ encodeWithMap2 mp c = case Map.lookup c mp of
 encodeableWithMap :: Map Char a -> Char -> Bool
 encodeableWithMap = flip Map.member
 
-decodeWithArray :: ByteSource m => Array Word8 (Maybe Char) -> m Char
+decodeWithArray :: ByteSource m => UArray Word8 Int -> m Char
 decodeWithArray arr = do
   w <- fetchWord8
-  case arr!w of
-    Nothing -> throwException $ IllegalCharacter w
-    Just c -> return c
+  let res = arr!w
+  if res < 0
+    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
   w1 <- fetchWord8
   w2 <- fetchWord8
-  case arr!(w1,w2) of
-    Nothing -> throwException $ IllegalCharacter w1
-    Just c -> return c
\ No newline at end of file
+  let res = arr!(w1,w2)
+  if res < 0
+    then throwException $ IllegalCharacter w1
+    else return $ chr res
\ No newline at end of file
diff --git a/Data/Encoding/Helper/Template.hs b/Data/Encoding/Helper/Template.hs
index d1619b5..60ff9f2 100644
--- a/Data/Encoding/Helper/Template.hs
+++ b/Data/Encoding/Helper/Template.hs
@@ -6,7 +6,7 @@ import Data.Bits
 import Data.Char
 import Data.Maybe (mapMaybe)
 import Data.Map as Map (fromList,lookup)
-import Data.Array
+import Data.Array.Unboxed
 import Data.Typeable
 import Language.Haskell.TH
 
@@ -27,10 +27,11 @@ makeJISInstance name file = do
 encodingInstance :: Name -> Name -> Name -> String -> Exp -> Exp -> [Dec]
 encodingInstance enc dec able name mp arr
     = [ DataD [] rname [] [NormalC rname []] [''Show,''Eq,''Typeable]
+      , ValD (VarP rmp) (NormalB mp) []
       , InstanceD [] (AppT (ConT ''Encoding) (ConT rname))
                       [FunD 'encodeChar
                        [Clause [WildP] (NormalB $ AppE (VarE enc) (VarE rmp))
-                        [ValD (VarP rmp) (NormalB mp) []]
+                        []
                        ]
                       ,FunD 'decodeChar
                        [Clause [WildP] (NormalB $ AppE (VarE dec) (VarE rarr))
@@ -38,14 +39,14 @@ encodingInstance enc dec able name mp arr
                        ]
                       ,FunD 'encodeable
                        [Clause [WildP] (NormalB $ AppE (VarE able) (VarE rmp))
-                        [ValD (VarP rmp) (NormalB mp) []]
+                        []
                        ]
                       ]
       ]
     where
       rname = mkName name
       rarr = mkName "arr"
-      rmp = mkName "mp"
+      rmp = mkName ("decoding_map_"++name)
 
 createCharArray :: [(Integer,Maybe Char)] -> Integer -> Integer -> Q Exp
 createCharArray lst f t = createArray (map (\(x,y) ->
@@ -64,8 +65,8 @@ integerExp :: Integer -> Exp
 integerExp i = LitE $ IntegerL i
 
 mbCharToExp :: Maybe Char -> Exp
-mbCharToExp Nothing = ConE 'Nothing
-mbCharToExp (Just c) = AppE (ConE 'Just) (LitE $ CharL c)
+mbCharToExp Nothing = LitE (IntegerL (-1))
+mbCharToExp (Just c) = LitE (IntegerL $ fromIntegral $ ord c)
 
 createArray :: [(Exp,Exp)] -> Exp -> Exp -> Q Exp
 createArray lst from to