GHC/HetMet/Private.hs

   1 {-# LANGUAGE RankNTypes, ScopedTypeVariables, NoMonomorphismRestriction, TypeOperators, FunctionalDependencies, FlexibleContexts #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  GHC.HetMet.GArrow
   5 -- Copyright   :  none
   6 -- License     :  public domain
   7 --
   8 -- Maintainer  :  Adam Megacz <megacz@acm.org>
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11
  12 module GHC.HetMet.Private (
  13   PGArrow,
  14   pga_id,
  15   pga_comp,
  16   pga_first,
  17   pga_second,
  18   pga_cancell,
  19   pga_cancelr,
  20   pga_uncancell,
  21   pga_uncancelr,
  22   pga_assoc,
  23   pga_unassoc,
  24   pga_copy,
  25   pga_drop,
  26   pga_swap,
  27   pga_applyl,
  28   pga_applyr,
  29   pga_curryl,
  30   pga_curryr
  31 ) where
  32 import Control.Category ( (>>>) )
  33 import qualified Control.Category
  34 import GHC.HetMet.GArrow
  35
  36 -------------------------------------------------------------------------
  37 -- Used internally by the compiler, subject to change without notice!!
  38
  39 newtype PGArrow x y = PGArrow { unG :: forall g. GArrowSTKC g (,) () => g x y }
  40
  41 pga_id        :: PGArrow x x
  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"