Dup.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Rank2Types #-}
-- | Interpreter to duplicate the representation of an expression
-- in order to evaluate it with different interpreters.
--
-- NOTE: this is a more verbose, less clear,
-- and maybe less efficient alternative
-- to maintaining the universal polymorphism of @repr@
-- either using @NoMonomorphismRestriction@ when writing an EDSL,
-- or with a @forall repr.@ within a data type
-- when writing a DSL; as is done when parsing 'Term' in this library;
-- it is thus mainly here for the sake of curiosity.
module Language.Symantic.Interpreting.Dup where

import Control.Applicative (Applicative(..), Alternative(..))
import Data.Functor (Functor(..))

-- * Type 'Dup'
-- | Duplicate an implicitly generated representation.
--
-- Useful to combine two symantic interpreters into one.
data Dup repr1 repr2 a
 =   Dup
 {   dup_1 :: repr1 a
 ,   dup_2 :: repr2 a
 }
infixl 2 `Dup`
instance (Functor x, Functor y) => Functor (Dup x y) where
	fmap f (x`Dup`y) = fmap f x `Dup` fmap f y
instance (Applicative x, Applicative y) => Applicative (Dup x y) where
	pure a = pure a `Dup` pure a
	(f`Dup`g) <*> (x`Dup`y) = f <*> x `Dup` g <*> y
	(f`Dup`g) <*  (x`Dup`y) = f <*  x `Dup` g <*  y
	(f`Dup`g)  *> (x`Dup`y) = f  *> x `Dup` g  *> y
instance (Alternative x, Alternative y) => Alternative (Dup x y) where
	empty = empty `Dup` empty
	(f`Dup`g) <|> (x`Dup`y) = f <|> x `Dup` g <|> y
	many (x`Dup`y) = many x `Dup` many y
	some (x`Dup`y) = some x `Dup` some y

-- * Helpers
-- | To be used with the @TypeApplications@ language extension:
-- @
-- dup0 \@Sym_Foo foo
-- @
dup0 :: (cl x, cl y) => (forall repr. cl repr => repr a) -> Dup x y a
dup0 f = f `Dup` f
{-# INLINE dup0 #-}

dup1 ::
 (cl x, cl y) =>
 (forall repr. cl repr => repr a -> repr b) ->
 Dup x y a -> Dup x y b
dup1 f (a1 `Dup` a2) =
	f a1 `Dup` f a2
{-# INLINE dup1 #-}

dup2 ::
 (cl x, cl y) =>
 (forall repr. cl repr => repr a -> repr b -> repr c) ->
 Dup x y a -> Dup x y b -> Dup x y c
dup2 f (a1 `Dup` a2) (b1 `Dup` b2) =
	f a1 b1 `Dup` f a2 b2
{-# INLINE dup2 #-}

dup3 ::
 (cl x, cl y) =>
 (forall repr. cl repr => repr a -> repr b -> repr c -> repr d)
 -> Dup x y a -> Dup x y b -> Dup x y c -> Dup x y d
dup3 f (a1 `Dup` a2) (b1 `Dup` b2) (c1 `Dup` c2) =
	f a1 b1 c1 `Dup` f a2 b2 c2
{-# INLINE dup3 #-}

dupList :: [Dup x y a] -> ([x a], [y a])
dupList = foldr (\(a`Dup`b) ~(as, bs) -> (a:as, b:bs)) ([],[])