add GArrowSTKCL for flattening of fixpoints

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

diff --git a/GHC/HetMet/Private.hs b/GHC/HetMet/Private.hs
index 9308087..59bddbf 100644 (file)
--- a/GHC/HetMet/Private.hs
+++ b/GHC/HetMet/Private.hs
@@ -28,6 +28,8 @@ module GHC.HetMet.Private (
   pga_applyr,
   pga_curryl,
   pga_curryr,
+  pga_loopl,
+  pga_loopr,
   pga_kappa
 ) where
 import Control.Category ( (>>>) )
@@ -37,7 +39,7 @@ import GHC.HetMet.GArrow
 -------------------------------------------------------------------------
 -- Used internally by the compiler, subject to change without notice!!
 
-newtype PGArrow g x y = PGArrowD { unG :: GArrowSTKC g => g x y }
+newtype PGArrow g x y = PGArrowD { unG :: GArrowSTKCL g => g x y }
 
 pga_id        :: forall g x. PGArrow g x x
 pga_id        =  PGArrowD { unG = Control.Category.id }
@@ -75,3 +77,7 @@ pga_curryr    :: forall g x y z . PGArrow g (GArrowTensor g x y) z  ->  PGArrow
 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 }