I am encoding (as an assumption) the functor identity law like so:
...
import qualified Prelude ()
...
{-# class Functor f where
fmap :: forall a b. (a -> b) -> (f a -> f b) #-}
class Functor f where
fmap :: (a -> b) -> (f a -> f b)
-- identity function
{-# id :: forall a . x : a -> {y : a | x = y} #-}
id :: forall a . a -> a
id x = x
-- functor law: mapping with identity is identity
{-# assume
fmap_id :: forall f a . Functor f => x : f a ->
{fmap id x = id x} #-}
fmap_id :: Functor f => f a -> ()
fmap_id _ = ()
I can't see anything wrong with this formulation, yet I get this error from LH:
src/Category/Functor/LH.hs:45:16: error:
• Illegal type specification for `Category.Functor.LH.fmap_id`
Category.Functor.LH.fmap_id :: forall f a .
(Functor<[]> f) =>
x:f a -> {VV : () | Category.Functor.LH.fmap Category.Functor.LH.id x == Category.Functor.LH.id x}
Sort Error in Refinement: {VV : Tuple | Category.Functor.LH.fmap Category.Functor.LH.id x == Category.Functor.LH.id x}
Unbound symbol Category.Functor.LH.fmap --- perhaps you meant: Category.Functor.LH.C:Functor ?
•
|
45 | fmap_id :: forall f a . Functor f => x : f a ->
|
What am I doing wrong? My goal is to formulate this point-free with extensionality, but at least this point-wise formulation should work first.
Configuration:
GHC version: 8.10.1
Cabal version: 3.2.0.0
Liquid Haskell version: 0.8.10.2
Support for typeclasses is not yet supported in the official release of Liquid Haskell (although it is almost ready to merge). For now, you can use this fork which implements typeclass support. After recursively cloning the repository, you can install the forked version with:
pushd liquid-benchmark/liquidhaskell
stack install
popd
We define Functor and its laws (in the VFunctor subclass) in liquid-base/liquid-base/src/Data/Functor/Classes.hs as follows. Notice that you can specify refinements on the typeclass methods directly.
class Functor f where
{-# fmap :: forall a b. (a -> b) -> f a -> f b #-}
fmap :: (a -> b) -> f a -> f b
(<$) :: a -> f b -> f a
class Functor m => VFunctor m where
{-# lawFunctorId :: forall a . x:m a -> {fmap id x == id x} #-}
lawFunctorId :: m a -> ()
{-# lawFunctorComposition :: forall a b c . f:(b -> c) -> g:(a -> b) -> x:m a -> { fmap (compose f g) x == compose (fmap f) (fmap g) x } #-}
lawFunctorComposition :: forall a b c. (b -> c) -> (a -> b) -> m a -> ()
You can run the forked version of Liquid Haskell on the typeclass definitions with:
liquid --typeclass -i liquid-base/liquid-base/src/ liquid-base/liquid-base/src/Data/Functor/Classes.hs
We create a verified Maybe instance in liquid-base/liquid-base/src/Data/Maybe/Functor.hs with:
instance Functor Maybe where
fmap _ Nothing = Nothing
fmap f (Just x) = Just (f x)
_ <$ Nothing = Nothing
x <$ (Just _) = Just x
instance VFunctor Maybe where
lawFunctorId Nothing = ()
lawFunctorId (Just _) = ()
lawFunctorComposition f g Nothing = ()
lawFunctorComposition f g (Just x) = ()
You can run Liquid Haskell on the Maybe instance to verify that it satisfies the required laws:
liquid --typeclass -i liquid-base/liquid-base/src/ liquid-base/liquid-base/src/Data/Maybe/Functor.hs
Related
The rank2classes package provides a version of Functor for which the mapped functions seem to be natural transformations between type constructors.
Following that idea, here's a rank-2 version of Bifunctor:
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneKindSignatures #-}
import Data.Kind
type Rank2Bifunctor :: ((Type -> Type) -> (Type -> Type) -> Type) -> Constraint
class Rank2Bifunctor b where
rank2bimap ::
(forall x. p x -> p' x) -> (forall x. q x -> q' x) -> b p q -> b p' q'
It seems clear that this type Foo can be given a Rank2Bifunctor instance:
data Foo f g = Foo (f Int) (g Int)
instance Rank2Bifunctor Foo where
rank2bimap tleft tright (Foo f g) = Foo (tleft f) (tright g)
But what about this Bar type which nests f and g:
data Bar f g = Bar (f (g Int))
For starters, it seems that we would need to require Functor p in the signature of rank2bimap, to be able to transform the g inside the f.
Is Bar a valid "rank-2 bifunctor"?
Indeed that's not an instance of your Bifunctor, since the lack of constraint allows you to pick a contravariant functor for f and then rank2bimap would amount roughly to implement fmap for f:
rank2bimap id :: (g ~> g') -> Bar f g -> Bar f g' -- covariance of f, kinda (since Bar f g = f (g Int))
type f ~> f' = (forall x. f x -> f' x)
If you add the requirement that f and g (optional here) be functors, then you do get a bifunctor:
rank2bimap :: (Functor f, Functor g) => (f ~> f') -> (g ~> g') -> Bar f g -> Bar f' g'
In particular, to prove the bifunctor laws, you will need the free theorem of f ~> f', assuming f and f' are functors, then n :: f ~> f' satisfies that for all phi, fmap phi . n = n . fmap phi.
I've got the following use-case: I'm building a custom AST. As an optimization for certain operations I'm doing on the AST, I've defined a list of children for an AST node thus:
data NodeChHolder a = NNode [a] -- For "normal" operators
| ACNode (MultiSet a) -- For operators that can be re-ordered and parenthesized arbitrarily
| NCNode -- Empty, no children
Now, I want to make this type a Functor. However, there's a problem because MultiSet requires its type parameter to be Ord. So, this didn't work:
instance Functor NodeChHolder where
fmap f (NNode l) = NNode $ map f l
fmap f (ACNode s) = ACNode $ MultiSet.map f s
fmap _ NCNode = NCNode
I got an error saying that there's "no instance for Ord b arising from a use of MultiSet.map", which is fair.
To resolve this problem, I tried the following approach using the ScopedTypeVariables ghc extension. I thought that this would work similarly to how it works with types, but it appears typeclasses are different:
instance Functor NodeChHolder where
fmap f (NNode l) = NNode $ map f l
fmap (f :: (Ord a, Ord b) => a -> b) (ACNode s) = ACNode $ MultiSet.map f s
fmap f (ACNode s) = NNode $ map f (MultiSet.toList s)
fmap _ NCNode = NCNode
This also failed with the same error message.
Next, I tried to change it a little, because to my understanding of forall from ScopedTypeVariables, it should have made sure that the a and b type variables that I'm using are the same as for fmap.
instance Functor NodeChHolder where
fmap f (NNode l) = NNode $ map f l
fmap (f :: forall a b. (Ord a, Ord b) => a -> b) (ACNode s) = ACNode $ MultiSet.map f s
fmap f (ACNode s) = NNode $ map f (MultiSet.toList s)
fmap _ NCNode = NCNode
The above didn't work, saying it "couldn't match b with b1", because they are both "rigid type variables". I thought this was because I needed to actually declare type parameters a and b for fmap itself, so I used the InstanceSigs extension as well and ended up with
instance Functor NodeChHolder where
fmap :: (a -> b) -> NodeChHolder a -> NodeChHolder b
fmap f (NNode l) = NNode $ map f l
fmap (f :: forall a b. (Ord a, Ord b) => a -> b) (ACNode s) = ACNode $ MultiSet.map f s
fmap f (ACNode s) = NNode $ map f (MultiSet.toList s)
fmap _ NCNode = NCNode
But I still got the same error about the rigid type variables.
At this point I don't even know if what I'm trying to do is even possible! Should I give up on trying to make this a functor altogether? With InstanceSigs, I could probably do fmap :: Ord b => (a -> b) -> NodeChHolder a -> NodeChHolder b, which would fit my usecase, but that would no longer be a true functor...
You can not do this using the regular Functor class. Such class has a method
fmap :: Functor f => (a -> b) -> f a -> f b
which does not put any constraints on a and b. This requires any instance to work with any choice for a and b. Indeed, if instances were allowed to put additional requirements, then fmap could not have the type above.
You could however used another type class to represent a constrained functor.
There is one in the package constrained-monads, which allows the following code.
import qualified Control.Monad.Constrained as C
data MultiSet a = Whatever -- stub
multiSet_map :: Ord b => (a -> b) -> MultiSet a -> MultiSet b
multiSet_map = undefined -- stub
data NodeChHolder a = NNode [a]
| ACNode (MultiSet a)
| NCNode
instance C.Functor NodeChHolder where
type Suitable NodeChHolder b = Ord b
fmap f (NNode l) = NNode $ map f l
fmap f (ACNode s) = ACNode $ multiSet_map f s
fmap _ NCNode = NCNode
This problem arose when attempting to fuse away intermediate triemaps in Haskell.
Consider the trie for Peano natural numbers:
data Nat = Zero | Succ Nat
data ExpoNat a = ExpoNat (Maybe a) (ExpoNat a)
| NoExpoNat
We can easily define a fold on ExpoNat (it is essentially a list) and use foldr/build (a.k.a. finally tagless) to fuse away intermediate occurrencess of ExpoNat:
{-# NOINLINE fold #-}
fold :: (Maybe a -> b -> b) -> b -> ExpoNat a -> b
fold f z (ExpoNat x y) = f x (fold f z y)
fold f z NoExpoNat = z
{-# NOINLINE build #-}
build :: (forall b. (Maybe a -> b -> b) -> b -> b) -> ExpoNat a
build f = f ExpoNat NoExpoNat
{-# RULES "fold/build" forall f n (g :: forall b. (Maybe a -> b -> b) -> b -> b). fold f n (build g) = g f n #-}
As an example, we take match and appl from "Is there a way to generalize this TrieMap code?" and compose them such that ExpoNat is fused away. (Note that we must "strengthen the induction hypothesis" in appl.)
{-# INLINE match #-}
match :: Nat -> ExpoNat ()
match n = build $ \f z ->
let go Zero = f (Just ()) z
go (Succ n) = f Nothing (go n)
in go n
{-# INLINE appl #-}
appl :: ExpoNat a -> (Nat -> Maybe a)
appl
= fold (\f z -> \n ->
case n of Zero -> f
Succ n' -> z n')
(\n -> Nothing)
applmatch :: Nat -> Nat -> Maybe ()
applmatch x = appl (match x)
The fusion can be verified by inspecting Core with -ddump-simpl.
Now we would like to do the same for Tree.
data Tree = Leaf | Node Tree Tree
data TreeMap a
= TreeMap {
tm_leaf :: Maybe a,
tm_node :: TreeMap (TreeMap a)
}
| EmptyTreeMap
We are in trouble: TreeMap is a non-regular data type, and so it is not obvious how to write its corresponding fold/build pair.
Haskell Programming with Nested Types: A Principled Approach seems to have the answer (see the Bush type) but 4:30 AM seems to be too late for me to get it working. How is one supposed to write hfmap? Have there been further developments since?
A similar variant of this question has been asked in What's the type of a catamorphism (fold) for non-regular recursive types?
I worked on it some more and I now have working fusion, without using the generic gadgets from the paper.
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
module Tree where
data Tree = Leaf | Node Tree Tree
deriving (Show)
data ExpoTree a = ExpoTree (Maybe a) (ExpoTree (ExpoTree a))
| NoExpoTree
deriving (Show, Functor)
I derived most of the specialized types by taking the generic construction and then inlining type definitions until I bottomed out. I've kept the generic construction in here for ease of comparison.
data HExpoTree f a = HExpoTree (Maybe a) (f (f a))
| HNoExpoTree
type g ~> h = forall a. g a -> h a
class HFunctor f where
ffmap :: Functor g => (a -> b) -> f g a -> f g b
hfmap :: (Functor g, Functor h) => (g ~> h) -> (f g ~> f h)
instance HFunctor HExpoTree where
ffmap f HNoExpoTree = HNoExpoTree
ffmap f (HExpoTree x y) = HExpoTree (fmap f x) (fmap (fmap f) y)
hfmap f HNoExpoTree = HNoExpoTree
hfmap f (HExpoTree x y) = HExpoTree x (f (fmap f y))
type Alg f g = f g ~> g
newtype Mu f a = In { unIn :: f (Mu f) a }
instance HFunctor f => Functor (Mu f) where
fmap f (In r) = In (ffmap f r)
hfold :: (HFunctor f, Functor g) => Alg f g -> (Mu f ~> g)
hfold m (In u) = m (hfmap (hfold m) u)
An Alg ExpoTreeH g can be decomposed into a product of two natural transformations:
type ExpoTreeAlg g = forall a. Maybe a -> g (g a) -> g a
type NoExpoTreeAlg g = forall a. g a
{-# NOINLINE fold #-}
fold :: Functor g => ExpoTreeAlg g -> NoExpoTreeAlg g -> ExpoTree a -> g a
fold f z NoExpoTree = z
fold f z (ExpoTree x y) = f x (fold f z (fmap (fold f z) y))
The natural transformation here c ~> x is very interesting, and turns out to be quite necessary. Here's the build translation:
hbuild :: HFunctor f => (forall x. Alg f x -> (c ~> x)) -> (c ~> Mu f)
hbuild g = g In
newtype I :: (* -> *) where
I :: x -> I x
deriving (Show, Eq, Functor, Foldable, Traversable)
-- Needs to be a newtype, otherwise RULE firer gets bamboozled
newtype ExpoTreeBuilder c = ETP {runETP :: (forall x. Functor x
=> (forall a. Maybe a -> x (x a) -> x a)
-> (forall a. x a)
-> (forall a. c a -> x a)
)}
{-# NOINLINE build #-}
build :: ExpoTreeBuilder c -> forall a. c a -> ExpoTree a
build g = runETP g ExpoTree NoExpoTree
The newtype for the builder function is needed, because GHC 8.0 doesn't know how to fire the RULE without.
Now, the shortcut fusion rule:
{-# RULES "ExpoTree fold/build"
forall (g :: ExpoTreeBuilder c) c (f :: ExpoTreeAlg g) (n :: NoExpoTreeAlg g).
fold f n (build g c) = runETP g f n c #-}
Implementation of 'match' with 'build':
{-# INLINE match #-}
match :: Tree -> ExpoTree ()
match n = build (match_mk n) (I ())
where
match_mk :: Tree -> ExpoTreeBuilder I
match_mk Leaf = ETP $ \ f z (I c) -> f (Just c) z
match_mk (Node x y) = ETP $ \ f z c ->
-- NB: This fmap is bad for performance
f Nothing (fmap (const (runETP (match_mk y) f z c)) (runETP (match_mk x) f z c))
Implementation of 'appl' with 'fold' (we need to define a custom functor to define the return type.)
newtype PFunTree a = PFunTree { runPFunTree :: Tree -> Maybe a }
deriving (Functor)
{-# INLINE appl #-}
appl :: ExpoTree a -> PFunTree a
appl = fold appl_expoTree appl_noExpoTree
where
appl_expoTree :: ExpoTreeAlg PFunTree
appl_expoTree = \z f -> PFunTree $ \n ->
case n of Leaf -> z
Node n1 n2 -> runPFunTree f n1 >>= flip runPFunTree n2
appl_noExpoTree :: NoExpoTreeAlg PFunTree
appl_noExpoTree = PFunTree $ \n -> Nothing
Putting it all together:
applmatch :: Tree -> Tree -> Maybe ()
applmatch x = runPFunTree (appl (match x))
We can once again inspect the core with -ddump-simpl. Unfortunately, while we have successfully fused away the TrieMap data structure, we are left with suboptimal code due to the fmap in match. Eliminating this inefficiency is left to future work.
The paper appears to draw a parallel between ExpoNat a as a recursive Type and Tree as a recursive type constructor (Type -> Type).
newtype Fix f = Fix (f ( Fix f))
newtype HFix h a = HFix (h (HFix h) a)
Fix f represents the least fixed point of the endofunctor on the category of types and functions, f :: Type -> Type; HFix h represents the least fixed point of the endofunctor h on a category of functors and natural transformations, h :: (Type -> Type) -> (Type -> Type).
-- x ~ Fix (ExpoNatF a) ~ ExpoNat
data ExpoNatF a x = ExpoNatF (Maybe a) x | NoExpoNatF
fmap :: (x -> y) -> ExpoNatF a x -> ExpoNatF a y
fmap f (ExpoNatF u v) = ExpoNatF u (f v)
fmap _ NoExpoNatF = NoExpoNatF
-- f ~ HFix TreeMapH ~ TreeMap
data TreeMapH f a = TreeMapH (Maybe a) (f (f a)) | EmptyTreeMapH
hfmap :: (f ~> g) -> (TreeMapH f ~> TreeMapH g)
hfmap f (TreeMapH u v) = TreeMapH u ((fmap . fmap) f v)
hfmap _ EmptyTreeMapH = EmptyTreeMapH
-- (~>) is the type of natural transformations
type f ~> g = forall a. f a -> g a
Endofunctors give rise to algebras.
type Alg f a = f a -> a
type HAlg h f = h f ~> f
fold, or cata maps any algebra to a morphism (function|natural transformation).
cata :: Alg f a -> Fix f -> a
hcata :: HAlg h f -> (HFix h ~> h)
build constructs a value from its Church encoding.
type Church f = forall a. Alg f a -> a
type HChurch h = forall f. HAlg h f ~> f
build :: Church f -> Fix f
hbuild :: HChurch h -> HFix h a
-- The paper actually has a slightly different type for Church encodings, derived from the categorical view, but I'm pretty sure they're equivalent
build/fold fusion is summarized by one equation.
cata alg ( build f) = f alg
hcata alg (hbuild f) = f alg
Given a simple "language":
data Expr a where
ConstE :: a -> Expr a
FMapE :: (b -> a) -> Expr b -> Expr a
instance Functor Expr where
fmap = FMapE
interpret :: Expr a -> a
interpret (ConstE a) = a
interpret (FMapE f a) = f (interpret a)
From that I would like to extract a call graph, eg:
foo = fmap show . fmap (*2) $ ConstE 1
Should result in the graph Node 1 -> Node (*2) -> Node show. Ideally I'd like to store this in a Data.Graph.
What I've come up to this point is that it should be possible to use System.Mem.StableNames to identify individual nodes and store them in a HashMap (StableName (Expr a)) (Expr a).
toHashMap :: Expr a -> HashMap (StableName (Expr a)) (Expr a)
toHashMap n#ConstE = do
sn <- makeStableName n
return $ HashMap.singleton sn n
The problem is, that there seems to be no way to get through the FMapE nodes:
toHashMap n#(FMapE _ a) = do
snN <- makeStableName n
snA <- makeStableName a
-- recurse
hmA <- toHashMap a
-- combine
return $ HashMap.singleton snN n `HashMap.union` hmA
GHC will complain along the lines of this:
Couldn't match type ‘t’ with ‘b’
because type variable ‘b’ would escape its scope
This (rigid, skolem) type variable is bound by
a pattern with constructor
FMapE :: forall a b. (b -> a) -> Expr b -> Expr a,
in an equation for ‘toHashMap’
I can see that this won't match ... but I have no clue on how to make this work.
Edit
This probably boils down to writing a children function:
children :: Event a -> [Event a]
children (ConstE) = []
children (FMapE _ a) = [a] -- doesn't match ...
For the same reason I can't uniplate on this ...
You can get a postorder traversal, which is a tolopogical sort for a tree, of a type of kind * -> * from the Uniplate1 class I've described previously.
{-# LANGUAGE RankNTypes #-}
import Control.Applicative
import Control.Monad.Identity
class Uniplate1 f where
uniplate1 :: Applicative m => f a -> (forall b. f b -> m (f b)) -> m (f a)
descend1 :: (forall b. f b -> f b) -> f a -> f a
descend1 f x = runIdentity $ descendM1 (pure . f) x
descendM1 :: Applicative m => (forall b. f b -> m (f b)) -> f a -> m (f a)
descendM1 f a = uniplate1 a f
transform1 :: Uniplate1 f => (forall b. f b -> f b) -> f a -> f a
transform1 f = f . descend1 (transform1 f)
transform1 is a generic postorder tranformation. A generic postorder Monadic traversal of a Uniplate1 is
transformM1 :: (Uniplate1 f, Applicative m, Monad m) =>
(forall b. f b -> m (f b)) ->
f a -> m (f a)
transformM1 f = (>>= f) . descendM1 (transformM1 f)
We can write a Uniplate1 instance for Expr:
instance Uniplate1 Expr where
uniplate1 e p = case e of
FMapE f a -> FMapE f <$> p a
e -> pure e
We'll make a simple dump function for demonstration purposes and bypass to restore the data after a monadic effect.
dump :: Expr b -> IO ()
dump (ConstE _) = putStrLn "ConstE"
dump (FMapE _ _) = putStrLn "FMapE"
bypass :: Monad m => (a -> m ()) -> a -> m a
bypass f x = f x >> return x
We can traverse your example in topological order
> transformM1 (bypass dump) (fmap show . fmap (*2) $ ConstE 1)
ConstE
FMapE
FMapE
Having read the article Scrap your type classes, I re-implemented some of the ideas shown.
While doing that I came across something really strange: The Type Class - Type can be used as a type constraint! My question: Why is that?
My Code:
{-# LANGUAGE Rank2Types #-}
data IFunctor f = IFunctor {
_fmap :: forall a b. (a -> b) -> f a -> f b
}
-- this type checks...
_fmap2 :: IFunctor f => (a -> b) -> f (f a) -> f (f b)
_fmap2 = \inst -> _fmap inst . _fmap inst
In GHCi the following thing happens:
>>> :t _fmap2 :: IFunctor f => (a -> b) -> f (f a) -> f (f b)
_fmap2 :: IFunctor f => (a -> b) -> f (f a) -> f (f b)
:: IFunctor f -> (a -> b) -> f (f a) -> f (f b)
This doesn't work on GHC 7.8.2. It gives the error Expected a constraint, but ‘IFunctor f’ has kind ‘*’.
Older versions of GHC had a bug where they allowed => to be used like -> in certain situations. This is likely because internally type class constraints are passed as arguments in the form of method dictionaries.