compdata 0.6.1.2 → 0.6.1.3

raw patch · 32 files changed

+128/−232 lines, 32 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• compdata.cabal +1/−5
• examples/Examples/Multi/Desugar.hs +1/−1
• examples/Examples/Param/Names.hs +12/−3
• src/Data/Comp/Automata.hs +1/−35
• src/Data/Comp/Derive.hs +10/−3
• src/Data/Comp/Derive/LiftSum.hs +0/−41
• src/Data/Comp/Derive/Utils.hs +1/−1
• src/Data/Comp/Desugar.hs +3/−5
• src/Data/Comp/Multi/Derive.hs +13/−3
• src/Data/Comp/Multi/Derive/LiftSum.hs +0/−39
• src/Data/Comp/Multi/Desugar.hs +6/−2
• src/Data/Comp/Multi/Generic.hs +1/−1
• src/Data/Comp/Multi/HFunctor.hs +4/−0
• src/Data/Comp/Multi/Ops.hs +7/−0
• src/Data/Comp/Multi/Sum.hs +1/−0
• src/Data/Comp/Multi/Variables.hs +2/−1
• src/Data/Comp/MultiParam/Derive.hs +13/−3
• src/Data/Comp/MultiParam/Derive/LiftSum.hs +0/−39
• src/Data/Comp/MultiParam/Desugar.hs +5/−2
• src/Data/Comp/MultiParam/Ops.hs +7/−0
• src/Data/Comp/MultiParam/Sum.hs +1/−0
• src/Data/Comp/Ops.hs +8/−0
• src/Data/Comp/Param/Derive.hs +12/−3
• src/Data/Comp/Param/Derive/LiftSum.hs +0/−37
• src/Data/Comp/Param/Desugar.hs +5/−2
• src/Data/Comp/Param/Ops.hs +7/−0
• src/Data/Comp/Param/Sum.hs +1/−0
• src/Data/Comp/Show.hs +1/−1
• src/Data/Comp/Sum.hs +1/−0
• src/Data/Comp/Variables.hs +2/−1
• testsuite/tests/Data/Comp/Multi/Variables_Test.hs +1/−3
• testsuite/tests/Data/Comp/Variables_Test.hs +1/−1

@@ -1,5 +1,5 @@ Name:			compdata-Version:		0.6.1.2+Version:		0.6.1.3 Synopsis:            	Compositional Data Types Description: @@ -234,7 +234,6 @@                         Data.Comp.Derive.DeepSeq,                         Data.Comp.Derive.SmartConstructors,                         Data.Comp.Derive.SmartAConstructors,-                        Data.Comp.Derive.LiftSum,                         Data.Comp.Derive.Foldable,                         Data.Comp.Derive.Traversable,                         Data.Comp.Derive.Injections,@@ -250,7 +249,6 @@                         Data.Comp.Multi.Derive.Show,                         Data.Comp.Multi.Derive.SmartConstructors                         Data.Comp.Multi.Derive.SmartAConstructors-                        Data.Comp.Multi.Derive.LiftSum,                         Data.Comp.Multi.Derive.Injections,                         Data.Comp.Multi.Derive.Projections, @@ -261,7 +259,6 @@                         Data.Comp.Param.Derive.Show,                         Data.Comp.Param.Derive.SmartConstructors,                         Data.Comp.Param.Derive.SmartAConstructors,-                        Data.Comp.Param.Derive.LiftSum,                         Data.Comp.Param.Derive.Injections,                         Data.Comp.Param.Derive.Projections, @@ -271,7 +268,6 @@                         Data.Comp.MultiParam.Derive.Show,                         Data.Comp.MultiParam.Derive.SmartConstructors,                         Data.Comp.MultiParam.Derive.SmartAConstructors,-                        Data.Comp.MultiParam.Derive.LiftSum,                         Data.Comp.MultiParam.Derive.Injections,                         Data.Comp.MultiParam.Derive.Projections 

