rephrase GArrow{Sum,Prod} to make instance inference easier

diff --git a/GHC/HetMet/Arrow.hs b/GHC/HetMet/Arrow.hs
index 2de4c42..cb20a6a 100644 (file)
--- a/GHC/HetMet/Arrow.hs
+++ b/GHC/HetMet/Arrow.hs
@@ -55,9 +55,7 @@ instance ArrowApply a => GArrowApply a (,) () a where
   ga_applyl    = ga_swap >>> app
   ga_applyr    = app
 
-instance Arrow a => GArrowProd a (,) () (,) () where
-  ga_prod_drop  = arr (\x -> ())
-  ga_prod_copy  = arr (\x -> (x,x))
+instance Arrow a => GArrowProd a (,) () where
 
 -- The uninhabited type
 data Void
@@ -90,7 +88,7 @@ instance ArrowChoice a => GArrow a Either Void where
                     eitherUnAssoc (Right (Left  y)) = Left  (Right y)
                     eitherUnAssoc (Right (Right z)) = Right        z
 
-instance ArrowChoice a => GArrowSum a (,) () Either Void where
+instance ArrowChoice a => GArrowSum a Either Void where
   ga_never = arr voidImpossible
   ga_merge = arr merge
               where

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index e981d9b..c340fe2 100644 (file)
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -79,35 +79,19 @@ ga_swap_second f =
 -- Products, Coproducts, etc
 
 
-class (GArrow     g (**)  u,
-       GArrow     g (<*>) v) =>
-       GArrowProd g (**)  u (<*>) v
-
-       -- fundep: in any given context, (<*>) may serve as the 
-       -- product for at most one GArrow
-       | (**) -> (<*>),
-         (<*>) -> v, v -> (<*>) where
-  ga_prod_copy :: g x (x<*>x)
-  ga_prod_drop :: g x  v
-
-class (GArrow     g (**)  u,
-       GArrow     g (<+>) v) => 
-       GArrowSum  g (**)  u (<+>) v
-
-       -- fundep: in any given context, (<+>) may serve as the 
-       -- coproduct for at most one GArrow
-       | (<+>) -> (**),
-         (<+>) -> v, v -> (<+>) where
+class (GArrowDrop g (<*>) u,
+       GArrowCopy g (<*>) u) =>
+       GArrowProd g (<*>) u
+
+class GArrow     g (<+>) u =>
+      GArrowSum  g (<+>) u where
   ga_merge :: g (x<+>x) x
-  ga_never :: g v       x
+  ga_never :: g u       x
 
--- Note to self: do not remove this type declaration; it ensures that if
--- I fiddle with the GArrowSum fundeps and get them wrong (i.e. insufficient)
--- I'll find out about it when compiling the base library.
-ga_inl :: GArrowSum g (**) u (<+>) v => g x (x<+>y)
+ga_inl :: GArrowSum g (<+>) u => g x (x<+>y)
 ga_inl = ga_uncancelr >>> ga_second ga_never
 
-ga_inr :: GArrowSum g (**) u (<+>) v => g x (y<+>x)
+ga_inr :: GArrowSum g (<+>) u => g x (y<+>x)
 ga_inr = ga_uncancell >>> ga_first  ga_never