encoding 0.6.1 → 0.6.2

raw patch · 4 files changed

+122/−1 lines, 4 files

Files

• Data/Array/Static/Builder.hs +12/−0
• Data/CharMap/Builder.hs +64/−0
• Data/Map/Static/Builder.hs +42/−0
• encoding.cabal +4/−1

@@ -0,0 +1,12 @@+{-# LANGUAGE MagicHash #-}+module Data.Array.Static.Builder where++import Data.Static++buildStaticArray :: (StaticElement e,Show i) => (i,i) -> [e] -> String+buildStaticArray (s,e) els = "StaticArray ("++show s++") ("++show e++") \""+                             ++concat (map (\w -> '\\':show w) (concat (map gen els)))+                             ++"\"#"++buildStaticArray' :: (StaticElement e) => [e] -> String+buildStaticArray' els = buildStaticArray (0,length els-1) els

@@ -0,0 +1,64 @@+module Data.CharMap.Builder where++import Data.Map.Static.Builder++import Data.List+import Data.Ord+import Data.Char+import Data.Bits+import Data.Word++data BuildingBlock+    = SingleMapping Char [Word8]+    | RangeMapping Char Char Int [(Word8,Word8)]++charRange :: BuildingBlock -> (Char,Char)+charRange (SingleMapping c _) = (c,c)+charRange (RangeMapping s e _ _) = (s,e)++mappingLength :: BuildingBlock -> Int+mappingLength (SingleMapping _ w) = length w+mappingLength (RangeMapping _ _ _ ws) = length ws++isRange :: BuildingBlock -> Bool+isRange (SingleMapping _ _) = False+isRange (RangeMapping _ _ _ _) = True++buildCharMap :: [BuildingBlock] -> String+buildCharMap lst = let slst = sortBy (comparing (fst.charRange)) lst+                       grps = groupBy (\x y -> (not (isRange x || isRange y))+                                              && mappingLength x == mappingLength y+                                      ) slst++                       split' xs = splitAt (length xs `div` 2) xs+                       +                       build' [] _ _ = "DeadEnd"+                       build' [[RangeMapping st end off (x:xs)]] bl br+                           = let e1 = if bl < st+                                      then "Node ("++show st++") DeadEnd ("++e2++")"+                                      else e2+                                 e2 = if br>end+                                      then "Node ("++show end++") ("++e3++") DeadEnd"+                                      else e3+                                 e3 = "LeafRange"++show (length xs+1)++" ("++show (ord st - off)++") "+                                      ++show (fst x)++concat (map (\(w,r) -> " "++show w++" "++show r) xs)+                             in e1+                       build' [mps@((SingleMapping _ w):_)] bl br+                           = "LeafMap"++show (length w)++" ("+                             ++(case length w of+                                  1 -> buildStaticMap (map (\(SingleMapping c [w]) -> (c,w)) mps)+                                  2 -> buildStaticMap $ map (\(SingleMapping c [w1,w2])+                                                               -> (c,((fromIntegral w1) `shiftL` 8) .|. (fromIntegral w2)::Word16)+                                                           ) mps+                                  4 -> buildStaticMap $ map (\(SingleMapping c [w1,w2,w3,w4])+                                                                -> (c,((fromIntegral w1) `shiftL` 24)+                                                                   .|. ((fromIntegral w2) `shiftL` 16)+                                                                   .|. ((fromIntegral w3) `shiftL` 8)+                                                                   .|. (fromIntegral w4)::Word32)+                                                           ) mps)++")"+                       build' mps bl br = let (l,r@((spl:_):_)) = split' mps+                                              (el,_) = charRange spl+                                          in "Node ("++show el++") ("++build' l bl (pred el)++") ("+++                                             build' r el br++")"+                                               +                   in build' grps minBound maxBound

@@ -0,0 +1,42 @@+module Data.Map.Static.Builder where++import Data.Static+import Data.Array.Static.Builder++import Data.List+import Data.Ord+import Data.Bits++buildStaticMap :: (StaticElement i,StaticElement e,Ord i) => [(i,e)] -> String+buildStaticMap lst = let  step :: Int -> [(i,e)] -> [(Int,(i,e))]+                          step n chunk = let ss = findSplitSize (length chunk)+                                             (h,d:t) = splitAt ss chunk+                                         in if null chunk+                                            then []+                                            else (n,d):((step (n*2) h)++(step (n*2+1) t))+                          checkHeap n [] = []+                          checkHeap n ((c,x):xs) = if c == n+                                                   then x:checkHeap (n+1) xs+                                                   else error $ "Heap is not consistent: Should be "++show n++" but is "++show c+                          uheap = sortBy (comparing fst) (step 1 slst)+                          slst = sortBy (comparing fst) lst+                          heap = checkHeap 1 $ sortBy (comparing fst) (step 1 slst)+                          len = length heap+                      in "StaticMap ("++buildStaticArray (1,len) (map fst heap)++") ("++buildStaticArray (1,len) (map snd heap)++")"++maxSize :: Int -> Int+maxSize d = (1 `shiftL` d) - 1++treeDepth :: Int -> Int+treeDepth sz = find' [0..]+    where+      find' (x:xs) = if 1 `shiftL` x > sz+                     then x+                     else find' xs++findSplitSize :: Int -> Int+findSplitSize len = let depth = treeDepth len+                        free = (maxSize depth) - len+                    in if free <= (1 `shiftL` (depth - 2))+                       then maxSize (depth - 1)+                       else len - (maxSize (depth - 2)) - 1

@@ -1,5 +1,5 @@ Name:		encoding-Version:	0.6.1+Version:	0.6.2 Author:		Henning Günther Maintainer:	h.guenther@tu-bs.de License:	BSD3@@ -15,6 +15,9 @@   Data/Encoding/Preprocessor/Mapping.hs   Data/Encoding/Preprocessor/XMLMapping.hs   Data/Encoding/Preprocessor/XMLMappingBuilder.hs+  Data/CharMap/Builder.hs+  Data/Array/Static/Builder.hs+  Data/Map/Static/Builder.hs  Flag splitBase   description:	Choose the new smaller, split-up base package.