encoding/Data/Static.hs
Henning Guenther 7b887abcb1 Fix bang pattern warning
Ignore-this: 25c92a74956ada02b849a5bdb56f78c1

darcs-hash:20100214211452-a4fee-22d79ad1175d6d8728b2c9ba438a44ff891aa69f
2010-02-14 13:14:52 -08:00

67 lines
2.5 KiB
Haskell

{-# LANGUAGE MagicHash,FlexibleInstances #-}
module Data.Static where
import GHC.Exts
import GHC.Prim
import GHC.Word
import Data.Word
import Data.Bits
import Data.Char
class StaticElement e where
extract :: Addr# -> Int# -> e
gen :: e -> [Word8]
instance StaticElement Word8 where
extract addr i = W8# (indexWord8OffAddr# addr i)
gen w = [w]
instance StaticElement Word16 where
extract addr i = W16# (indexWord16OffAddr# addr i)
gen w = let r1 = fromIntegral w
r2 = fromIntegral $ w `shiftR` 8
in [r1,r2]
instance StaticElement Word32 where
extract addr i = W32# (indexWord32OffAddr# addr i)
gen w = let r1 = fromIntegral w
r2 = fromIntegral $ w `shiftR` 8
r3 = fromIntegral $ w `shiftR` 16
r4 = fromIntegral $ w `shiftR` 24
in [r1,r2,r3,r4]
instance StaticElement Char where
extract addr i = C# (indexWideCharOffAddr# addr i)
gen c = gen (fromIntegral (ord c)::Word32)
instance StaticElement (Maybe Char) where
extract addr i = let !v = indexWord32OffAddr# addr i
in if eqWord# v (int2Word# 4294967295#) -- -1 in Word32
then Nothing
else (if (I# (word2Int# v)) > 0x10FFFF
then error (show (I# (word2Int# v))++" is not a valid char ("++show (I# i)++")")
else Just (chr (I# (word2Int# v)))
)
gen Nothing = gen (-1::Word32)
gen (Just c) = gen (fromIntegral (ord c)::Word32)
instance StaticElement a => StaticElement (a,a) where
extract addr i = let x1 = extract addr (i *# 2#)
x2 = extract addr (i *# 2# +# 1#)
in (x1,x2)
gen (x1,x2) = gen x1 ++ gen x2
instance StaticElement a => StaticElement (a,a,a) where
extract addr i = let x1 = extract addr (i *# 3#)
x2 = extract addr (i *# 3# +# 1#)
x3 = extract addr (i *# 3# +# 2#)
in (x1,x2,x3)
gen (x1,x2,x3) = gen x1 ++ gen x2 ++ gen x3
instance StaticElement a => StaticElement (a,a,a,a) where
extract addr i = let x1 = extract addr (i *# 4#)
x2 = extract addr (i *# 4# +# 1#)
x3 = extract addr (i *# 4# +# 2#)
x4 = extract addr (i *# 4# +# 3#)
in (x1,x2,x3,x4)
gen (x1,x2,x3,x4) = gen x1 ++ gen x2 ++ gen x3 ++ gen x4