Roman Cheplyaka wrote: > > {-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances, > FlexibleInstances #-} > import Data.Fixpoint > > newtype Expr = Expr { unExpr :: Pre Expr Expr } > > instance Functor (Pre Expr) => Fixpoint Expr where > data Pre Expr a > = Add a a > | Const Int > project = unExpr > inject = Expr > > instance Functor (Pre Expr) where > fmap f (Const x) = Const x > fmap f (Add x1 x2) = Add (f x1) (f x2) > > eval = cata eval' where > eval' (Const x) = x > eval' (Add x1 x2) = x1 + x2 > > There are some issues with this code, compared to simply using > > newtype Fix f = In { out :: f (Fix f) } > > to build an Expr. > > 1. Since 'Pre' is a data (not type) family, we cannot simply make use of > a functor defined elsewhere. We need to define the functor inside the > instance declaration (or at least wrap an existing functor).
Yes, it would be nicer if it was a type family. There is a single reason why this isn't the case but I find that reason pretty compelling: you couldn't type hylo if it was. > 2. I wasn't able to derive the Functor instance, getting an error > > Derived instance `Functor (Pre Expr)' > requires illegal partial application of data type family Pre > In the data type instance declaration for `Pre' That's really a GHC problem. There is no reason why it shouldn't be able to do this. > 3. Having to use UndecidableInstances makes me feel a bit uncomfortable. You don't need UndecidableInstances. Just get rid of the Functor (Pre Expr) constraint on the Fixpoint Expr instance, it's doesn't do anything anyway. Roman _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe