Language/Symantic/Trans/Common.hs

   1 {-# LANGUAGE MultiParamTypeClasses #-}
   2 {-# LANGUAGE TypeFamilies #-}
   3 module Language.Symantic.Trans.Common where
   4
   5 -- |
   6 -- * 'trans_lift' is generally not /surjective/
   7 -- * 'trans_apply' is not /injective/
   8 -- * 'trans_apply' . 'trans_lift' == 'id'
   9 -- * 'trans_lift' . 'trans_apply' /= 'id'
  10 --
  11 -- NOTE: @DefaultSignatures@ can be used
  12 -- when declaring a symantic type class
  13 -- to provide default definition of the methods:
  14 -- implementing their identity transformation
  15 -- in order to avoid boilerplate code
  16 -- when writting 'Trans' instances which
  17 -- do not need to alterate those methods.
  18 class Trans t repr where
  19         -- | Lift an interpreter to the transformer's.
  20         trans_lift  :: repr a -> t repr a
  21         -- | Unlift an interpreter from the transformer's.
  22         trans_apply :: t repr a -> repr a
  23
  24         -- | Convenient method to define the identity transformation for a unary symantic method.
  25         trans_map1 :: (repr a -> repr b) -> (t repr a -> t repr b)
  26         trans_map1 f = trans_lift . f . trans_apply
  27
  28         -- | Convenient method to define the identity transformation for a binary symantic method.
  29         trans_map2
  30          :: (repr a -> repr b -> repr c)
  31          -> (t repr a -> t repr b -> t repr c)
  32         trans_map2 f e1 e2 = trans_lift (trans_apply e1 `f` trans_apply e2)
  33
  34         -- | Convenient method to define the identity transformation for a terary symantic method.
  35         trans_map3
  36          :: (repr a -> repr b -> repr c -> repr d)
  37          -> (t repr a -> t repr b -> t repr c -> t repr d)
  38         trans_map3 f e1 e2 e3 = trans_lift $ f (trans_apply e1) (trans_apply e2) (trans_apply e3)
  39
  40 -- | Closed type family extracting the representation
  41 -- upon which a transformer is applied.
  42 --
  43 -- This is useful to write default associated types in symantics.
  44 type family Repr_of_Trans (repr :: * -> *) :: (* -> *) where
  45         Repr_of_Trans (t repr) = repr