From 26167ff9bda21116409c377fac0f9a8d477a7479 Mon Sep 17 00:00:00 2001 From: Adam Megacz Date: Tue, 21 Jun 2011 22:19:29 -0700 Subject: [PATCH] GArrowFullyEnriched: avoid need for UndecidableInstances --- GHC/HetMet/GArrowFullyEnriched.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/GHC/HetMet/GArrowFullyEnriched.hs b/GHC/HetMet/GArrowFullyEnriched.hs index 66b1ab7..113dfcd 100644 --- a/GHC/HetMet/GArrowFullyEnriched.hs +++ b/GHC/HetMet/GArrowFullyEnriched.hs @@ -1,5 +1,5 @@ {-# OPTIONS -fwarn-incomplete-patterns #-} -{-# LANGUAGE RankNTypes, FlexibleInstances, TypeFamilies, MultiParamTypeClasses, GADTs, DatatypeContexts, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE RankNTypes, FlexibleInstances, TypeFamilies, MultiParamTypeClasses, GADTs, DatatypeContexts, TypeOperators #-} ----------------------------------------------------------------------------- -- -- | The instance witnessing the fact that (forall g . GArrow g => g a b) is fully enriched in Hask. @@ -61,13 +61,13 @@ import Control.Category import GHC.HetMet.GArrow import Prelude hiding ((.), id) -data GArrow g (**) u => Polynomial g (**) u t x y +data (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => Polynomial g (**) u t x y = L (g (t**x) y) -- uses t, wants it as the left arg | R (g (x**t) y) -- uses t, wants it as the right arg | B (g (t**x) y) (g (x**t) y) -- uses t, doesn't care which arg | N (g x y) -- doesn't use t -instance (GArrowCopy g (**) u, GArrowSwap g (**) u) => Category (Polynomial g (**) u t) where +instance (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => Category (Polynomial g (**) u t) where id = N id (N g) . (N f) = N $ g . f (N g) . (L f) = L $ g . f @@ -87,7 +87,7 @@ instance (GArrowCopy g (**) u, GArrowSwap g (**) u) => Category (Polynomial g (* (B g g') . (B f f') = B (ga_first ga_copy >>> ga_assoc >>> ga_second f >>> g) (ga_second ga_copy >>> ga_unassoc >>> ga_first f' >>> g') -instance (GArrowCopy g (**) u, GArrowSwap g (**) u) => GArrow (Polynomial g (**) u t) (**) u where +instance (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => GArrow (Polynomial g (**) u t) (**) u where ga_first (N f) = N $ ga_first f ga_first (L f) = L $ ga_unassoc >>> ga_first f ga_first (R f) = B (ga_unassoc >>> ga_first (ga_swap >>> f)) @@ -122,9 +122,9 @@ instance (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => GAr -- a self-contained instance-polymorphic term @(g (a**b) c)@. The "trick" is that we supply -- the instance-polymorphic Haskell function with a modified dictionary (type class instance) -- -homfunctor_inv :: forall a b c u . - (forall g (**) . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g u a -> g b c) -> - (forall g (**) . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g (a**b) c) +homfunctor_inv :: forall a b c. + (forall g (**) u . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g u a -> g b c) -> + (forall g (**) u . (GArrowSwap g (**) u, GArrowCopy g (**) u, GArrowDrop g (**) u) => g (a**b) c) homfunctor_inv f = case f (B ga_cancelr ga_cancell) of (N f') -> ga_first ga_drop >>> ga_cancell >>> f' -- 1.7.10.4