1 {-# LANGUAGE RankNTypes, ScopedTypeVariables, NoMonomorphismRestriction, TypeOperators, FunctionalDependencies, FlexibleContexts #-}
2 -----------------------------------------------------------------------------
4 -- Module : GHC.HetMet.GArrow
6 -- License : public domain
8 -- Maintainer : Adam Megacz <megacz@acm.org>
9 -- Stability : experimental
10 -- Portability : portable
12 module GHC.HetMet.Private (
32 import Control.Category ( (>>>) )
33 import qualified Control.Category
34 import GHC.HetMet.GArrow
36 -------------------------------------------------------------------------
37 -- Used internally by the compiler, subject to change without notice!!
39 newtype PGArrow x y = PGArrow { unG :: forall g. GArrowSTKC g (,) () => g x y }
42 pga_id = PGArrow { unG = Control.Category.id }
43 pga_comp :: forall x y z. PGArrow x y -> PGArrow y z -> PGArrow x z
44 pga_comp f g = PGArrow { unG = unG f >>> unG g }
45 pga_first :: PGArrow x y -> PGArrow (x , z) (y , z)
46 pga_first f = PGArrow { unG = ga_first $ unG f }
47 pga_second :: PGArrow x y -> PGArrow (z , x) (z , y)
48 pga_second f = PGArrow { unG = ga_second $ unG f }
49 pga_cancell :: PGArrow ((),x) x
50 pga_cancell = PGArrow { unG = ga_cancell }
51 pga_cancelr :: PGArrow (x,()) x
52 pga_cancelr = PGArrow { unG = ga_cancelr }
53 pga_uncancell :: PGArrow x ((),x)
54 pga_uncancell = PGArrow { unG = ga_uncancell }
55 pga_uncancelr :: PGArrow x (x,())
56 pga_uncancelr = PGArrow { unG = ga_uncancelr }
57 pga_assoc :: PGArrow ((x, y),z ) ( x,(y ,z))
58 pga_assoc = PGArrow { unG = ga_assoc }
59 pga_unassoc :: PGArrow ( x,(y ,z)) ((x, y),z )
60 pga_unassoc = PGArrow { unG = ga_unassoc }
61 pga_copy :: PGArrow x (x,x)
62 pga_copy = PGArrow { unG = ga_copy }
63 pga_drop :: PGArrow x ()
64 pga_drop = PGArrow { unG = ga_drop }
65 pga_swap :: PGArrow (x,y) (y,x)
66 pga_swap = PGArrow { unG = ga_swap }
67 pga_applyl :: PGArrow (x,(x->y) ) y
68 pga_applyl = error "not implemented"
69 pga_applyr :: PGArrow ( (x->y),x) y
70 pga_applyr = error "not implemented"
71 pga_curryl :: PGArrow (x,y) z -> PGArrow x (y->z)
72 pga_curryl = error "not implemented"
73 pga_curryr :: PGArrow (x,y) z -> PGArrow y (x->z)
74 pga_curryr = error "not implemented"