{-# LANGUAGE OverloadedStrings #-} -- |Generate the large constructor trees of some primitive types (Array,Word8,Word7) module ZM.Type.Generate (arrayCT, word8CT, word7CT) where import Data.Model.Types -- |Constructor Tree for: -- data Array a = A0 | A1 a (Array a) .. | A255 a .. a (Array a) arrayCT :: Maybe (ConTree String (TypeRef QualName)) arrayCT = Just (asACT $ mkCons 256) asACT :: Cons -> ConTree String (TypeRef QualName) asACT (P t1 t2) = ConTree (asACT t1) (asACT t2) asACT (L 0) = Con "A0" (Left []) asACT (L n) = let a = TypeCon $ TypVar 0 in Con ("A"++show n) (Left $ replicate n a ++ [TypeApp (TypeCon (TypRef (QualName "" "" "Array"))) a]) --word8ADT = ADT {declName = "Word8", declNumParameters = 0, declCons = word8CT} -- |Constructor Tree for: -- data Word8 = V0 | V1 .. | V255 word8CT :: Maybe (ConTree String ref) word8CT = Just (asWCT $ mkCons 256) -- |Constructor Tree for: -- data Word7 = V0 | V1 .. | V127 word7CT :: Maybe (ConTree String ref) word7CT = Just (asWCT $ mkCons 128) asWCT :: Cons -> ConTree String ref asWCT (P t1 t2) = ConTree (asWCT t1) (asWCT t2) asWCT (L n) = Con ("V"++show n) (Left []) -- |A binary tree with integer leaves, used to represent constructor trees data Cons = L Int | P Cons Cons deriving (Show) -- |Generate a right heavier binary tree whose leaves are marked -- with the position (starting with 0) of the corresponding constructor -- in the list of constructors mkCons :: Int -> Cons mkCons = makeTree 0 makeTree :: Int -> Int -> Cons makeTree p 1 = L p makeTree p n = let (d,m) = n `divMod` 2 in P (makeTree p d) (makeTree (p+d) (d+m))