add Arrow=>GArrowProd instance

diff --git a/GHC/HetMet/Arrow.hs b/GHC/HetMet/Arrow.hs
index 08b75b3..b79943a 100644 (file)
--- a/GHC/HetMet/Arrow.hs
+++ b/GHC/HetMet/Arrow.hs
@@ -55,6 +55,10 @@ 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))
+
 -- The uninhabited type
 data Void
 

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index 9f8aab1..9506528 100644 (file)
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -75,10 +75,10 @@ ga_swap_second f =
 
 
 class (GArrow     g (**)  u,
-       GArrow     g (<*>) u) =>
-       GArrowProd g (**)  u (<*>) where
+       GArrow     g (<*>) v) =>
+       GArrowProd g (**)  u (<*>) v where
   ga_prod_copy :: g x (x<*>x)
-  ga_prod_drop :: g x  u
+  ga_prod_drop :: g x  v
 
 class (GArrow     g (**)  u,
        GArrow     g (<+>) v) =>