packages feed

multirec 0.3 → 0.4

raw patch · 9 files changed

+56/−36 lines, 9 files

Files

multirec.cabal view
@@ -1,5 +1,5 @@ name:			multirec-version:		0.3+version:		0.4 license:		BSD3 license-file:		LICENSE author:			Alexey Rodriguez,@@ -32,8 +32,7 @@   .   *  Alexey Rodriguez, Stefan Holdermans, Andres Löh, Johan Jeuring.      /Generic programming with fixed points for mutually recursive datatypes/.-     Technical Report, Universiteit Utrecht-     (<http://www.cs.uu.nl/research/techreps/repo/CS-2008/2008-019.pdf>).+     ICFP 2009.   stability:		experimental build-type:		Simple
src/Generics/MultiRec.hs view
@@ -11,7 +11,7 @@ -- multirec -- -- generic programming for families of recursive datatypes -- --- This top-level module re-exports all other modules of the library.+-- This top-level module re-exports most modules of the library. -- ----------------------------------------------------------------------------- @@ -24,7 +24,9 @@     module Generics.MultiRec.HFunctor,     module Generics.MultiRec.Fold,     module Generics.MultiRec.Compos,-    module Generics.MultiRec.Eq+    module Generics.MultiRec.Eq,+    module Generics.MultiRec.HFix,+    module Generics.MultiRec.Show   )   where @@ -33,5 +35,7 @@ import Generics.MultiRec.Fold import Generics.MultiRec.Compos import Generics.MultiRec.Eq+import Generics.MultiRec.HFix+import Generics.MultiRec.Show
src/Generics/MultiRec/Compos.hs view
@@ -32,14 +32,14 @@ -- | Normal version. compos :: (Fam phi, HFunctor phi (PF phi)) =>           (forall ix. phi ix -> ix -> ix) -> phi ix -> ix -> ix-compos f p = to p . hmap (\ p -> I0 . f p . unI0) . from p+compos f p = to p . hmap (\ p -> I0 . f p . unI0) p . from p  -- | Monadic version of 'compos'. composM :: (Fam phi, HFunctor phi (PF phi), Monad m) =>            (forall ix. phi ix -> ix -> m ix) -> phi ix -> ix -> m ix-composM f p = liftM (to p) . hmapM (\ p -> liftM I0 . f p . unI0) . from p+composM f p = liftM (to p) . hmapM (\ p -> liftM I0 . f p . unI0) p . from p  -- | Applicative version of 'compos'. composA :: (Fam phi, HFunctor phi (PF phi), Applicative a) =>            (forall ix. phi ix -> ix -> a ix) -> phi ix -> ix -> a ix-composA f p = liftA (to p) . hmapA (\ p -> liftA I0 . f p . unI0) . from p+composA f p = liftA (to p) . hmapA (\ p -> liftA I0 . f p . unI0) p . from p
src/Generics/MultiRec/Fold.hs view
@@ -47,11 +47,11 @@  fold :: (Fam phi, HFunctor phi (PF phi)) =>         Algebra phi r -> phi ix -> ix -> r ix-fold f p = f p . hmap (\ p (I0 x) -> fold f p x) . from p+fold f p = f p . hmap (\ p (I0 x) -> fold f p x) p . from p  foldM :: (Fam phi, HFunctor phi (PF phi), Monad m) =>          AlgebraF phi m r -> phi ix -> ix -> m (r ix)-foldM f p x = hmapM (\ p (I0 x) -> foldM f p x) (from p x) >>= f p+foldM f p x = hmapM (\ p (I0 x) -> foldM f p x) p (from p x) >>= f p  type CoAlgebra'  phi f   r = forall ix. phi ix -> r ix -> f r ix type CoAlgebra   phi     r = CoAlgebra' phi (PF phi) r@@ -60,11 +60,11 @@  unfold :: (Fam phi, HFunctor phi (PF phi)) =>           CoAlgebra phi r -> phi ix -> r ix -> ix-unfold f p = to p . hmap (\ p x -> I0 (unfold f p x)) . f p+unfold f p = to p . hmap (\ p x -> I0 (unfold f p x)) p . f p  unfoldM :: (Fam phi, HFunctor phi (PF phi), Monad m) =>            CoAlgebraF phi m r -> phi ix -> r ix -> m ix-unfoldM f p x = f p x >>= liftM (to p) . hmapM (\ p x -> liftM I0 (unfoldM f p x))+unfoldM f p x = f p x >>= liftM (to p) . hmapM (\ p x -> liftM I0 (unfoldM f p x)) p  type ParaAlgebra'  phi f   r = forall ix. phi ix -> f r ix -> ix -> r ix type ParaAlgebra   phi     r = ParaAlgebra' phi (PF phi) r@@ -73,11 +73,11 @@  para :: (Fam phi, HFunctor phi (PF phi)) =>          ParaAlgebra phi r -> phi ix -> ix -> r ix-para f p x = f p (hmap (\ p (I0 x) -> para f p x) (from p x)) x+para f p x = f p (hmap (\ p (I0 x) -> para f p x) p (from p x)) x  paraM :: (Fam phi, HFunctor phi (PF phi), Monad m) =>           ParaAlgebraF phi m r -> phi ix -> ix -> m (r ix)-paraM f p x = hmapM (\ p (I0 x) -> paraM f p x) (from p x) >>= \ r -> f p r x+paraM f p x = hmapM (\ p (I0 x) -> paraM f p x) p (from p x) >>= \ r -> f p r x  -- * Creating an algebra
src/Generics/MultiRec/FoldAlg.hs view
@@ -106,7 +106,7 @@ fold :: forall phi ix r . (Fam phi, HFunctor phi (PF phi), Fold (PF phi)) =>         Algebra phi r -> phi ix -> ix -> r ix fold f p = alg (f p) .-           hmap (\ p (I0 x) -> fold f p x) .+           hmap (\ p (I0 x) -> fold f p x) p .            from p  -- * Construction of algebras
src/Generics/MultiRec/FoldAlgK.hs view
@@ -105,7 +105,7 @@ fold :: forall phi ix r . (Fam phi, HFunctor phi (PF phi), Fold (PF phi)) =>         Algebra phi r -> phi ix -> ix -> r fold f p = alg (f p) .-           hmap (\ p (I0 x) -> K0 (fold f p x)) .+           hmap (\ p (I0 x) -> K0 (fold f p x)) p .            from p  -- * Construction of algebras
src/Generics/MultiRec/FoldK.hs view
@@ -38,11 +38,11 @@  fold :: (Fam phi, HFunctor phi (PF phi)) =>         Algebra phi r -> phi ix -> ix -> r-fold f p = f p . hmap (\ p (I0 x) -> K0 (fold f p x)) . from p+fold f p = f p . hmap (\ p (I0 x) -> K0 (fold f p x)) p . from p  foldM :: (Fam phi, HFunctor phi (PF phi), Monad m) =>          AlgebraF phi m r -> phi ix -> ix -> m r-foldM f p x = hmapM (\ p (I0 x) -> liftM K0 (foldM f p x)) (from p x) >>= f p+foldM f p x = hmapM (\ p (I0 x) -> liftM K0 (foldM f p x)) p (from p x) >>= f p  type CoAlgebra'  phi f   r = forall ix. phi ix -> r -> f (K0 r) ix type CoAlgebra   phi     r = CoAlgebra' phi (PF phi) r@@ -51,11 +51,11 @@  unfold :: (Fam phi, HFunctor phi (PF phi)) =>           CoAlgebra phi r -> phi ix -> r -> ix-unfold f p = to p . hmap (\ p (K0 x) -> I0 (unfold f p x)) . f p+unfold f p = to p . hmap (\ p (K0 x) -> I0 (unfold f p x)) p . f p  unfoldM :: (Fam phi, HFunctor phi (PF phi), Monad m) =>            CoAlgebraF phi m r -> phi ix -> r -> m ix-unfoldM f p x = f p x >>= liftM (to p) . hmapM (\ p (K0 x) -> liftM I0 (unfoldM f p x))+unfoldM f p x = f p x >>= liftM (to p) . hmapM (\ p (K0 x) -> liftM I0 (unfoldM f p x)) p  type ParaAlgebra'  phi f   r = forall ix. phi ix -> f (K0 r) ix -> ix -> r type ParaAlgebra   phi     r = ParaAlgebra' phi (PF phi) r@@ -64,11 +64,11 @@  para :: (Fam phi, HFunctor phi (PF phi)) =>          ParaAlgebra phi r -> phi ix -> ix -> r-para f p x = f p (hmap (\ p (I0 x) -> K0 (para f p x)) (from p x)) x+para f p x = f p (hmap (\ p (I0 x) -> K0 (para f p x)) p (from p x)) x  paraM :: (Fam phi, HFunctor phi (PF phi), Monad m) =>           ParaAlgebraF phi m r -> phi ix -> ix -> m r-paraM f p x = hmapM (\ p (I0 x) -> liftM K0 (paraM f p x)) (from p x) >>= \ r -> f p r x+paraM f p x = hmapM (\ p (I0 x) -> liftM K0 (paraM f p x)) p (from p x) >>= \ r -> f p r x  -- * Creating an algebra
src/Generics/MultiRec/HFunctor.hs view
@@ -32,29 +32,29 @@ class HFunctor phi f where   hmapA :: (Applicative a) =>            (forall ix. phi ix -> r ix -> a (r' ix)) ->-           f r ix -> a (f r' ix)+           phi ix -> f r ix -> a (f r' ix)  instance El phi xi => HFunctor phi (I xi) where-  hmapA f (I x) = I <$> f proof x+  hmapA f _ (I x) = I <$> f proof x  instance HFunctor phi (K x) where-  hmapA _ (K x) = pure (K x)+  hmapA _ _ (K x) = pure (K x)  instance HFunctor phi U where-  hmapA _ U = pure U+  hmapA _ _ U = pure U  instance (HFunctor phi f, HFunctor phi g) => HFunctor phi (f :+: g) where-  hmapA f (L x) = L <$> hmapA f x-  hmapA f (R y) = R <$> hmapA f y+  hmapA f p (L x) = L <$> hmapA f p x+  hmapA f p (R y) = R <$> hmapA f p y  instance (HFunctor phi f, HFunctor phi g) => HFunctor phi (f :*: g) where-  hmapA f (x :*: y) = (:*:) <$> hmapA f x <*> hmapA f y+  hmapA f p (x :*: y) = (:*:) <$> hmapA f p x <*> hmapA f p y  instance HFunctor phi f => HFunctor phi (f :>: ix) where-  hmapA f (Tag x) = Tag <$> hmapA f x+  hmapA f p (Tag x) = Tag <$> hmapA f p x  instance (Constructor c, HFunctor phi f) => HFunctor phi (C c f) where-  hmapA f (C x) = C <$> hmapA f x+  hmapA f p (C x) = C <$> hmapA f p x  -- | The function 'hmap' takes a functor @f@. All the recursive instances -- in that functor are wrapped by an application of @r@. The argument to@@ -64,11 +64,11 @@ -- parameterized by a witness of type @phi ix@.  hmap  :: (HFunctor phi f) =>          (forall ix. phi ix -> r ix -> r' ix) ->-         f r ix -> f r' ix-hmap f x = unI0 (hmapA (\ ix x -> I0 (f ix x)) x)+         phi ix -> f r ix -> f r' ix+hmap f p x = unI0 (hmapA (\ ix x -> I0 (f ix x)) p x)  -- | Monadic version of 'hmap'. hmapM :: (HFunctor phi f, Monad m) =>          (forall ix. phi ix -> r ix -> m (r' ix)) ->-         f r ix -> m (f r' ix)-hmapM f x = unwrapMonad (hmapA (\ ix x -> WrapMonad (f ix x)) x)+         phi ix -> f r ix -> m (f r' ix)+hmapM f p x = unwrapMonad (hmapA (\ ix x -> WrapMonad (f ix x)) p x)
src/Generics/MultiRec/TH.hs view
@@ -100,10 +100,12 @@ deriveEqS s ns =     liftM (:[]) $     instanceD (cxt []) (conT ''EqS `appT` conT s)-      [funD 'eqS (map trueClause ns ++ [falseClause])]+      [funD 'eqS (trues ++ falses)]   where     trueClause n = clause [conP n [], conP n []] (normalB (conE 'Just `appE` conE 'Refl)) []     falseClause  = clause [wildP,  wildP]        (normalB (conE 'Nothing)) []+    trues        = map trueClause ns+    falses       = if length trues == 1 then [] else [falseClause]  constrInstance :: Name -> Q [Dec] constrInstance n =@@ -117,9 +119,16 @@     is <- mapM mkInstance cs     return $ ds ++ is +stripRecordNames :: Con -> Con+stripRecordNames (RecC n f) =+  NormalC n (map (\(_, s, t) -> (s, t)) f)+stripRecordNames c = c+ mkData :: Con -> Q Dec mkData (NormalC n _) =   dataD (cxt []) (mkName (nameBase n)) [] [] [] +mkData r@(RecC _ _) =+  mkData (stripRecordNames r) mkData (InfixC t1 n t2) =   mkData (NormalC n [t1,t2]) @@ -136,6 +145,8 @@ mkInstance (NormalC n _) =     instanceD (cxt []) (appT (conT ''Constructor) (conT $ mkName (nameBase n)))       [funD 'conName [clause [wildP] (normalB (stringE (nameBase n))) []]]+mkInstance r@(RecC _ _) =+  mkInstance (stripRecordNames r) mkInstance (InfixC t1 n t2) =     do       i <- reify n@@ -175,6 +186,8 @@   where     prod :: Q Type -> Q Type -> Q Type     prod a b = conT ''(:*:) `appT` a `appT` b+pfCon ns r@(RecC _ _) =+  pfCon ns (stripRecordNames r) pfCon ns (InfixC t1 n t2) =     pfCon ns (NormalC n [t1,t2]) @@ -233,6 +246,8 @@       (normalB $ wrap $ lrE m i $ conE 'C `appE` foldr1 prod (zipWith (fromField ns) [0..] (map snd fs))) []   where     prod x y = conE '(:*:) `appE` x `appE` y+fromCon wrap ns n m i r@(RecC _ _) =+  fromCon wrap ns n m i (stripRecordNames r) fromCon wrap ns n m i (InfixC t1 cn t2) =   fromCon wrap ns n m i (NormalC cn [t1,t2]) @@ -248,6 +263,8 @@       (normalB $ foldl appE (conE cn) (map (varE . field) [0..length fs - 1])) []   where     prod x y = conP '(:*:) [x,y]+toCon wrap ns n m i r@(RecC _ _) =+  toCon wrap ns n m i (stripRecordNames r) toCon wrap ns n m i (InfixC t1 cn t2) =   toCon wrap ns n m i (NormalC cn [t1,t2])