X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FHetMet%2FArrow.hs;h=f40ed5b7eeab412d104b314f8174e6b8597f656d;hb=7406d7e6d3e42c96a67fb233e7dc1847b9c64418;hp=2de4c42ac5590d273e5ff5312d80026f0035b883;hpb=3a7e8de77666fab3f6d2a7fc5c813cbca77ad57d;p=ghc-base.git diff --git a/GHC/HetMet/Arrow.hs b/GHC/HetMet/Arrow.hs index 2de4c42..f40ed5b 100644 --- a/GHC/HetMet/Arrow.hs +++ b/GHC/HetMet/Arrow.hs @@ -48,16 +48,14 @@ instance Arrow a => GArrowReify a (,) () x y x y where ga_reify = arr instance ArrowLoop a => GArrowLoop a (,) () where - ga_loopl = loop - ga_loopr f = loop (ga_swap >>> f >>> ga_swap) + ga_loopr = loop + ga_loopl f = loop (ga_swap >>> f >>> ga_swap) 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