@@ -1,6 +1,6 @@ {-# LANGUAGE TemplateHaskell, TypeOperators, MultiParamTypeClasses,   FlexibleInstances, FlexibleContexts, UndecidableInstances, GADTs,-  OverlappingInstances #-}+  IncoherentInstances #-} -------------------------------------------------------------------------------- -- | -- Module      :  Examples.Multi.Desugar

@@ -55,8 +55,12 @@ class N2PTrans f g where   n2pAlg :: Alg f (M g a (Trm g a)) -$(derive [liftSum] [''N2PTrans]) +-- We make the lifting to sums explicit in order to make the N2PTrans+-- work with the default instance declaration further below.+instance (N2PTrans f1 g, N2PTrans f2 g) => N2PTrans (f1 :+: f2) g where+    n2pAlg = caseD n2pAlg n2pAlg+ n2p :: (Difunctor f, N2PTrans f g) => Term f -> Term g n2p t = Term $ runReader (cata n2pAlg t) Map.empty @@ -85,8 +89,13 @@ class P2NTrans f g where   p2nAlg :: Alg f (M' (Trm g a)) -$(derive [liftSum] [''P2NTrans]) +-- We make the lifting to sums explicit in order to make the P2NTrans+-- work with the default instance declaration further below.+instance (P2NTrans f1 g, P2NTrans f2 g) => P2NTrans (f1 :+: f2) g where+    p2nAlg = caseD p2nAlg p2nAlg++ p2n :: (Difunctor f, P2NTrans f g) => Term f -> Term g p2n t = Term $ runReader (cata p2nAlg t) ['x' : show n | n <- [1..]] @@ -98,7 +107,7 @@                       return $ iNLam n (runReader (f (return $ iNVar n)) names)  ep' :: Term SigP-ep' = Term $ iLam $ \a -> iLam (\b -> (iLam $ \a -> b)) `iApp` a+ep' = Term $ iLam $ \a -> iLam (\b -> (iLam $ \_ -> b)) `iApp` a  en' :: Term SigN en' = p2n ep'

@@ -1,4 +1,4 @@-{-# LANGUAGE Rank2Types, FlexibleContexts, ImplicitParams, GADTs, TypeOperators, DeriveFunctor #-}+{-# LANGUAGE Rank2Types, FlexibleContexts, ImplicitParams, GADTs, TypeOperators #-}  -------------------------------------------------------------------------------- -- |@@ -275,40 +275,6 @@ -- to an extended state space.  type DUpState f p q = forall a . (?below :: a -> p, ?above :: p, q :< p) => f a -> q----- type QHom f q g = forall a . (?below :: a -> q, ?above :: q) => f a -> Context g a--homToState :: Functor g => QHom f p g -> DUpState f (Term g, p) (Term g)-homToState hom = appCxt . fmap below . hom'-    where hom' = explicit hom (snd ?above) (snd . ?below)---- runQHom :: (Traversable f, Functor g) =>---            DUpState f (u,d) u -> DDownState f (u,d) d -> ---            QHom f (u,d) g ->---            d -> Term f -> (u, Term g)--- runDState :: DUpState f (u, d) u -> DDownState f (u, d) d -> d -> Term f -> uSource--data Sig a-      = X-      | Const Integer-      | Add a a-        deriving Functor--isConst :: UpState Sig (Maybe Integer)-isConst (Const a) = Just a-isConst (Add (Just a) (Just b)) = Just (a + b)-isConst _         = Nothing--trans :: QHom Sig (Maybe Integer) Sig-trans a | Just c <- above = simpCxt $ Const c-        | otherwise       = simpCxt a--runIt :: Term Sig -> Term Sig-runIt = runUpHom isConst trans---  -- | This combinator turns an arbitrary DUTA into a GDUTA. 

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Comp.Derive@@ -44,11 +45,11 @@      -- ** Smart Constructors w/ Annotations      module Data.Comp.Derive.SmartAConstructors,      -- ** Lifting to Sums-     module Data.Comp.Derive.LiftSum+     liftSum     ) where  import Control.DeepSeq (NFData(..))-import Data.Comp.Derive.Utils (derive)+import Data.Comp.Derive.Utils (derive, liftSumGen) import Data.Comp.Derive.HaskellStrict import Data.Comp.Derive.Foldable import Data.Comp.Derive.Traversable@@ -59,7 +60,7 @@ import Data.Comp.Derive.Arbitrary import Data.Comp.Derive.SmartConstructors import Data.Comp.Derive.SmartAConstructors-import Data.Comp.Derive.LiftSum+import Data.Comp.Ops ((:+:), caseF)  import Language.Haskell.TH @@ -74,3 +75,9 @@ {-| Derive an instance of 'NFData' for a type constructor. -} makeNFData :: Name -> Q [Dec] makeNFData = D.derive A.makeNFData++{-| Given the name of a type class, where the first parameter is a functor,+  lift it to sums of functors. Example: @class ShowF f where ...@ is lifted+  as @instance (ShowF f, ShowF g) => ShowF (f :+: g) where ... @. -}+liftSum :: Name -> Q [Dec]+liftSum = liftSumGen 'caseF ''(:+:)

@@ -1,41 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeOperators #-}------------------------------------------------------------------------------------ |--- Module      :  Data.Comp.Derive.LiftSum--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved--- License     :  BSD3--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>--- Stability   :  experimental--- Portability :  non-portable (GHC Extensions)------ Lift a class declaration for difunctors to sums of functors.--------------------------------------------------------------------------------------module Data.Comp.Derive.LiftSum-    (-     liftSum,-     caseF-    ) where--import Language.Haskell.TH hiding (Cxt)-import Data.Comp.Derive.Utils-import Data.Comp.Sum-import Data.Comp.Ops ((:+:)(..))---{-| Given the name of a type class, where the first parameter is a functor,-  lift it to sums of functors. Example: @class ShowF f where ...@ is lifted-  as @instance (ShowF f, ShowF g) => ShowF (f :+: g) where ... @. -}-liftSum :: Name -> Q [Dec]-liftSum = liftSumGen 'caseF ''(:+:)-                         ---{-| Utility function to case on a functor sum, without exposing the internal-  representation of sums. -}-caseF :: (f a -> b) -> (g a -> b) -> (f :+: g) a -> b-{-# INLINE caseF #-}-caseF f g x = case x of-                Inl x -> f x-                Inr x -> g x

@@ -140,7 +140,7 @@   let targs = map tyVarBndrName targs_   splitM <- findSig targs decs   case splitM of -    Nothing -> do report True $ "Class " ++ show name ++ " cannot be lifted to sums!"+    Nothing -> do reportError $ "Class " ++ show name ++ " cannot be lifted to sums!"                   return []     Just (ts1_, ts2_) -> do       let f = VarT $ mkName "f"

@@ -16,7 +16,6 @@ module Data.Comp.Desugar where  import Data.Comp-import Data.Comp.Ops  -- |The desugaring term homomorphism. class (Functor f, Functor g) => Desugar f g where@@ -25,11 +24,10 @@     desugHom' :: Alg f (Context g a)     desugHom' x = appCxt (desugHom x) -+-- We make the lifting to sums explicit in order to make the Desugar+-- class work with the default instance declaration further below. instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where-    desugHom (Inl x) = desugHom x-    desugHom (Inr x) = desugHom x-+    desugHom = caseF desugHom desugHom  -- |Desugar a term. desugar :: Desugar f g => Term f -> Term g

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Comp.Multi.Derive@@ -36,10 +37,10 @@      -- ** Smart Constructors w/ Annotations      module Data.Comp.Multi.Derive.SmartAConstructors,      -- ** Lifting to Sums-     module Data.Comp.Multi.Derive.LiftSum+     liftSum     ) where -import Data.Comp.Derive.Utils (derive)+import Data.Comp.Derive.Utils (derive, liftSumGen) import Data.Comp.Multi.Derive.Equality import Data.Comp.Multi.Derive.Ordering import Data.Comp.Multi.Derive.Show@@ -48,4 +49,13 @@ import Data.Comp.Multi.Derive.HTraversable import Data.Comp.Multi.Derive.SmartConstructors import Data.Comp.Multi.Derive.SmartAConstructors-import Data.Comp.Multi.Derive.LiftSum+import Data.Comp.Multi.Ops ((:+:), caseH)++import Language.Haskell.TH++{-| Given the name of a type class, where the first parameter is a higher-order+  functor, lift it to sums of higher-order. Example: @class HShowF f where ...@+  is lifted as @instance (HShowF f, HShowF g) => HShowF (f :+: g) where ... @.+ -}+liftSum :: Name -> Q [Dec]+liftSum = liftSumGen 'caseH ''(:+:)

@@ -1,39 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeOperators #-}------------------------------------------------------------------------------------ |--- Module      :  Data.Comp.Multi.Derive.LiftSum--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved--- License     :  BSD3--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>--- Stability   :  experimental--- Portability :  non-portable (GHC Extensions)------ Lift a class declaration for higher-order functors to sums of higher-order--- functors.--------------------------------------------------------------------------------------module Data.Comp.Multi.Derive.LiftSum-    (-     liftSum,-     caseH-    ) where--import Language.Haskell.TH hiding (Cxt)-import Data.Comp.Derive.Utils-import Data.Comp.Multi.Sum-import Data.Comp.Multi.Ops ((:+:)(..))--{-| Given the name of a type class, where the first parameter is a higher-order-  functor, lift it to sums of higher-order. Example: @class HShowF f where ...@-  is lifted as @instance (HShowF f, HShowF g) => HShowF (f :+: g) where ... @.- -}-liftSum :: Name -> Q [Dec]-liftSum = liftSumGen 'caseH ''(:+:)--{-| Utility function to case on a higher-order functor sum, without exposing the-  internal representation of sums. -}-caseH :: (f a b -> c) -> (g a b -> c) -> (f :+: g) a b -> c-caseH f g x = case x of-                Inl x -> f x-                Inr x -> g x

@@ -16,8 +16,8 @@ module Data.Comp.Multi.Desugar where  import Data.Comp.Multi-import Data.Comp.Multi.Derive + -- |The desugaring term homomorphism. class (HFunctor f, HFunctor g) => Desugar f g where     desugHom :: Hom f g@@ -25,7 +25,11 @@     desugHom' :: Alg f (Context g a)     desugHom' x = appCxt (desugHom x) -$(derive [liftSum] [''Desugar])++-- We make the lifting to sums explicit in order to make the Desugar+-- class work with the default instance declaration further below.+instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where+    desugHom = caseH desugHom desugHom  -- |Desugar a term. desugar :: Desugar f g => Term f :-> Term g

@@ -82,4 +82,4 @@ -- | This function computes the generic depth of the given term. depth :: HFoldable f => Cxt h f a :=> Int depth (Hole {}) = 0-depth (Term t) = 1 + hfoldl (\s x -> s + size x) 0 t+depth (Term t) = 1 + hfoldl (\s x -> s `max` depth x) 0 t

@@ -24,6 +24,7 @@      K (..),      A (..),      E (..),+     runE,      (:.:)(..)      ) where @@ -37,6 +38,9 @@     fmap _ (K x) = K x  data E f = forall i. E {unE :: f i}++runE :: (f :=> b) -> E f -> b+runE f (E x) = f x  data A f = A {unA :: forall i. f i} 

