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 g x y = PGArrowD { unG :: GArrowSTKC g (,) () => g x y }
41 pga_id :: forall g x. PGArrow g x x
42 pga_id = PGArrowD { unG = Control.Category.id }
43 pga_comp :: forall g x y z. PGArrow g x y -> PGArrow g y z -> PGArrow g x z
44 pga_comp f g = PGArrowD { unG = unG f >>> unG g }
45 pga_first :: forall g x y z . PGArrow g x y -> PGArrow g (x , z) (y , z)
46 pga_first f = PGArrowD { unG = ga_first $ unG f }
47 pga_second :: forall g x y z . PGArrow g x y -> PGArrow g (z , x) (z , y)
48 pga_second f = PGArrowD { unG = ga_second $ unG f }
49 pga_cancell :: forall g x . PGArrow g ((),x) x
50 pga_cancell = PGArrowD { unG = ga_cancell }
51 pga_cancelr :: forall g x . PGArrow g (x,()) x
52 pga_cancelr = PGArrowD { unG = ga_cancelr }
53 pga_uncancell :: forall g x . PGArrow g x ((),x)
54 pga_uncancell = PGArrowD { unG = ga_uncancell }
55 pga_uncancelr :: forall g x . PGArrow g x (x,())
56 pga_uncancelr = PGArrowD { unG = ga_uncancelr }
57 pga_assoc :: forall g x y z . PGArrow g ((x, y),z ) ( x,(y ,z))
58 pga_assoc = PGArrowD { unG = ga_assoc }
59 pga_unassoc :: forall g x y z . PGArrow g ( x,(y ,z)) ((x, y),z )
60 pga_unassoc = PGArrowD { unG = ga_unassoc }
61 pga_copy :: forall g x . PGArrow g x (x,x)
62 pga_copy = PGArrowD { unG = ga_copy }
63 pga_drop :: forall g x . PGArrow g x ()
64 pga_drop = PGArrowD { unG = ga_drop }
65 pga_swap :: forall g x y . PGArrow g (x,y) (y,x)
66 pga_swap = PGArrowD { unG = ga_swap }
67 pga_applyl :: forall g x y . PGArrow g (x,(x->y) ) y
68 pga_applyl = error "not implemented"
69 pga_applyr :: forall g x y . PGArrow g ( (x->y),x) y
70 pga_applyr = error "not implemented"
71 pga_curryl :: forall g x y z . PGArrow g (x,y) z -> PGArrow g x (y->z)
72 pga_curryl = error "not implemented"
73 pga_curryr :: forall g x y z . PGArrow g (x,y) z -> PGArrow g y (x->z)
74 pga_curryr = error "not implemented"
75 --pga_kappa :: forall g x y . (g u x -> g u y) -> g x y
76 --pga_kappa = error "not implemented"