Tom Pledger wrote:
I don't know whether this is a shining example of an advantage, and am keen to see other comments.
For what it's worth, I've pulled some snippets from some code I wrote. I wanted three recursive types which were nearly identical (Exp,ExpQv,ExpPr). Rather than write three different type declarations data Exp = ... data ExpQv = ... data ExpPr = ... I was able to abstract out the commonality into one non-recursive type data FctrExp a = ... Note how concise some of my "Sample Functions" can be. These would have been very long and ugly to write were I to use the first approach. At the expense of now using a "two-level" type, I've gained some expressiveness. - Mark ---- Fix Type ----------------------------------------------------------------- data Fix f = In (f (Fix f)) class FixEq f where fixEq :: Eq a => (f a -> f a -> Bool) class FixShow f where fixShowsPrec :: Show a => (Int -> f a -> ShowS) instance FixEq f => Eq (Fix f) where (==) (In x) (In y) = fixEq x y instance FixShow f => Show (Fix f) where showsPrec p (In x) = showString "In (" . fixShowsPrec p x . showChar ')' ---- Types for Documentation -------------------------------------------------- type Var = String type Env x = [(Var,x)] type Pat = Exp type Type = Exp ---- Form & FormPr Related Types --------------------------------------------- type Qv = (Exp,Exp) data Pr = Pstep (ExpPr,Justifier,ExpPr) | Pletu (Var, Type, ExpPr) deriving(Show,Eq) data Justifier = Stub1 deriving (Show,Eq) ---- Exp,ExpPr,ExpQv Types ---------------------------------------------------- data Ftype = Stub2 deriving (Show,Eq) data Ltype = Stub3 deriving (Show,Eq) data Const = Stub4 deriving (Show,Eq) data FctrExp a = Econ Const | Evar Var | Eapp (Ftype, a, a) | Elet (Ltype, Pat, Type, a, a) -- let x:t=e1 in e2 | Elam (Ftype, Pat, Type, a) -- \x:t=>e | Eqnt (Ftype, Pat, Type, a) -- |~|x:t=>e | Etup [a] -- <e1,e2,...> | Emu a | Ecase a -- case e | Ein (a,a) -- In i e deriving (Show,Eq) data FctrExpQv a = ExpQvExp (FctrExp a) | ExpQvQv Qv deriving (Show,Eq) data FctrExpPr a = ExpPrExp (FctrExp a) | ExpPrPr Pr deriving (Show,Eq) type Exp = Fix FctrExp type ExpQv = Fix FctrExpQv type ExpPr = Fix FctrExpPr ---- Define Appropriate Functors ---------------------------------------------- instance Functor FctrExp where fmap = fmapFctrExp fmapFctrExp :: (a->b) -> (FctrExp a -> FctrExp b) fmapFctrExp f e = case e of Econ x -> Econ x Evar x -> Evar x Eapp (x,e1,e2) -> Eapp (x,f e1, f e2) Elet (x,v,t,y,z) -> Elet (x,v,t,f y,f z) Elam (x,v,t,e) -> Elam (x,v,t,f e) Eqnt (x,v,t,e) -> Eqnt (x,v,t,f e) Etup es -> Etup (map f es) Emu e -> Emu (f e) Ecase e -> Ecase (f e) Ein (i,e) -> Ein (f i,f e) ---- Make Exp,ExpQv,ExpPr instances of Show and Eq ---------------------------- instance FixEq FctrExp where fixEq = (==) instance FixShow FctrExp where fixShowsPrec = showsPrec instance FixEq FctrExpQv where fixEq = (==) instance FixShow FctrExpQv where fixShowsPrec = showsPrec instance FixEq FctrExpPr where fixEq = (==) instance FixShow FctrExpPr where fixShowsPrec = showsPrec ---- Sample Functions --------------------------------------------------------- expToExpPr :: Exp -> ExpPr expToExpPr (In x) = In (ExpPrExp (fmap expToExpPr x)) firstExpPr, finalExpPr :: ExpPr -> Exp firstExpPr (In x) = case x of ExpPrExp e -> In $ fmap firstExpPr e ExpPrPr (Pstep (p,_,_)) -> firstExpPr p ExpPrPr (Pletu _) -> error "firstExpPr" finalExpPr (In x) = case x of ExpPrExp e -> In $ fmap finalExpPr e ExpPrPr (Pstep (_,_,p)) -> finalExpPr p ExpPrPr (Pletu _) -> error "finalExpPr"