@@ -35,6 +35,13 @@ data (f :+: g) (h :: * -> *) e = Inl (f h e)                     | Inr (g h e) +{-| Utility function to case on a higher-order functor sum, without exposing the+  internal representation of sums. -}+caseH :: (f a b -> c) -> (g a b -> c) -> (f :+: g) a b -> c+caseH f g x = case x of+                Inl x -> f x+                Inr x -> g x+ instance (HFunctor f, HFunctor g) => HFunctor (f :+: g) where     hfmap f (Inl v) = Inl $ hfmap f v     hfmap f (Inr v) = Inr $ hfmap f v

@@ -18,6 +18,7 @@     (      (:<:),      (:+:),+     caseH,       -- * Projections for Signatures and Terms      proj,

@@ -27,7 +27,8 @@      variableList,      variables',      appSubst,-     compSubst+     compSubst,+     getBoundVars     ) where  import Data.Comp.Multi.Term

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Comp.MultiParam.Derive@@ -32,14 +33,23 @@      -- ** Smart Constructors w/ Annotations      module Data.Comp.MultiParam.Derive.SmartAConstructors,      -- ** Lifting to Sums-     module Data.Comp.MultiParam.Derive.LiftSum+     liftSum     ) where -import Data.Comp.Derive.Utils (derive)+import Data.Comp.Derive.Utils (derive, liftSumGen) import Data.Comp.MultiParam.Derive.Equality import Data.Comp.MultiParam.Derive.Ordering import Data.Comp.MultiParam.Derive.Show import Data.Comp.MultiParam.Derive.HDifunctor import Data.Comp.MultiParam.Derive.SmartConstructors import Data.Comp.MultiParam.Derive.SmartAConstructors-import Data.Comp.MultiParam.Derive.LiftSum+import Data.Comp.MultiParam.Ops ((:+:), caseHD)++import Language.Haskell.TH++{-| Given the name of a type class, where the first parameter is a higher-order+  difunctor, lift it to sums of higher-order difunctors. Example:+  @class ShowHD f where ...@ is lifted as+  @instance (ShowHD f, ShowHD g) => ShowHD (f :+: g) where ... @. -}+liftSum :: Name -> Q [Dec]+liftSum = liftSumGen 'caseHD ''(:+:)

