GHC/HetMet/GArrow.hs

   1 {-# OPTIONS -XRankNTypes -XMultiParamTypeClasses -XNoMonomorphismRestriction -XTypeOperators #-}
   2 module GHC.HetMet.GArrow (
   3   GArrow(..),
   4   GArrowDrop(..),
   5   GArrowCopy(..),
   6   GArrowSwap(..),
   7   GArrowLoop(..),
   8   GArrowReify(..),
   9   GArrowReflect(..)
  10 ) where
  11
  12 class GArrow g (**) where
  13   ga_id        :: g x x
  14   ga_comp      :: g x y -> g y z -> g x z
  15   ga_first     :: g x y -> g (x ** z) (y ** z)
  16   ga_second    :: g x y -> g (z ** x) (z ** y)
  17   ga_cancell   :: g (()**x) x
  18   ga_cancelr   :: g (x**()) x
  19   ga_uncancell :: g x       (()**x)
  20   ga_uncancelr :: g x       (x**())
  21   ga_assoc     :: g ((x**y)**z) (x**(y**z))
  22   ga_unassoc   :: g (x**(y**z)) ((x**y)**z)
  23
  24 class GArrow g (**) => GArrowDrop g (**) where
  25   ga_drop      :: g x ()
  26
  27 class GArrow g (**) => GArrowCopy g (**) where
  28   ga_copy      :: g x (x**x)
  29
  30 class GArrow g (**) => GArrowSwap g (**) where
  31   ga_swap      :: g (x**y) (y**x)
  32   --ga_second  f =  ga_comp (ga_comp ga_swap (ga_first f)) ga_swap
  33
  34 class GArrow g (**) => GArrowLoop g (**) where
  35   ga_loop      :: g (x**z) (y**z) -> g x y
  36
  37 class GArrow g (**) => GArrowLiteral g (**) a where
  38   ga_literal   :: a -> g () a
  39
  40 -- not sure
  41 class GArrow g (**) => GArrowReify g (**) where
  42   ga_reify     :: (x -> y) -> g x y
  43
  44 -- not sure
  45 class GArrow g (**) => GArrowReflect g (**) where
  46   ga_reflect   :: g x y -> (x -> y)
  47
  48