From 6a14b6d26bfcce9a1838d3eb302468f08ec4348b Mon Sep 17 00:00:00 2001 From: Adam Megacz Date: Fri, 8 Apr 2011 04:10:35 +0000 Subject: [PATCH] add Arrow=>GArrowProd instance --- GHC/HetMet/Arrow.hs | 4 ++++ GHC/HetMet/GArrow.hs | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/GHC/HetMet/Arrow.hs b/GHC/HetMet/Arrow.hs index 08b75b3..b79943a 100644 --- 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 --- 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) => -- 1.7.10.4