3f8c3bbb26
Ignore-this: 3b03abece3edb25c656f84db9cef7734 darcs-hash:20121017171258-76d51-76a4e9057c0a4c3c1370485f3dc072c18caafddf
74 lines
2.7 KiB
Haskell
74 lines
2.7 KiB
Haskell
module Data.CharMap where
|
|
|
|
import Data.Map.Static
|
|
import Data.Encoding.ByteSink
|
|
import Data.Encoding.Exception
|
|
|
|
import Control.Throws
|
|
import Data.Word
|
|
import Data.Char
|
|
import Prelude hiding (lookup)
|
|
|
|
data CharMap
|
|
= Node !Char !CharMap !CharMap
|
|
| DeadEnd
|
|
| LeafRange1 !Int !Word8
|
|
| LeafRange2 !Int !Word8 !Word8 !Word8
|
|
| LeafRange3 !Int !Word8 !Word8 !Word8 !Word8 !Word8
|
|
| LeafRange4 !Int !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
|
|
| LeafMap1 (StaticMap Char Word8)
|
|
| LeafMap2 (StaticMap Char Word16)
|
|
| LeafMap4 (StaticMap Char Word32)
|
|
|
|
mapEncode :: ByteSink m => Char -> CharMap -> m ()
|
|
mapEncode ch (Node rch l r)
|
|
| ch < rch = mapEncode ch l
|
|
| otherwise = mapEncode ch r
|
|
mapEncode ch DeadEnd = throwException (HasNoRepresentation ch)
|
|
mapEncode ch (LeafRange1 bch st)
|
|
= pushWord8 $ st + (fromIntegral ((ord ch) - bch))
|
|
mapEncode ch (LeafRange2 bch min1 min2 r2)
|
|
= let v = (ord ch) - bch
|
|
(w1,w2) = v `divMod` (fromIntegral r2)
|
|
in do
|
|
pushWord8 (fromIntegral w1 + min1)
|
|
pushWord8 (fromIntegral w2 + min2)
|
|
mapEncode ch (LeafRange3 bch min1 min2 r2 min3 r3)
|
|
= let v = (ord ch) - bch
|
|
(v1,w3) = v `divMod` (fromIntegral r3)
|
|
(w1,w2) = v1 `divMod` (fromIntegral r2)
|
|
in do
|
|
pushWord8 (fromIntegral w1 + min1)
|
|
pushWord8 (fromIntegral w2 + min2)
|
|
pushWord8 (fromIntegral w3 + min3)
|
|
mapEncode ch (LeafRange4 bch min1 min2 r2 min3 r3 min4 r4)
|
|
= let v = (ord ch) - bch
|
|
(v1,w4) = v `divMod` (fromIntegral r4)
|
|
(v2,w3) = v1 `divMod` (fromIntegral r3)
|
|
(w1,w2) = v2 `divMod` (fromIntegral r2)
|
|
in do
|
|
pushWord8 (fromIntegral w1 + min1)
|
|
pushWord8 (fromIntegral w2 + min2)
|
|
pushWord8 (fromIntegral w3 + min3)
|
|
pushWord8 (fromIntegral w4 + min4)
|
|
mapEncode ch (LeafMap1 mp) = case lookup ch mp of
|
|
Nothing -> throwException (HasNoRepresentation ch)
|
|
Just v -> pushWord8 v
|
|
mapEncode ch (LeafMap2 mp) = case lookup ch mp of
|
|
Nothing -> throwException (HasNoRepresentation ch)
|
|
Just v -> pushWord16be v
|
|
mapEncode ch (LeafMap4 mp) = case lookup ch mp of
|
|
Nothing -> throwException (HasNoRepresentation ch)
|
|
Just v -> pushWord32be v
|
|
|
|
|
|
mapMember :: Char -> CharMap -> Bool
|
|
mapMember c (Node rc l r)
|
|
| c < rc = mapMember c l
|
|
| otherwise = mapMember c r
|
|
mapMember c DeadEnd = False
|
|
mapMember c (LeafMap1 mp) = member c mp
|
|
mapMember c (LeafMap2 mp) = member c mp
|
|
mapMember c (LeafMap4 mp) = member c mp
|
|
mapMember c _ = True
|