From a223a71a0d40523d2fb3a6b84b5da37d9fc719b8 Mon Sep 17 00:00:00 2001 From: Adam Megacz Date: Sat, 19 Mar 2011 12:32:13 -0700 Subject: [PATCH] add GArrow instance for Control.Arrow --- GHC/HetMet/GArrow.hs | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs index da6a9c2..93d2886 100644 --- a/GHC/HetMet/GArrow.hs +++ b/GHC/HetMet/GArrow.hs @@ -60,3 +60,37 @@ class GArrow g (**) => GArrowReflect g (**) where +------------------------------------------------------------------------------ +-- GArrow instances for Control.Arrow + +instance Arrow a => GArrow a (,) where + ga_id = arr Prelude.id + ga_comp = (>>>) + ga_first = first + ga_second = second + ga_cancell = arr (\((),x) -> x) + ga_cancelr = arr (\(x,()) -> x) + ga_uncancell = arr (\x -> ((),x)) + ga_uncancelr = arr (\x -> (x,())) + ga_assoc = arr (\((x,y),z) -> (x,(y,z))) + ga_unassoc = arr (\(x,(y,z)) -> ((x,y),z)) + +instance Arrow a => GArrowDrop a (,) where + ga_drop = arr (\x -> ()) + +instance Arrow a => GArrowCopy a (,) where + ga_copy = arr (\x -> (x,x)) + +instance Arrow a => GArrowSwap a (,) where + ga_swap = arr (\(x,y) -> (y,x)) + +instance Arrow a => GArrowLiteral a (,) where + ga_literal x = arr (\() -> x) + +instance Arrow a => GArrowReify a (,) where + ga_reify = arr + +instance ArrowLoop a => GArrowLoop a (,) where + ga_loop = loop + + -- 1.7.10.4