@@ -1,39 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeOperators #-}------------------------------------------------------------------------------------ |--- Module      :  Data.Comp.MultiParam.Derive.LiftSum--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved--- License     :  BSD3--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>--- Stability   :  experimental--- Portability :  non-portable (GHC Extensions)------ Lift a class declaration for higher-order difunctors to sums of higher-order--- difunctors.--------------------------------------------------------------------------------------module Data.Comp.MultiParam.Derive.LiftSum-    (-     liftSum,-     caseHD-    ) where--import Language.Haskell.TH hiding (Cxt)-import Data.Comp.Derive.Utils-import Data.Comp.MultiParam.Sum-import Data.Comp.MultiParam.Ops ((:+:)(..))--{-| Given the name of a type class, where the first parameter is a higher-order-  difunctor, lift it to sums of higher-order difunctors. Example:-  @class ShowHD f where ...@ is lifted as-  @instance (ShowHD f, ShowHD g) => ShowHD (f :+: g) where ... @. -}-liftSum :: Name -> Q [Dec]-liftSum = liftSumGen 'caseHD ''(:+:)--{-| Utility function to case on a higher-order difunctor sum, without exposing-  the internal representation of sums. -}-caseHD :: (f a b i -> c) -> (g a b i -> c) -> (f :+: g) a b i -> c-caseHD f g x = case x of-                 Inl x -> f x-                 Inr x -> g x

