rename classes to create GArrowCopyDropSwap[Loop]

[ghc-base.git] / GHC / HetMet / GArrow.hs

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index 0ba6e3f..c009f43 100644 (file)
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFunctionalDependencies -XTypeFamilies -XFlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, TypeOperators, FunctionalDependencies, TypeFamilies, FlexibleContexts #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.HetMet.GArrow
@@ -34,8 +34,8 @@ module GHC.HetMet.GArrow (
   GArrowUnit,
   GArrowExponent,
 
-  GArrowKappa(..),
-  GArrowSTKC(..),
+  GArrowCopyDropSwap(..),
+  GArrowCopyDropSwapLoop(..),
   GArrowSTLC(..),
   GArrowPCF(..)
 
@@ -46,7 +46,7 @@ import Prelude          hiding (id)
 ------------------------------------------------------------------------
 -- The main GArrow class
 
-class Category g => GArrow g (**) u | (**) -> u, u -> (**) where
+class Category g => GArrow g (**) u | g (**) -> u, g u -> (**) where
 --id           :: g x x
 --comp         :: g x y -> g y z -> g x z
   ga_first     :: g x y -> g (x ** z) (y ** z)
@@ -107,8 +107,8 @@ ga_inr = ga_uncancell >>> ga_first  ga_never
 -- Loop
 
 class GArrow g (**) u => GArrowLoop g (**) u where
-  ga_loopl    :: g (x**z) (y**z) -> g x y
-  ga_loopr    :: g (z**x) (z**y) -> g x y
+  ga_loopr    :: g (x**z) (y**z) -> g x y
+  ga_loopl    :: g (z**x) (z**y) -> g x y
 
 
 ------------------------------------------------------------------------
@@ -134,6 +134,8 @@ class GArrow g (**) u => GArrowConstant g (**) u t r where
 
 
 
+
+
 ------------------------------------------------------------------------
 -- Reify and Reflect, which are "curried" versions of eval/const
 
@@ -149,18 +151,6 @@ class GArrow g (**) u => GArrowReflect g (**) u r q x y where
 
 
 
-------------------------------------------------------------------------
--- The Kappa adjunction
---
--- See Hasegawa, Decomposing Typed Lambda Calculus into a Couple of
--- Categorical Programming Languages) section 3, rule $(\times L)$
-
-class GArrow g (**) u => GArrowKappa g (**) u where
-  ga_kappa :: (g u x -> g u y) -> g x y
-
-
-
-
 
 ------------------------------------------------------------------------
 -- Apply and Curry
@@ -189,7 +179,7 @@ class GArrow g (**) u => GArrowCurry g (**) u (~>) where
 -- However, in daily practice it's a pain to have all those extra type
 -- variables floating around.  If you'd like to hide them, you can use
 -- the type families below to do so; see the definition of class
--- GArrowSTKC for an example.  Keep in mind, however, that any given
+-- GArrowCopyDropSwap for an example.  Keep in mind, however, that any given
 -- type may only have a single instance declared using the type
 -- families.
 --
@@ -204,16 +194,16 @@ type family GArrowExponent g :: * -> * -> *   -- (~>)
 ------------------------------------------------------------------------
 -- Commonly Implemented Collections of Classes
 
---
--- The simply typed KAPPA calculus; see Hasegawa, __Decomposing Typed
--- Lambda Calculus into a Couple of Categorical Programming
--- Languages__, http://dx.doi.org/10.1007/3-540-60164-3_28
--- 
-
 class (GArrowDrop  g (GArrowTensor g) (GArrowUnit g),
        GArrowCopy  g (GArrowTensor g) (GArrowUnit g),
        GArrowSwap  g (GArrowTensor g) (GArrowUnit g)) =>
-       GArrowSTKC  g
+       GArrowCopyDropSwap  g
+
+class (GArrowDrop  g (GArrowTensor g) (GArrowUnit g),
+       GArrowCopy  g (GArrowTensor g) (GArrowUnit g),
+       GArrowSwap  g (GArrowTensor g) (GArrowUnit g),
+       GArrowLoop  g (GArrowTensor g) (GArrowUnit g)) =>
+       GArrowCopyDropSwapLoop  g
 
 -- The simply typed LAMBDA calculus
 class (GArrowDrop  g (GArrowTensor g) (GArrowUnit g),