X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FHetMet%2FGArrow.hs;h=3b64d90bcab005482a67f8a8a19b6ccc3e92ecf3;hb=1e8fee55a5b5ce6770ccf46faa79cec2fabe5091;hp=950652870d964ae5adb7d33496cf6a2226aa1e65;hpb=6a14b6d26bfcce9a1838d3eb302468f08ec4348b;p=ghc-base.git

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index 9506528..3b64d90 100644
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -21,14 +21,19 @@ module GHC.HetMet.GArrow (
   GArrowConstant(..),
   GArrowLiteral(..),   -- should be implemented, but never invoked, by user code
 
-  GArrowSum(..),
+  GArrowSum(..),  ga_inl, ga_inr,
   GArrowProd(..),
 
   GArrowReify(..),
   GArrowReflect(..),
 
   GArrowCurry(..),
-  GArrowApply(..)
+  GArrowApply(..),
+
+  GArrowSTKC(..),
+  GArrowSTLC(..),
+  GArrowPCF(..)
+
 ) where
 import Control.Category
 
@@ -82,13 +87,12 @@ class (GArrow     g (**)  u,
 
 class (GArrow     g (**)  u,
        GArrow     g (<+>) v) => 
-       GArrowSum  g (**)  u v (<+>) where
+       GArrowSum  g (**)  u (<+>) v where
   ga_merge :: g (x<+>x) x
   ga_never :: g v       x
-      
-
-
 
+ga_inl = ga_uncancelr >>> ga_second ga_never
+ga_inr = ga_uncancell >>> ga_first  ga_never
 
 ------------------------------------------------------------------------
 -- Loop
@@ -146,3 +150,39 @@ class GArrow g (**) u => GArrowApply g (**) u (~>) where
 class GArrow g (**) u => GArrowCurry g (**) u (~>) where
   ga_curryl    :: g (x**y) z  ->  g x (y~>z)
   ga_curryr    :: g (x**y) z  ->  g y (x~>z)
+
+
+
+
+------------------------------------------------------------------------
+-- 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 (**) u,
+       GArrowCopy  g (**) u,
+       GArrowSwap  g (**) u) =>
+       GArrowSTKC  g (**) u
+
+-- The simply typed LAMBDA calculus
+class (GArrowSTKC  g (**) u,
+       GArrowCurry g (**) u (~>),
+       GArrowApply g (**) u (~>)) =>
+       GArrowSTLC  g (**) u (~>)
+
+-- Programming Language for Computable Functions (w/o integers and booleans)
+class (GArrowSTLC  g (**) u (~>),
+       GArrowLoop  g (**) u) =>
+       GArrowPCF   g (**) u (~>)
+
+
+
+
+
+
+
+
+