symantic/Language/Symantic/Interpreting/Dup.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE ConstraintKinds #-}
   3 {-# LANGUAGE Rank2Types #-}
   4 -- | Interpreter to duplicate the representation of an expression
   5 -- in order to evaluate it with different interpreters.
   6 --
   7 -- NOTE: this is a more verbose, less clear,
   8 -- and maybe less efficient alternative
   9 -- to maintaining the universal polymorphism of @repr@
  10 -- either using @NoMonomorphismRestriction@ when writing an EDSL,
  11 -- or with a @forall repr.@ within a data type
  12 -- when writing a DSL; as is done when parsing 'Term' in this library;
  13 -- it is thus mainly here for the sake of curiosity.
  14 module Language.Symantic.Interpreting.Dup where
  15
  16 import Control.Applicative (Applicative(..), Alternative(..))
  17 import Data.Functor (Functor(..))
  18
  19 -- * Type 'Dup'
  20 -- | Duplicate an implicitly generated representation.
  21 --
  22 -- Useful to combine two symantic interpreters into one.
  23 data Dup repr1 repr2 a
  24  =   Dup
  25  {   dup_1 :: repr1 a
  26  ,   dup_2 :: repr2 a
  27  }
  28 infixl 2 `Dup`
  29 instance (Functor x, Functor y) => Functor (Dup x y) where
  30         fmap f (x`Dup`y) = fmap f x `Dup` fmap f y
  31 instance (Applicative x, Applicative y) => Applicative (Dup x y) where
  32         pure a = pure a `Dup` pure a
  33         (f`Dup`g) <*> (x`Dup`y) = f <*> x `Dup` g <*> y
  34         (f`Dup`g) <*  (x`Dup`y) = f <*  x `Dup` g <*  y
  35         (f`Dup`g)  *> (x`Dup`y) = f  *> x `Dup` g  *> y
  36 instance (Alternative x, Alternative y) => Alternative (Dup x y) where
  37         empty = empty `Dup` empty
  38         (f`Dup`g) <|> (x`Dup`y) = f <|> x `Dup` g <|> y
  39         many (x`Dup`y) = many x `Dup` many y
  40         some (x`Dup`y) = some x `Dup` some y
  41
  42 -- * Helpers
  43 -- | To be used with the @TypeApplications@ language extension:
  44 -- @
  45 -- dup0 \@Sym_Foo foo
  46 -- @
  47 dup0 :: (cl x, cl y) => (forall repr. cl repr => repr a) -> Dup x y a
  48 dup0 f = f `Dup` f
  49 {-# INLINE dup0 #-}
  50
  51 dup1 ::
  52  (cl x, cl y) =>
  53  (forall repr. cl repr => repr a -> repr b) ->
  54  Dup x y a -> Dup x y b
  55 dup1 f (a1 `Dup` a2) =
  56         f a1 `Dup` f a2
  57 {-# INLINE dup1 #-}
  58
  59 dup2 ::
  60  (cl x, cl y) =>
  61  (forall repr. cl repr => repr a -> repr b -> repr c) ->
  62  Dup x y a -> Dup x y b -> Dup x y c
  63 dup2 f (a1 `Dup` a2) (b1 `Dup` b2) =
  64         f a1 b1 `Dup` f a2 b2
  65 {-# INLINE dup2 #-}
  66
  67 dup3 ::
  68  (cl x, cl y) =>
  69  (forall repr. cl repr => repr a -> repr b -> repr c -> repr d)
  70  -> Dup x y a -> Dup x y b -> Dup x y c -> Dup x y d
  71 dup3 f (a1 `Dup` a2) (b1 `Dup` b2) (c1 `Dup` c2) =
  72         f a1 b1 c1 `Dup` f a2 b2 c2
  73 {-# INLINE dup3 #-}
  74
  75 dupList :: [Dup x y a] -> ([x a], [y a])
  76 dupList = foldr (\(a`Dup`b) ~(as, bs) -> (a:as, b:bs)) ([],[])