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 (
33 import Control.Category ( (>>>) )
34 import qualified Control.Category
35 import GHC.HetMet.GArrow
37 -------------------------------------------------------------------------
38 -- Used internally by the compiler, subject to change without notice!!
40 newtype PGArrow g x y = PGArrowD { unG :: GArrowSTKC g (,) () => g x y }
42 pga_id :: forall g x. PGArrow g x x
43 pga_id = PGArrowD { unG = Control.Category.id }
44 pga_comp :: forall g x y z. PGArrow g x y -> PGArrow g y z -> PGArrow g x z
45 pga_comp f g = PGArrowD { unG = unG f >>> unG g }
46 pga_first :: forall g x y z . PGArrow g x y -> PGArrow g (x , z) (y , z)
47 pga_first f = PGArrowD { unG = ga_first $ unG f }
48 pga_second :: forall g x y z . PGArrow g x y -> PGArrow g (z , x) (z , y)
49 pga_second f = PGArrowD { unG = ga_second $ unG f }
50 pga_cancell :: forall g x . PGArrow g ((),x) x
51 pga_cancell = PGArrowD { unG = ga_cancell }
52 pga_cancelr :: forall g x . PGArrow g (x,()) x
53 pga_cancelr = PGArrowD { unG = ga_cancelr }
54 pga_uncancell :: forall g x . PGArrow g x ((),x)
55 pga_uncancell = PGArrowD { unG = ga_uncancell }
56 pga_uncancelr :: forall g x . PGArrow g x (x,())
57 pga_uncancelr = PGArrowD { unG = ga_uncancelr }
58 pga_assoc :: forall g x y z . PGArrow g ((x, y),z ) ( x,(y ,z))
59 pga_assoc = PGArrowD { unG = ga_assoc }
60 pga_unassoc :: forall g x y z . PGArrow g ( x,(y ,z)) ((x, y),z )
61 pga_unassoc = PGArrowD { unG = ga_unassoc }
62 pga_copy :: forall g x . PGArrow g x (x,x)
63 pga_copy = PGArrowD { unG = ga_copy }
64 pga_drop :: forall g x . PGArrow g x ()
65 pga_drop = PGArrowD { unG = ga_drop }
66 pga_swap :: forall g x y . PGArrow g (x,y) (y,x)
67 pga_swap = PGArrowD { unG = ga_swap }
68 pga_applyl :: forall g x y . PGArrow g (x,(x->y) ) y
69 pga_applyl = error "not implemented"
70 pga_applyr :: forall g x y . PGArrow g ( (x->y),x) y
71 pga_applyr = error "not implemented"
72 pga_curryl :: forall g x y z . PGArrow g (x,y) z -> PGArrow g x (y->z)
73 pga_curryl = error "not implemented"
74 pga_curryr :: forall g x y z . PGArrow g (x,y) z -> PGArrow g y (x->z)
75 pga_curryr = error "not implemented"
76 pga_kappa :: forall g x y . (g () x -> g () y) -> g x y
77 pga_kappa = error "not implemented"