make Control.Category a superclass of GArrow

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index 2f7f5f9..9853637 100644 (file)
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFlexibleInstances #-}
+{-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFlexibleInstances -XFunctionalDependencies #-}

 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.HetMet.GArrow
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.HetMet.GArrow

@@ -21,9 +21,7 @@ module GHC.HetMet.GArrow (
 import Control.Arrow
 import Control.Category
 
 import Control.Arrow
 import Control.Category
 

-class GArrow g (**) where
-  ga_id        :: g x x
-  ga_comp      :: g x y -> g y z -> g x z
+class Category g => GArrow g (**) | g -> (**) where

   ga_first     :: g x y -> g (x ** z) (y ** z)
   ga_second    :: g x y -> g (z ** x) (z ** y)
   ga_cancell   :: g (()**x) x
   ga_first     :: g x y -> g (x ** z) (y ** z)
   ga_second    :: g x y -> g (z ** x) (z ** y)
   ga_cancell   :: g (()**x) x

@@ -43,7 +41,7 @@ class GArrow g (**) => GArrowSwap g (**) where
   ga_swap          :: g (x**y) (y**x)
 
 -- implementation of ga_second for GArrowSwap instances
   ga_swap          :: g (x**y) (y**x)
 
 -- implementation of ga_second for GArrowSwap instances

-ga_swap_second f = ga_comp (ga_comp ga_swap (ga_first f)) ga_swap
+ga_swap_second f = ga_swap >>> ga_first f >>> ga_swap

 
 class GArrow g (**) => GArrowLoop g (**) where
   ga_loop      :: g (x**z) (y**z) -> g x y
 
 class GArrow g (**) => GArrowLoop g (**) where
   ga_loop      :: g (x**z) (y**z) -> g x y

@@ -65,8 +63,6 @@ class GArrow g (**) => GArrowReflect g (**) where
 -- GArrow instances for Control.Arrow
 
 instance Arrow a => GArrow a (,) where
 -- GArrow instances for Control.Arrow
 
 instance Arrow a => GArrow a (,) where

-  ga_id        =  arr Prelude.id
-  ga_comp      =  (>>>)

   ga_first     =  first
   ga_second    =  second
   ga_cancell   =  arr (\((),x) -> x)
   ga_first     =  first
   ga_second    =  second
   ga_cancell   =  arr (\((),x) -> x)

@@ -85,7 +81,7 @@ instance Arrow a => GArrowCopy a (,) where
 instance Arrow a => GArrowSwap a (,) where
   ga_swap      =  arr (\(x,y) -> (y,x))
 
 instance Arrow a => GArrowSwap a (,) where
   ga_swap      =  arr (\(x,y) -> (y,x))
 

-instance Arrow a => GArrowLiteral a (,) where
+instance Arrow a => GArrowLiteral a (,) b where

   ga_literal x =  arr (\() -> x)
 
 instance Arrow a => GArrowReify a (,) where
   ga_literal x =  arr (\() -> x)
 
 instance Arrow a => GArrowReify a (,) where

@@ -97,12 +93,3 @@ instance ArrowLoop a => GArrowLoop a (,) where
 
 
 
 
 
 

-------------------------------------------------------------------------------
--- Category instance for GArrow
-
-instance GArrow g => Category g where
-  id   = ga_id
-  x .y = ga_comp y x
-
-
-