1 {-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators -XFlexibleInstances -XFunctionalDependencies #-}
2 -----------------------------------------------------------------------------
4 -- Module : GHC.HetMet.Arrow
6 -- License : public domain
8 -- Maintainer : Adam Megacz <megacz@acm.org>
9 -- Stability : experimental
10 -- Portability : portable
12 module GHC.HetMet.Arrow where
13 import GHC.HetMet.GArrow
15 import Control.Category
17 ------------------------------------------------------------------------------
18 -- GArrow instances for Control.Arrow; this is kept in a separate
19 -- module because having it available to GHC's instance-search
20 -- algorithm often creates overlapping or even undecidable
21 -- instance-search problems
23 instance Arrow a => GArrow a (,) where
26 ga_cancell = arr (\((),x) -> x)
27 ga_cancelr = arr (\(x,()) -> x)
28 ga_uncancell = arr (\x -> ((),x))
29 ga_uncancelr = arr (\x -> (x,()))
30 ga_assoc = arr (\((x,y),z) -> (x,(y,z)))
31 ga_unassoc = arr (\(x,(y,z)) -> ((x,y),z))
33 instance Arrow a => GArrowDrop a (,) where
34 ga_drop = arr (\x -> ())
36 instance Arrow a => GArrowCopy a (,) where
37 ga_copy = arr (\x -> (x,x))
39 instance Arrow a => GArrowSwap a (,) where
40 ga_swap = arr (\(x,y) -> (y,x))
42 instance Arrow a => GArrowConstant a (,) where
43 ga_constant x = arr (\() -> x)
45 instance Arrow a => GArrowReify a (,) where
48 instance ArrowLoop a => GArrowLoop a (,) where