From: Adam Megacz <megacz@cs.berkeley.edu>
Date: Thu, 5 May 2011 04:18:01 +0000 (-0700)
Subject: add experimental GArrowKappa
X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=3b6276233970210dce8d7c12d72ba5d55644e051

add experimental GArrowKappa
---

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index 0c32468..b9bfccf 100644
--- a/GHC/HetMet/GArrow.hs
+++ b/GHC/HetMet/GArrow.hs
@@ -30,12 +30,14 @@ module GHC.HetMet.GArrow (
   GArrowCurry(..),
   GArrowApply(..),
 
+  GArrowKappa(..),
   GArrowSTKC(..),
   GArrowSTLC(..),
   GArrowPCF(..)
 
 ) where
-import Control.Category
+import Control.Category hiding ((.))
+import Prelude          hiding (id)
 
 ------------------------------------------------------------------------
 -- The main GArrow class
@@ -127,7 +129,7 @@ class GArrow g (**) u => GArrowConstant g (**) u t r where
 
 
 ------------------------------------------------------------------------
--- Reify and Reflect, which are "curried" versions
+-- Reify and Reflect, which are "curried" versions of eval/const
 
 -- If you have this for R the identity map on types, you're basically
 -- a Control.Arrow; you can also define essentially all the other
@@ -142,6 +144,19 @@ 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
 
 class GArrow g (**) u => GArrowApply g (**) u (~>) where