@@ -16,7 +16,6 @@ module Data.Comp.MultiParam.Desugar where  import Data.Comp.MultiParam-import Data.Comp.MultiParam.Derive  -- |The desugaring term homomorphism. class (HDifunctor f, HDifunctor g) => Desugar f g where@@ -25,7 +24,11 @@     desugHom' :: f a (Cxt h g a b) :-> Cxt h g a b     desugHom' x = appCxt (desugHom x) -$(derive [liftSum] [''Desugar])+-- We make the lifting to sums explicit in order to make the Desugar+-- class work with the default instance declaration further below.+instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where+    desugHom = caseHD desugHom desugHom+  -- |Desugar a term. desugar :: Desugar f g => Term f :-> Term g

@@ -29,6 +29,13 @@ data (f :+: g) (a :: * -> *) (b :: * -> *) i = Inl (f a b i)                                              | Inr (g a b i) +{-| Utility function to case on a higher-order difunctor sum, without exposing+  the internal representation of sums. -}+caseHD :: (f a b i -> c) -> (g a b i -> c) -> (f :+: g) a b i -> c+caseHD f g x = case x of+                 Inl x -> f x+                 Inr x -> g x+ instance (HDifunctor f, HDifunctor g) => HDifunctor (f :+: g) where     hdimap f g (Inl e) = Inl (hdimap f g e)     hdimap f g (Inr e) = Inr (hdimap f g e)

