From 3b6276233970210dce8d7c12d72ba5d55644e051 Mon Sep 17 00:00:00 2001 From: Adam Megacz Date: Wed, 4 May 2011 21:18:01 -0700 Subject: [PATCH] add experimental GArrowKappa --- GHC/HetMet/GArrow.hs | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) 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 -- 1.7.10.4