[Haskell-cafe] Type family fun
Ryan Ingram
ryani.spam at gmail.com
Sun Aug 24 05:14:23 EDT 2008
On Sun, Aug 24, 2008 at 1:44 AM, Stefan Holdermans <stefan at cs.uu.nl> wrote:
] Your calls to empty are just ambiguous.
Now, you are probably wondering how to fix it. Here's two different solutions:
> {-# LANGUAGE TypeFamilies, TypeOperators, ScopedTypeVariables #-}
> module Ix where
The first solution still uses type families, but "empty" takes a
parameter so that the which instance to use can be chosen
unambiguously.
> class Ix i where
> type IxMap i :: * -> *
> empty :: i -> IxMap i [Int]
> -- uses ScopedTypeVariables
> instance (Ix left, Ix right) => Ix (left :|: right) where
> type IxMap (left :|: right) = BiApp (IxMap left) (IxMap right)
> empty _ = BiApp (empty (undefined :: left)) (empty (undefined :: right))
The second solution uses data families instead, because no such
ambiguity can exist.
> class IxD i where
> data IxMapD i :: * -> *
> emptyD :: IxMapD i [Int]
> instance (IxD left, IxD right) => IxD (left :|: right) where
> data IxMapD (left :|: right) a = BiAppD (IxMapD left a) (IxMapD right a)
> emptyD = BiAppD emptyD emptyD
-- ryan
> data (:|:) a b = Inl a | Inr b
> data BiApp a b c = BiApp (a c) (b c)
More information about the Haskell-Cafe
mailing list