@@ -18,6 +18,7 @@     (      (:<:),      (:+:),+     caseHD,       -- * Projections for Signatures and Terms      proj,

@@ -35,6 +35,14 @@ data (f :+: g) e = Inl (f e)                  | Inr (g e) +{-| Utility function to case on a functor sum, without exposing the internal+  representation of sums. -}+caseF :: (f a -> b) -> (g a -> b) -> (f :+: g) a -> b+{-# INLINE caseF #-}+caseF f g x = case x of+                Inl x -> f x+                Inr x -> g x+ instance (Functor f, Functor g) => Functor (f :+: g) where     fmap f (Inl e) = Inl (fmap f e)     fmap f (Inr e) = Inr (fmap f e)

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | -- Module      :  Data.Comp.Param.Derive@@ -34,10 +35,10 @@      -- ** Smart Constructors w/ Annotations      module Data.Comp.Param.Derive.SmartAConstructors,      -- ** Lifting to Sums-     module Data.Comp.Param.Derive.LiftSum+     liftSum     ) where -import Data.Comp.Derive.Utils (derive)+import Data.Comp.Derive.Utils (derive, liftSumGen) import Data.Comp.Param.Derive.Equality import Data.Comp.Param.Derive.Ordering import Data.Comp.Param.Derive.Show@@ -45,4 +46,12 @@ import Data.Comp.Param.Derive.Ditraversable import Data.Comp.Param.Derive.SmartConstructors import Data.Comp.Param.Derive.SmartAConstructors-import Data.Comp.Param.Derive.LiftSum+import Data.Comp.Param.Ops ((:+:), caseD)++import Language.Haskell.TH++{-| Given the name of a type class, where the first parameter is a difunctor,+  lift it to sums of difunctors. Example: @class ShowD f where ...@ is lifted+  as @instance (ShowD f, ShowD g) => ShowD (f :+: g) where ... @. -}+liftSum :: Name -> Q [Dec]+liftSum = liftSumGen 'caseD ''(:+:)

@@ -1,37 +0,0 @@-{-# LANGUAGE TemplateHaskell, TypeOperators #-}------------------------------------------------------------------------------------ |--- Module      :  Data.Comp.Param.Derive.LiftSum--- Copyright   :  (c) 2011 Patrick Bahr, Tom Hvitved--- License     :  BSD3--- Maintainer  :  Tom Hvitved <hvitved@diku.dk>--- Stability   :  experimental--- Portability :  non-portable (GHC Extensions)------ Lift a class declaration for difunctors to sums of difunctors.--------------------------------------------------------------------------------------module Data.Comp.Param.Derive.LiftSum-    (-     liftSum,-     caseD-    ) where--import Language.Haskell.TH hiding (Cxt)-import Data.Comp.Derive.Utils-import Data.Comp.Param.Sum-import Data.Comp.Param.Ops ((:+:)(..))--{-| Given the name of a type class, where the first parameter is a difunctor,-  lift it to sums of difunctors. Example: @class ShowD f where ...@ is lifted-  as @instance (ShowD f, ShowD g) => ShowD (f :+: g) where ... @. -}-liftSum :: Name -> Q [Dec]-liftSum = liftSumGen 'caseD ''(:+:)--{-| Utility function to case on a difunctor sum, without exposing the internal-  representation of sums. -}-caseD :: (f a b -> c) -> (g a b -> c) -> (f :+: g) a b -> c-caseD f g x = case x of-                Inl x -> f x-                Inr x -> g x

@@ -16,8 +16,8 @@ module Data.Comp.Param.Desugar where  import Data.Comp.Param-import Data.Comp.Param.Derive + -- |The desugaring term homomorphism. class (Difunctor f, Difunctor g) => Desugar f g where     desugHom :: Hom f g@@ -25,7 +25,10 @@     desugHom' :: f a (Cxt h g a b) -> Cxt h g a b     desugHom' x = appCxt (desugHom x) -$(derive [liftSum] [''Desugar])+-- We make the lifting to sums explicit in order to make the Desugar+-- class work with the default instance declaration further below.+instance (Desugar f h, Desugar g h) => Desugar (f :+: g) h where+    desugHom = caseD desugHom desugHom  -- |Desugar a term. desugar :: Desugar f g => Term f -> Term g

@@ -27,6 +27,13 @@ data (f :+: g) a b = Inl (f a b)                    | Inr (g a b) +{-| Utility function to case on a difunctor sum, without exposing the internal+  representation of sums. -}+caseD :: (f a b -> c) -> (g a b -> c) -> (f :+: g) a b -> c+caseD f g x = case x of+                Inl x -> f x+                Inr x -> g x+ instance (Difunctor f, Difunctor g) => Difunctor (f :+: g) where     dimap f g (Inl e) = Inl (dimap f g e)     dimap f g (Inr e) = Inr (dimap f g e)

@@ -18,6 +18,7 @@     (      (:<:),      (:+:),+     caseD,       -- * Projections for Signatures and Terms      proj,

@@ -20,9 +20,9 @@ import Data.Comp.Term import Data.Comp.Annotation import Data.Comp.Algebra+import Data.Comp.Derive (liftSum) import Data.Comp.Derive.Utils (derive) import Data.Comp.Derive.Show-import Data.Comp.Derive.LiftSum  instance (Functor f, ShowF f) => ShowF (Cxt h f) where     showF (Hole s) = s

@@ -18,6 +18,7 @@     (      (:<:),      (:+:),+     caseF,       -- * Projections for Signatures and Terms      proj,

@@ -28,7 +28,8 @@      variables',      substVars,      appSubst,-     compSubst+     compSubst,+     getBoundVars     ) where  import Data.Comp.Term

@@ -12,9 +12,7 @@ import Data.Comp.Multi.HFunctor import Data.Comp.Multi.Show () -import Data.Map (Map) import qualified Data.Map as Map-import Data.Set (Set) import qualified Data.Set as Set  import Test.Framework@@ -84,7 +82,7 @@ letExp' = iLet X (iInt 1 `iPlus` iInt 1) (iAbs Y (iVar Y `iPlus` iVar X) `iApp` iInt 3)  -- letrec x = x + 1 in (\y. y + x) z-recExp, recExp :: Expression SigRec+recExp, recExp' :: Expression SigRec recExp = iLetRec X (iVar X `iPlus` iInt 1) (iAbs Y (iVar Y `iPlus` iVar X) `iApp` iVar Z) recExp' = iLetRec X (iVar X `iPlus` iInt 1) (iAbs Y (iVar Y `iPlus` iVar X) `iApp` iInt 3) 

@@ -71,7 +71,7 @@ letExp' = iLet X (iInt 1 `iPlus` iInt 1) (iAbs Y (iVar Y `iPlus` iVar X) `iApp` iInt 3)  -- letrec x = x + 1 in (\y. y + x) z-recExp, recExp :: Term SigRec+recExp, recExp' :: Term SigRec recExp = iLetRec X (iVar X `iPlus` iInt 1) (iAbs Y (iVar Y `iPlus` iVar X) `iApp` iVar Z) recExp' = iLetRec X (iVar X `iPlus` iInt 1) (iAbs Y (iVar Y `iPlus` iVar X) `iApp` iInt 3)