rename classes to create GArrowCopyDropSwap[Loop]

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

diff --git a/GHC/HetMet/Private.hs b/GHC/HetMet/Private.hs
index aee3ad6..3d204f8 100644 (file)
--- a/GHC/HetMet/Private.hs
+++ b/GHC/HetMet/Private.hs
@@ -10,7 +10,7 @@
 -- Portability :  portable
 
 module GHC.HetMet.Private (
-  PGArrow,
+  PGArrow (..),
   pga_id,
   pga_comp,
   pga_first,
@@ -27,7 +27,10 @@ module GHC.HetMet.Private (
   pga_applyl,
   pga_applyr,
   pga_curryl,
-  pga_curryr
+  pga_curryr,
+  pga_loopl,
+  pga_loopr,
+  pga_kappa
 ) where
 import Control.Category ( (>>>) )
 import qualified Control.Category
@@ -36,39 +39,45 @@ import GHC.HetMet.GArrow
 -------------------------------------------------------------------------
 -- Used internally by the compiler, subject to change without notice!!
 
-newtype PGArrow x y = PGArrow { unG :: forall g. GArrowSTKC g (,) () => g x y }
+newtype PGArrow g x y = PGArrowD { unG :: GArrowCopyDropSwapLoop g => g x y }
 
-pga_id        :: PGArrow x x
-pga_id        =  PGArrow { unG = Control.Category.id }
-pga_comp      :: forall x y z. PGArrow x y -> PGArrow y z -> PGArrow x z
-pga_comp f g  =  PGArrow { unG = unG f >>> unG g }
-pga_first     :: PGArrow x y -> PGArrow (x , z) (y , z)
-pga_first f   =  PGArrow { unG = ga_first $ unG f }
-pga_second    :: PGArrow x y -> PGArrow (z , x) (z , y)
-pga_second f  =  PGArrow { unG = ga_second $ unG f }
-pga_cancell   :: PGArrow ((),x)         x
-pga_cancell   =  PGArrow { unG = ga_cancell }
-pga_cancelr   :: PGArrow    (x,())      x
-pga_cancelr   =  PGArrow { unG = ga_cancelr }
-pga_uncancell :: PGArrow     x      ((),x)
-pga_uncancell =  PGArrow { unG = ga_uncancell }
-pga_uncancelr :: PGArrow     x         (x,())
-pga_uncancelr =  PGArrow { unG = ga_uncancelr }
-pga_assoc     :: PGArrow ((x, y),z ) ( x,(y ,z))
-pga_assoc     =  PGArrow { unG = ga_assoc }
-pga_unassoc   :: PGArrow ( x,(y ,z)) ((x, y),z )
-pga_unassoc   =  PGArrow { unG = ga_unassoc }
-pga_copy      :: PGArrow x (x,x)
-pga_copy      =  PGArrow { unG = ga_copy }
-pga_drop      :: PGArrow x ()
-pga_drop      =  PGArrow { unG = ga_drop }
-pga_swap      :: PGArrow (x,y) (y,x)
-pga_swap      =  PGArrow { unG = ga_swap }
-pga_applyl    :: PGArrow (x,(x->y)   ) y
+pga_id        :: forall g x. PGArrow g x x
+pga_id        =  PGArrowD { unG = Control.Category.id }
+pga_comp      :: forall g x y z. PGArrow g x y -> PGArrow g y z -> PGArrow g x z
+pga_comp f g  =  PGArrowD { unG = unG f >>> unG g }
+pga_first     :: forall g x y z . PGArrow g x y -> PGArrow g (GArrowTensor g x z) (GArrowTensor g y z)
+pga_first f   =  PGArrowD { unG = ga_first $ unG f }
+pga_second    :: forall g x y z . PGArrow g x y -> PGArrow g (GArrowTensor g z x) (GArrowTensor g z y)
+pga_second f  =  PGArrowD { unG = ga_second $ unG f }
+pga_cancell   :: forall g x . PGArrow g (GArrowTensor g (GArrowUnit g) x)         x
+pga_cancell   =  PGArrowD { unG = ga_cancell }
+pga_cancelr   :: forall g x . PGArrow g    (GArrowTensor g x (GArrowUnit g))      x
+pga_cancelr   =  PGArrowD { unG = ga_cancelr }
+pga_uncancell :: forall g x . PGArrow g     x      (GArrowTensor g (GArrowUnit g) x)
+pga_uncancell =  PGArrowD { unG = ga_uncancell }
+pga_uncancelr :: forall g x . PGArrow g     x         (GArrowTensor g x (GArrowUnit g))
+pga_uncancelr =  PGArrowD { unG = ga_uncancelr }
+pga_assoc     :: forall g x y z . PGArrow g (GArrowTensor g (GArrowTensor g x y) z) (GArrowTensor g x (GArrowTensor g y z))
+pga_assoc     =  PGArrowD { unG = ga_assoc }
+pga_unassoc   :: forall g x y z . PGArrow g (GArrowTensor g x (GArrowTensor g y z)) (GArrowTensor g (GArrowTensor g x y) z)
+pga_unassoc   =  PGArrowD { unG = ga_unassoc }
+pga_copy      :: forall g x . PGArrow g x (GArrowTensor g x x)
+pga_copy      =  PGArrowD { unG = ga_copy }
+pga_drop      :: forall g x . PGArrow g x (GArrowUnit g)
+pga_drop      =  PGArrowD { unG = ga_drop }
+pga_swap      :: forall g x y . PGArrow g (GArrowTensor g x y) (GArrowTensor g y x)
+pga_swap      =  PGArrowD { unG = ga_swap }
+pga_applyl    :: forall g x y . PGArrow g (GArrowTensor g x (GArrowExponent g x y)   ) y
 pga_applyl    =  error "not implemented"
-pga_applyr    :: PGArrow (   (x->y),x) y
+pga_applyr    :: forall g x y . PGArrow g (GArrowTensor g (GArrowExponent g x y) x) y
 pga_applyr    =  error "not implemented"
-pga_curryl    :: PGArrow (x,y) z  ->  PGArrow x (y->z)
+pga_curryl    :: forall g x y z . PGArrow g (GArrowTensor g x y) z  ->  PGArrow g x (GArrowExponent g y z)
 pga_curryl    =  error "not implemented"
-pga_curryr    :: PGArrow (x,y) z  ->  PGArrow y (x->z)
+pga_curryr    :: forall g x y z . PGArrow g (GArrowTensor g x y) z  ->  PGArrow g y (GArrowExponent g x z)
 pga_curryr    =  error "not implemented"
+pga_kappa     :: forall g x y . (g (GArrowUnit g) x -> g (GArrowUnit g) y) -> g x y
+pga_kappa     =  error "not implemented"
+pga_loopr     :: forall g x y z . PGArrow g (GArrowTensor g x z) (GArrowTensor g y z) -> PGArrow g x y
+pga_loopr f   =  PGArrowD { unG = ga_loopr $ unG f }
+pga_loopl     :: forall g x y z . PGArrow g (GArrowTensor g z x) (GArrowTensor g z y) -> PGArrow g x y
+pga_loopl f   =  PGArrowD { unG = ga_loopl $ unG f }