add GArrowSTKCL for flattening of fixpoints

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

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index 0ba6e3f..8b88b9b 100644 (file)
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -36,6 +36,7 @@ module GHC.HetMet.GArrow (
 
   GArrowKappa(..),
   GArrowSTKC(..),
+  GArrowSTKCL(..),
   GArrowSTLC(..),
   GArrowPCF(..)
 
@@ -107,8 +108,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
 
 
 ------------------------------------------------------------------------
@@ -215,6 +216,12 @@ class (GArrowDrop  g (GArrowTensor g) (GArrowUnit g),
        GArrowSwap  g (GArrowTensor g) (GArrowUnit g)) =>
        GArrowSTKC  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)) =>
+       GArrowSTKCL  g
+
 -- The simply typed LAMBDA calculus
 class (GArrowDrop  g (GArrowTensor g) (GArrowUnit g),
        GArrowCopy  g (GArrowTensor g) (GArrowUnit g),