X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FHetMet%2FArrow.hs;h=5bead2c491e4720b9170f87820d4bd95bb29933c;hb=f98950484a7cb01e43352e3d88277a2784cd58bf;hp=39bd2fe2c680c707c5d560e55c58bf4d8f7dad7b;hpb=5d6e930086fffc10e70fe91fa30ae01d9f75c6a9;p=ghc-base.git

diff --git a/GHC/HetMet/Arrow.hs b/GHC/HetMet/Arrow.hs
index 39bd2fe..5bead2c 100644
--- a/GHC/HetMet/Arrow.hs
+++ b/GHC/HetMet/Arrow.hs
@@ -20,7 +20,9 @@ import Control.Category
 -- algorithm often creates overlapping or even undecidable
 -- instance-search problems
 
-instance Arrow a => GArrow a (,) where
+type Id a = a
+
+instance Arrow a => GArrow a (,) () where
   ga_first     =  first
   ga_second    =  second
   ga_cancell   =  arr (\((),x) -> x)
@@ -30,24 +32,28 @@ instance Arrow a => GArrow a (,) where
   ga_assoc     =  arr (\((x,y),z) -> (x,(y,z)))
   ga_unassoc   =  arr (\(x,(y,z)) -> ((x,y),z))
   
-instance Arrow a => GArrowDrop a (,) where
+instance Arrow a => GArrowDrop a (,) () where
   ga_drop      =  arr (\x -> ())
 
-instance Arrow a => GArrowCopy a (,) where
+instance Arrow a => GArrowCopy a (,) () where
   ga_copy      =  arr (\x -> (x,x))
 
-instance Arrow a => GArrowSwap a (,) where
+instance Arrow a => GArrowSwap a (,) () where
   ga_swap      =  arr (\(x,y) -> (y,x))
 
-instance Arrow a => GArrowLiteral a (,) b where
-  ga_literal x = arr (\() -> x)
+instance Arrow a => GArrowConstant a (,) () t t where
+  ga_constant x = arr (\() -> x)
 
-instance Arrow a => GArrowReify a (,) where
+instance Arrow a => GArrowReify a (,) () x y x y where
   ga_reify     =  arr
 
-instance ArrowLoop a => GArrowLoop a (,) where
-  ga_loop      =  loop
+instance ArrowLoop a => GArrowLoop a (,) () where
+  ga_loopl     =  loop
+  ga_loopr  f  =  loop (ga_swap >>> f >>> ga_swap)
 
+instance ArrowApply a => GArrowApply a (,) () a where
+  ga_applyl    = ga_swap >>> app
+  ga_applyr    = app