add GArrow instance for Control.Arrow

diff --git a/GHC/HetMet/GArrow.hs b/GHC/HetMet/GArrow.hs
index da6a9c2..93d2886 100644 (file)
--- 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
+
+