I am trying to create a instance of Show for haskell operator or functions, but I just can't figure it out how...
I tried
instance (Show (+)) where
show (+) = "+"
but of course, it doesn't work. Does anyone know how to do it?
This might not be what you're looking for, but it might be the closest you can get: we can always turn a typeclass signature into a concrete data type.
-- built it
class Num a where
(+) :: a -> a -> a
(*) :: a -> a -> a
(-) :: a -> a -> a
negate :: a -> a
abs :: a -> a
signum :: a -> a
fromInteger :: Integer -> a
-- ours
data Num
= Plus Num Num
| Mult Num Num
| Subt Num Num
| Neg Num
| Abs Num
| Signun Num
| FromInt Integer
deriving ( Show )
instance Num Num where
(+) = Plus
(-) = Subt
(*) = Mult
negate = Neg
abs = Abs
signum = Signum
fromInteger = FromInt
And now we can use the deriving ( Show ) bit on our Num data type to see expressions.
>>> 3 + 2 :: Num
Plus (FromInt 3) (FromInt 2)
But generally there's no way much simpler than this to show Haskell functions or operators. Usually once you've gotten a value of a type like a -> b then the best thing you can do to examine it is to feed it as
instance Show a => Show (Bool -> a) where
show f = "Fun { True -> " ++ show (f True) ++ ", False -> " ++ show (f False) ++ " }"
>>> id :: Bool -> Bool
Fun { True -> True, False -> False }
>>> not
Fun { True -> False, False -> True}
Related
(With possibly using GHC extensions), is there a way to reduce boilerplate in this kind of code?
data Operation = Add | Sub | Mult | Div
data Number
= IntVal Integer
| FloatVal Double
evaluate :: Operation -> Number -> Number -> Number
evaluate op lhs rhs = case op of
Add -> case (lhs, rhs) of
(IntVal i, IntVal j) -> IntVal $ i + j
(FloatVal x, FloatVal y) -> FloatVal $ x + y
_ -> undefined
Sub -> case (lhs, rhs) of
(IntVal i, IntVal j) -> IntVal $ i - j
(FloatVal x, FloatVal y) -> FloatVal $ x - y
_ -> undefined
Mult -> case (lhs, rhs) of
(IntVal i, IntVal j) -> IntVal $ i * j
(FloatVal x, FloatVal y) -> FloatVal $ x * y
_ -> undefined
Deriving instance Num Number would run into the same issue.
If you just want to reduce the boilerplate of the similar pattern matches, then the standard strategy works. Make a helper function that does the repeating stuff, and pull out the bits that vary into parameters:
data Operation = Add | Sub | Mult | Div
deriving Show
data Number
= IntVal Integer
| FloatVal Double
deriving Show
liftIntFloatBinOp
:: (Integer -> Integer -> Integer) -> (Double -> Double -> Double)
-> (Number -> Number -> Number)
liftIntFloatBinOp iOp fOp x y
= case (x, y) of
(IntVal x', IntVal y') -> IntVal $ x' `iOp` y'
(FloatVal x', FloatVal y') -> FloatVal $ x' `fOp` y'
_ -> undefined
evaluate :: Operation -> (Number -> Number -> Number)
evaluate op
= case op of
Add -> liftIntFloatBinOp (+) (+)
Sub -> liftIntFloatBinOp (-) (-)
Mult -> liftIntFloatBinOp (*) (*)
Div -> liftIntFloatBinOp div (/)
I added deriving Show just so you can see it works in ghci:
λ let (|*|) = evaluate Mult in IntVal 3 |*| IntVal 7
IntVal 21
it :: Number
λ let (|*|) = evaluate Mult in FloatVal 3 |*| FloatVal 7
FloatVal 21.0
it :: Number
λ let (|*|) = evaluate Mult in FloatVal 3 |*| IntVal 7
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:74:14 in base:GHC.Err
undefined, called at foo.hs:19:12 in main:Number
If you want, you can then apply the same strategy again to get rid of the repeated calls to liftIntFloatBinOp (although with a less verbose name they would matter less anyway), by implementing something like:
toIntFloatOps :: Operation -> (Integer -> Integer -> Integer, Double -> Double -> Double)
toIntFloatOps op
= case op of
Add -> ((+), (+))
Sub -> ((-), (-))
Mult -> ((*), (*))
Div -> (div, (/))
evaluate :: Operation -> (Number -> Number -> Number)
evaluate = uncurry liftIntFloatBinOp . toIntFloatOps
You may have been hoping for something fancy like using {-# LANGUAGE RankNTypes #-} to write:
liftNumOp
:: (forall t. Num t => t -> t -> t)
-> (Number -> Number -> Number)
liftNumOp op x y
= case (x, y) of
(IntVal x', IntVal y') -> IntVal $ x' `op` y'
(FloatVal x', FloatVal y') -> FloatVal $ x' `op` y'
_ -> undefined
This does work to a degree. You can use this to try:
λ liftNumOp (*) (IntVal 3) (IntVal 6)
IntVal 18
But it fails when you want division:
λ liftNumOp (/) (IntVal 3) (IntVal 6)
<interactive>:16:11: error:
• Could not deduce (Fractional t) arising from a use of ‘/’
from the context: Num t
bound by a type expected by the context:
forall t. Num t => t -> t -> t
at <interactive>:16:11-13
Possible fix:
add (Fractional t) to the context of
a type expected by the context:
forall t. Num t => t -> t -> t
• In the first argument of ‘liftNumOp’, namely ‘(/)’
In the expression: liftNumOp (/) (IntVal 3) (IntVal 6)
In an equation for ‘it’: it = liftNumOp (/) (IntVal 3) (IntVal 6)
λ liftNumOp (div) (IntVal 3) (IntVal 6)
<interactive>:17:12: error:
• Could not deduce (Integral t) arising from a use of ‘div’
from the context: Num t
bound by a type expected by the context:
forall t. Num t => t -> t -> t
at <interactive>:17:11-15
Possible fix:
add (Integral t) to the context of
a type expected by the context:
forall t. Num t => t -> t -> t
• In the first argument of ‘liftNumOp’, namely ‘(div)’
In the expression: liftNumOp (div) (IntVal 3) (IntVal 6)
In an equation for ‘it’: it = liftNumOp (div) (IntVal 3) (IntVal 6)
It fails for the a very simple reason you would have noticed yourself if you'd actually kept going with your original boilerplatey version: there is no single division operator that works on both integers and floating point numbers. So there's no polymorphic function you can pass that can be applied to either type your Number might contain, even when you use RankNTypes to pass an argument function that is "still polymorphic".
So honestly, the low-tech helper function approach is probably better.
In this example you can just reorder the structure:
evaluate op lhs rhs = case (lhs, rhs) of
(IntVal i, IntVal j) -> IntVal $ i % j
(FloatVal x, FloatVal y) -> FloatVal $ x % y
_ -> undefined
where (%) :: Num a => a -> a -> a
(%) = case op of
Add -> (+)
Sum -> (-)
Mult -> (*)
You can make a generic function first:
handling :: (Integer -> Integer -> Integer) -> (Float -> Float -> Float) -> Number -> Number -> Number
handling f g = go
where go (IntVal x) (IntVal y) = IntVal (f x y)
go (FloatVal x) (FloatVal y) = FloatVal (g x y)
go _ _ = undefined
then it is:
evaluate :: Operation -> Number -> Number -> Number
evaluate Add = handling (+) (+)
evaluate Sub = handling (-) (-)
evaluate Mult = handling (*) (*)
A fairly primitive alternative choice to consider:
evaluate op (IntVal l) (IntVal r) = IntVal $ case op of
Add -> l + r
Sub -> l - r
Mult -> l * r
evaluate op (FloatVal l) (FloatVal r) = FloatVal $ case op of
Add -> l + r
Sub -> l - r
Mult -> l * r
evaluate op _ _ = undefined
The amount of repetition is not reduced to zero, but it's reduced a lot.
I'm trying to implement a function that multiplies polynomials (represented using lists -- 3x^2 + 5x + 2 = P [2,5,3]):
newtype Poly a = P [a]
plus :: Num a => Poly a -> Poly a -> Poly a
plus (P a) (P b) = P (map (\(y,z) -> z + y) (zipWithPadding 0 a b))
where
zipWithPadding :: (Num a) => a -> [a] -> [a] -> [(a, a)]
zipWithPadding e (aa: as) (bb: bs) = ((aa, bb): zipWithPadding e as bs)
zipWithPadding e [] bs = zip (repeat e) bs
zipWithPadding e as [] = zip as (repeat e)
times :: Num a => Poly a -> Poly a -> Poly a
times (P a) (P b) = sum $ multList 0 [] a b
where
multList :: Num a => Int -> [Poly a] -> [a] -> [a] -> [Poly a]
multList _ s [] _ = s
multList e s (aa:as) bs = multList (e + 1) (s ++ (multElement e aa bs)) as bs
multElement :: Num a => Int -> a -> [a] -> [Poly a]
multElement e aa bs = [P $ replicate e 0 ++ (map (*aa) bs)]
instance Num a => Num (Poly a) where
(+) = plus
(*) = times
negate = undefined
fromInteger = undefined
-- No meaningful definitions exist
abs = undefined
signum = undefined
When I tried to run however, I got an undefined error:
*HW04> times (P [1,2,2]) (P [1,2])
*** Exception: Prelude.undefined
I'm confused.
Clearly you are calling one of the undefined methods in the Num instance for Poly.
You can determine which one is being called by using these definitions:
negate = error "Poly negate undefined"
fromInteger = error "Poly fromInteger undefined"
abs = error "Poly abs undefined"
signum = error "Poly signum undefined"
Running your test expression yields:
Poly *** Exception: Poly fromInteger undefined
The problem is in your use of sum which is essentially defined as:
sum xs = foldl (+) 0 xs
It is therefore calling fromInteger 0. You can fix this with:
fromInteger x = P [ fromInteger x ]
Update
The reason fromInteger for Poly a needs to be defined this way is
because we need to construct a list of Num a values, and fromInteger x
is the way to create a Num a from the Integer value x.
A polynomial is not really a Num, although there is a ring monomorphism Num a => a -> Poly a.
Discard that Num instance and use foldl plus instead of sum.
I'm going to take the position that you should not define an instance of a class simply to hijack the class's functions. The minimal definition of a Num instance expects certain functions to be defined; explicitly assigning undefined to those names does not qualify as a definition. Consider that Haskell provides a specific operator (++) for list concatenation instead of simply overloading (+) with an instance like
instance Num [a] where
a + [] = a
[] + b = b
(a:as) + b = a:(as + b)
(*) = undefined
negate = undefined
-- etc
Instead, define a class that does provide the operations you want. In this case, you want a Ring, which is a type along with two operations, addition and multipication, that obey certain laws. (Put briefly, the operations act as you would expect given the integers as an example, except multiplication is not required to be commutative.)
In Haskell, we would define the class as
class Ring a where
rplus :: a -> a -> a -- addition
rmult :: a -> a -> a -- multiplication
rnegate :: a -> a -- negation
runit :: a -- multiplicative identity
rzero :: a -- additive identity, multiplicative zero
Any value with a valid Num instance forms a ring, although you need to define the instances separately.
instance Ring Integer where
rplus = (+)
rmult = (*)
rnegate = negate
rzero = 0
runit = 1
instance Ring Float
rplus = (+)
rmult = (*)
rnegate = negate
rzero = 0
runit = 1
-- etc
You can define an instance of Ring for polynomials, as long as the coefficients form a ring as well.
newtype Poly a = P [a]
instance Ring a => Ring (Poly a) where
-- Take care to handle polynomials with different degree
-- Note the use of rplus and rzero instead of (+) and 0
-- when dealing with coefficients
rplus (P a) (P b) = case (compare (length a) (length b)) of
LT -> rplus (P (rzero:a)) (P b)
EQ -> P $ zipWith rplus a b
GT -> rplus (P a) (P (rzero:b))
-- I leave a correct implementation of rmult as an exercise
-- for the reader.
rmult = ...
rnegate (P coeffs) = P $ map rnegate coeffs
rzero = P [0]
runit = P [1]
I'm trying to understand the result of
(*) . (+)
in Haskell. I know that the composition operator is just the standard composition of mathematical functions- so
(f . g) = f (g x)
But:
(*) . (+) :: (Num (a -> a), Num a) => a -> (a -> a) -> a -> a
I'm struggling to understand this type signature. I would have expected to be able to do things like:
((*) . (+)) 1 2 :: Num a => a -> a
= (* (+ 1 2))
What is the meaning of (*) . (+)'s type signature? I tried playing with it by something like (just matching up with its signature):
((*) . (+)) 1 (\x -> x + 1) 1
But that fails to compile. I'm trying to walk through the logical steps when composing these, but I'm not fully understanding how it's getting to this result (and what the result is).
I understand how you feel. I found function composition to be quite difficult to grasp at first too. What helped me grok the matter were type signatures. Consider:
(*) :: Num x => x -> x -> x
(+) :: Num y => y -> y -> y
(.) :: (b -> c) -> (a -> b) -> a -> c
Now when you write (*) . (+) it is actually the same as (.) (*) (+) (i.e. (*) is the first argument to (.) and (+) is the second argument to (.)):
(.) :: (b -> c) -> (a -> b) -> a -> c
|______| |______|
| |
(*) (+)
Hence the type signature of (*) (i.e. Num x => x -> x -> x) unifies with b -> c:
(*) :: Num x => x -> x -> x -- remember that `x -> x -> x`
| |____| -- is implicitly `x -> (x -> x)`
| |
b -> c
(.) (*) :: (a -> b) -> a -> c
| |
| |‾‾‾‾|
Num x => x x -> x
(.) (*) :: Num x => (a -> x) -> a -> x -> x
Hence the type signature of (+) (i.e. Num y => y -> y -> y) unifies with Num x => a -> x:
(+) :: Num y => y -> y -> y -- remember that `y -> y -> y`
| |____| -- is implicitly `y -> (y -> y)`
| |
Num x => a -> x
(.) (*) (+) :: Num x => a -> x -> x
| | |
| |‾‾‾‾| |‾‾‾‾|
Num y => y y -> y y -> y
(.) (*) (+) :: (Num (y -> y), Num y) => y -> (y -> y) -> y -> y
I hope that clarifies where the Num (y -> y) and Num y come from. You are left with a very weird function of the type (Num (y -> y), Num y) => y -> (y -> y) -> y -> y.
What makes it so weird is that it expects both y and y -> y to be instances of Num. It's understandable that y should be an instance of Num, but how y -> y? Making y -> y an instance of Num seems illogical. That can't be correct.
However, it makes sense when you look at what function composition actually does:
( f . g ) = \z -> f ( g z)
((*) . (+)) = \z -> (*) ((+) z)
So you have a function \z -> (*) ((+) z). Hence z must clearly be an instance of Num because (+) is applied to it. Thus the type of \z -> (*) ((+) z) is Num t => t -> ... where ... is the type of (*) ((+) z), which we will find out in a moment.
Therefore ((+) z) is of the type Num t => t -> t because it requires one more number. However, before it is applied to another number, (*) is applied to it.
Hence (*) expects ((+) z) to be an instance of Num, which is why t -> t is expected to be an instance of Num. Thus the ... is replaced by (t -> t) -> t -> t and the constraint Num (t -> t) is added, resulting in the type (Num (t -> t), Num t) => t -> (t -> t) -> t -> t.
The way you really want to combine (*) and (+) is using (.:):
(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
f .: g = \x y -> f (g x y)
Hence (*) .: (+) is the same as \x y -> (*) ((+) x y). Now two arguments are given to (+) ensuring that ((+) x y) is indeed just Num t => t and not Num t => t -> t.
Hence ((*) .: (+)) 2 3 5 is (*) ((+) 2 3) 5 which is (*) 5 5 which is 25, which I believe is what you want.
Note that f .: g can also be written as (f .) . g, and (.:) can also be defined as (.:) = (.) . (.). You can read more about it here:
What does (f .) . g mean in Haskell?
(*) and (+) both have the type signature Num a => a -> a -> a
Now, if you compose them, you get something funky.
(*) . (+) :: (Num (a -> a), Num a) => a -> (a -> a) -> a -> a
That's because (*) and (+) are expecting two 'arguments'.
(+) with one argument gets you a function. The . operator expects that function (the a -> a that you see).
Here's the meaning of (*) . (+)
x f y
(*) . (+) :: (Num (a -> a), Num a) => a -> (a -> a) -> a -> a
(*) . (+) maps x f y to ((x +) * f) y where f is a function from a to a that is ALSO a number.
The reason (*) expects a function is to make the types match while it expects two arguments, but that function has to be a number because (*) only works on numbers.
Really, this function makes no sense at all.
Some extensions first:
{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}
As the other answers show, your function is
weird :: (Num (a -> a), Num a) => a -> (a -> a) -> a -> a
weird x g = (x +) * g
But this function does have non-weird semantics.
There is a notion of difference lists. Accordingly, there is a notion of difference integers. I've seen them being used only in the dependently typed setting (e.g. here, but that's not the only case). The relevant part of the definition is
instance Enum DiffInt where
toEnum n = (n +)
fromEnum n = n 0
instance Num DiffInt where
n + m = n . m
n * m = foldr (+) id $ replicate (fromEnum n) m
This doesn't make much sense in Haskell, but can be useful with dependent types.
Now we can write
test :: DiffInt
test = toEnum 3 * toEnum 4
Or
test :: DiffInt
test = weird 3 (toEnum 4)
In both the cases fromEnum test == 12.
EDIT
It's possible to avoid the using of the TypeSynonymInstances extension:
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
weird :: (Num (a -> a), Num a) => a -> (a -> a) -> a -> a
weird x g = (x +) * g
instance (Enum a, Num a) => Enum (a -> a) where
toEnum n = (toEnum n +)
fromEnum n = fromEnum $ n (toEnum 0)
instance (Enum a, Num a) => Num (a -> a) where
n + m = n . m
n * m = foldr (+) id $ replicate (fromEnum n) m
type DiffInt = Int -> Int
As before we can write
test' :: DiffInt
test' = weird 3 (toEnum 4)
But now we can also write
-- difference ints over difference ints
type DiffDiffInt = DiffInt -> DiffInt
test'' :: DiffDiffInt
test'' = weird (toEnum 3) (toEnum (toEnum 4))
And
main = print $ fromEnum $ fromEnum test'
prints 12.
EDIT2 Better links added.
Let:
m = (*)
a = (+)
then
(m.a) x = (m (a x)) = m (a x)
Now m expects a Num a as a parameter, on the other hand (a x) , i.e. (x +) is a unary function (a -> a) by definition of (+). I guess what happened is that GHC tries to unite these two types so that, if you have a type that is both a number and a unary function, m can take a number and a unary function and return a unary function, since they are considered the same type.
As #Syd pointed, this unification wouldn't make sense for any normal number types such as integers and floating point numbers.
There are good answers here, but let me quickly point out a few steps where you went wrong.
First, the correct definition of function composition is
(f . g) x = f (g x)
you omitted the x on the LHS. Next, you should remember that in Haskell h x y is the same as (h x) y. So, contrary to what you expected,
((*) . (+)) 1 2 = (((*) . (+)) 1) 2 = ((*) ((+) 1)) 2 = ((+) 1) * 2,
and now you see why that fails. Also,
((*) . (+)) 1 (\x -> x + 1) 1
does not work, because the constraint Num (Int -> Int) is not satisfied.
I want to generalize this function to be (Integral a, Integral b, Bounded b) => a -> [b] but I don't know how to force maxBound to have the type of the result. Is this possible?
go :: Integral a => a -> Maybe (Word8, a)
go 0 = Nothing
go x
| x < 0 = error "Negative numbers are not acceptable"
| otherwise = Just $ (remainder, quotient)
where
quotient = fromInteger $ (toInteger x) `div` (toInteger (maxBound :: Word8))
remainder = fromInteger $ (toInteger x) `mod` (toInteger (maxBound :: Word8))
int2WordList :: Integral a => a -> [Word8]
int2WordList x = unfoldr go x
Basically, you want to use a type parameter at some point in your function. That's exactly what scoped type variables are for:
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Word
import Data.List
go :: forall a b. (Integral a, Integral b, Bounded b) => a -> Maybe (b, a)
go 0 = Nothing
go x
| x < 0 = error "Negative numbers are not acceptable"
| otherwise = Just $ (remainder, quotient)
where
quotient = fromInteger $ (toInteger x) `div` (toInteger (maxBound :: b))
remainder = fromInteger $ (toInteger x) `mod` (toInteger (maxBound :: b))
-- ^
-- that's the same `b` as above
int2List :: (Integral a, Integral b, Bounded b) => a -> [b]
int2List x = unfoldr go x
Alternatively you can use asTypeOf:
go :: (Integral a, Integral b, Bounded b) => a -> Maybe (b, a)
go 0 = Nothing
go x
| x < 0 = error "Negative numbers are not acceptable"
| otherwise = Just $ (remainder, quotient)
where
quotient = fromInteger $ (toInteger x) `div` (toInteger (maxBound `asTypeOf` remainder))
remainder = fromInteger $ (toInteger x) `mod` (toInteger (maxBound `asTypeOf` remainder))
int2List :: (Integral a, Integral b, Bounded b) => a -> [b]
int2List x = unfoldr go x
asTypeOf is a rather simple function, but its type makes sure that remainder and maxBound have the same type:
asTypeOf :: a -> a -> a
asTypeOf = const
The Haskell 98 solution to this problem is the asTypeOf function, e.g.:
quotient = fromInteger $ (toInteger x) `div` (toInteger (maxBound `asTypeOf` remainder))
I would suggest re-working your expressions a bit, though:
xInt = toInteger x
mbound = toInteger (maxBound `asTypeOf` remainder)
quotient = fromInteger $ xInt `div` mbound
remainder = fromInteger $ xInt `div` mbound
which will make it a bit clearer that you want to divide x by the same value but then round the result to two different types.
I recently learned a bit about F-algebras:
https://www.fpcomplete.com/user/bartosz/understanding-algebras.
I wanted to lift this functionality to more advanced types (indexed and higher-kinded).
Furthermore, I checked "Giving Haskell a Promotion" (http://research.microsoft.com/en-us/people/dimitris/fc-kind-poly.pdf), which was very helpful because it gave names to my own vague "inventions".
However, I cannot seem to create a unified approach that works for all shapes.
Algebras need some "carrier type", but the structure we're traversing expects a certain shape (itself, applied recursively), so I came up with a "Dummy" container that can carry any type, but is shaped as expected. I then use a type family to couple these.
This approach seems to work, leading to a fairly generic signature for my 'cata' function.
However, the other things I use (Mu, Algebra) still need separate versions for each shape, just for passing a bunch of type variables around. I was hoping something like PolyKinds could help (which I use successfully to shape the dummy type), but it seems it is only meant to work the other way around.
As IFunctor1 and IFunctor2 do not have extra variables, I tried to unify them by attaching (via type family) the index-preserving-function type, but this seems not allowed because of the existential quantification, so I'm left with multiple versions there too.
Is there any way to unify these 2 cases? Did I overlook some tricks, or is this just a limitation for now?
Are there other things that can be simplified?
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Cata where
-- 'Fix' for indexed types (1 index)
newtype Mu1 f a = Roll1 { unRoll1 :: f (Mu1 f) a }
deriving instance Show (f (Mu1 f) a) => Show (Mu1 f a)
-- 'Fix' for indexed types (2 index)
newtype Mu2 f a b = Roll2 { unRoll2 :: f (Mu2 f) a b }
deriving instance Show (f (Mu2 f) a b) => Show (Mu2 f a b)
-- index-preserving function (1 index)
type s :-> t = forall i. s i -> t i
-- index-preserving function (2 index)
type s :--> t = forall i j. s i j -> t i j
-- indexed functor (1 index)
class IFunctor1 f where
imap1 :: (s :-> t) -> (f s :-> f t)
-- indexed functor (2 index)
class IFunctor2 f where
imap2 :: (s :--> t) -> (f s :--> f t)
-- dummy container type to store a solid result type
-- the shape should follow an indexed type
type family Dummy (x :: i -> k) :: * -> k
type Algebra1 f a = forall t. f ((Dummy f) a) t -> (Dummy f) a t
type Algebra2 f a = forall s t. f ((Dummy f) a) s t -> (Dummy f) a s t
cata1 :: IFunctor1 f => Algebra1 f a -> Mu1 f t -> (Dummy f) a t
cata1 alg = alg . imap1 (cata1 alg) . unRoll1
cata2 :: IFunctor2 f => Algebra2 f a -> Mu2 f s t -> (Dummy f) a s t
cata2 alg = alg . imap2 (cata2 alg) . unRoll2
And 2 example structures to work with:
ExprF1 seems like a normal useful thing, attaching an embedded type to an object language.
ExprF2 is contrived (extra argument which happens to be lifted (DataKinds) as well), just to find out if the "generic" cata2 is able to handle these shapes.
-- our indexed type, which we want to use in an F-algebra (1 index)
data ExprF1 f t where
ConstI1 :: Int -> ExprF1 f Int
ConstB1 :: Bool -> ExprF1 f Bool
Add1 :: f Int -> f Int -> ExprF1 f Int
Mul1 :: f Int -> f Int -> ExprF1 f Int
If1 :: f Bool -> f t -> f t -> ExprF1 f t
deriving instance (Show (f t), Show (f Bool)) => Show (ExprF1 f t)
-- our indexed type, which we want to use in an F-algebra (2 index)
data ExprF2 f s t where
ConstI2 :: Int -> ExprF2 f Int True
ConstB2 :: Bool -> ExprF2 f Bool True
Add2 :: f Int True -> f Int True -> ExprF2 f Int True
Mul2 :: f Int True -> f Int True -> ExprF2 f Int True
If2 :: f Bool True -> f t True -> f t True -> ExprF2 f t True
deriving instance (Show (f s t), Show (f Bool t)) => Show (ExprF2 f s t)
-- mapper for f-algebra (1 index)
instance IFunctor1 ExprF1 where
imap1 _ (ConstI1 x) = ConstI1 x
imap1 _ (ConstB1 x) = ConstB1 x
imap1 eval (x `Add1` y) = eval x `Add1` eval y
imap1 eval (x `Mul1` y) = eval x `Mul1` eval y
imap1 eval (If1 p t e) = If1 (eval p) (eval t) (eval e)
-- mapper for f-algebra (2 index)
instance IFunctor2 ExprF2 where
imap2 _ (ConstI2 x) = ConstI2 x
imap2 _ (ConstB2 x) = ConstB2 x
imap2 eval (x `Add2` y) = eval x `Add2` eval y
imap2 eval (x `Mul2` y) = eval x `Mul2` eval y
imap2 eval (If2 p t e) = If2 (eval p) (eval t) (eval e)
-- turned into a nested expression
type Expr1 = Mu1 ExprF1
-- turned into a nested expression
type Expr2 = Mu2 ExprF2
-- dummy containers
newtype X1 x y = X1 x deriving Show
newtype X2 x y z = X2 x deriving Show
type instance Dummy ExprF1 = X1
type instance Dummy ExprF2 = X2
-- a simple example agebra that evaluates the expression
-- turning bools into 0/1
alg1 :: Algebra1 ExprF1 Int
alg1 (ConstI1 x) = X1 x
alg1 (ConstB1 False) = X1 0
alg1 (ConstB1 True) = X1 1
alg1 ((X1 x) `Add1` (X1 y)) = X1 $ x + y
alg1 ((X1 x) `Mul1` (X1 y)) = X1 $ x * y
alg1 (If1 (X1 0) _ (X1 e)) = X1 e
alg1 (If1 _ (X1 t) _) = X1 t
alg2 :: Algebra2 ExprF2 Int
alg2 (ConstI2 x) = X2 x
alg2 (ConstB2 False) = X2 0
alg2 (ConstB2 True) = X2 1
alg2 ((X2 x) `Add2` (X2 y)) = X2 $ x + y
alg2 ((X2 x) `Mul2` (X2 y)) = X2 $ x * y
alg2 (If2 (X2 0) _ (X2 e)) = X2 e
alg2 (If2 _ (X2 t) _) = X2 t
-- simple helpers for construction
ci1 :: Int -> Expr1 Int
ci1 = Roll1 . ConstI1
cb1 :: Bool -> Expr1 Bool
cb1 = Roll1 . ConstB1
if1 :: Expr1 Bool -> Expr1 a -> Expr1 a -> Expr1 a
if1 p t e = Roll1 $ If1 p t e
add1 :: Expr1 Int -> Expr1 Int -> Expr1 Int
add1 x y = Roll1 $ Add1 x y
mul1 :: Expr1 Int -> Expr1 Int -> Expr1 Int
mul1 x y = Roll1 $ Mul1 x y
ci2 :: Int -> Expr2 Int True
ci2 = Roll2 . ConstI2
cb2 :: Bool -> Expr2 Bool True
cb2 = Roll2 . ConstB2
if2 :: Expr2 Bool True -> Expr2 a True-> Expr2 a True -> Expr2 a True
if2 p t e = Roll2 $ If2 p t e
add2 :: Expr2 Int True -> Expr2 Int True -> Expr2 Int True
add2 x y = Roll2 $ Add2 x y
mul2 :: Expr2 Int True -> Expr2 Int True -> Expr2 Int True
mul2 x y = Roll2 $ Mul2 x y
-- test case
test1 :: Expr1 Int
test1 = if1 (cb1 True)
(ci1 3 `mul1` ci1 4 `add1` ci1 5)
(ci1 2)
test2 :: Expr2 Int True
test2 = if2 (cb2 True)
(ci2 3 `mul2` ci2 4 `add2` ci2 5)
(ci2 2)
main :: IO ()
main = let (X1 x1) = cata1 alg1 test1
(X2 x2) = cata2 alg2 test2
in do print x1
print x2
Output:
17
17
I wrote a talk on this topic called "Slicing It" in 2009. It certainly points to the work by my Strathclyde colleagues, Johann and Ghani, on initial algebra semantics for GADTs. I used the notation which SHE provides for writing data-indexed types, but that has pleasingly been superseded by the "promotion" story.
The key point of the talk is, as per my comment, to be systematic about using exactly one index, but to exploit the fact that its kind can vary.
So indeed, we have (using my current preferred "Goscinny and Uderzo" names)
type s :-> t = forall i. s i -> t i
class FunctorIx f where
mapIx :: (s :-> t) -> (f s :-> f t)
Now you can show FunctorIx is closed under fixpoints. The key is to combine two indexed sets into a one that offers a choice of index.
data Case (f :: i -> *) (g :: j -> *) (b :: Either i j) :: * where
L :: f i -> Case f g (Left i)
R :: g j -> Case f g (Right j)
(<?>) :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g'
(f <?> g) (L x) = L (f x)
(f <?> g) (R x) = R (g x)
Now we can now take fixpoints of functors whose "contained elements" stand for either "payload" or "recursive substructures".
data MuIx (f :: (Either i j -> *) -> j -> *) :: (i -> *) -> j -> * where
InIx :: f (Case x (MuIx f x)) j -> MuIx f x j
As a result, we can mapIx over "payload"...
instance FunctorIx f => FunctorIx (MuIx f) where
mapIx f (InIx xs) = InIx (mapIx (f <?> mapIx f) xs)
...or write a catamorphism over the "recursive substructures"...
foldIx :: FunctorIx f => (f (Case x t) :-> t) -> MuIx f x :-> t
foldIx f (InIx xs) = f (mapIx (id <?> foldIx f) xs)
...or both at once.
mapFoldIx :: FunctorIx f => (x :-> y) -> (f (Case y t) :-> t) -> MuIx f x :-> t
mapFoldIx e f (InIx xs) = f (mapIx (e <?> mapFoldIx e f) xs)
The joy of FunctorIx is that it has such splendid closure properties, thanks to the ability to vary the indexing kinds. MuIx allows for notions of payload, and can be iterated. There is thus an incentive to work with structured indices rather than multiple indices.
If I understand it properly, this is precisely the problem tackled by Johann and Ghani's "Initial Algebra Semantics is Enough!"
https://personal.cis.strath.ac.uk/neil.ghani/papers/ghani-tlca07.pdf
See in particular their hfold
Edit: For the GADT case, see their later paper "Foundations for Structured Programming using GADTs". Note that they encounter an obstacle that can be resolved using PolyKinds, which we now have: http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.111.2948
This blog post may also be of interest: http://www.timphilipwilliams.com/posts/2013-01-16-fixing-gadts.html