{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
-- | 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 @term@
-- at parsing time as done with 'Term';
-- it is mainly here for the sake of curiosity.
module Language.Symantic.Interpreting.Dup where

-- | Interpreter's data.
data Dup term1 term2 a
 =   Dup
 {   dup_1 :: term1 a
 ,   dup_2 :: term2 a
 }

dup0
 :: (cl r, cl s)
 => (forall term. cl term => term a)
 -> Dup r s a
dup0 f = f `Dup` f

dup1
 :: (cl r, cl s)
 => (forall term. cl term => term a -> term b)
 -> Dup r s a
 -> Dup r s b
dup1 f (a1 `Dup` a2) =
	f a1 `Dup` f a2

dup2
 :: (cl r, cl s)
 => (forall term. cl term => term a -> term b -> term c)
 -> Dup r s a
 -> Dup r s b
 -> Dup r s c
dup2 f (a1 `Dup` a2) (b1 `Dup` b2) =
	f a1 b1 `Dup` f a2 b2

dup3
 :: (cl r, cl s)
 => (forall term. cl term => term a -> term b -> term c -> term d)
 -> Dup r s a
 -> Dup r s b
 -> Dup r s c
 -> Dup r s d
dup3 f (a1 `Dup` a2) (b1 `Dup` b2) (c1 `Dup` c2) =
	f a1 b1 c1 `Dup` f a2 b2 c2