-- | 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@ at parsing time
-- as done with 'Forall_Repr_with_Context';
-- it is mainly here for the sake of curiosity.
module Language.Symantic.Repr.Dup where

import Language.Symantic.Expr

-- | Interpreter's data.
data Dup repr1 repr2 a
 =   Dup
 {   dup1 :: repr1 a
 ,   dup2 :: repr2 a
 }

instance -- Sym_Bool
 ( Sym_Bool r1
 , Sym_Bool r2
 ) => Sym_Bool (Dup r1 r2) where
	bool x = bool x `Dup` bool x
	not  (x1 `Dup` x2)               = not  x1    `Dup` not  x2
	(&&) (x1 `Dup` x2) (y1 `Dup` y2) = (&&) x1 y1 `Dup` (&&) x2 y2
	(||) (x1 `Dup` x2) (y1 `Dup` y2) = (||) x1 y1 `Dup` (||) x2 y2
	xor  (x1 `Dup` x2) (y1 `Dup` y2) = xor  x1 y1 `Dup` xor  x2 y2
instance -- Sym_Int
 ( Sym_Int r1
 , Sym_Int r2
 ) => Sym_Int (Dup r1 r2) where
	int     x                          = int x     `Dup` int x
	abs    (x1 `Dup` x2)               = abs x1    `Dup` abs x2
	negate (x1 `Dup` x2)               = negate x1 `Dup` negate x2
	(+)    (x1 `Dup` x2) (y1 `Dup` y2) = (+) x1 y1 `Dup` (+) x2 y2
	(-)    (x1 `Dup` x2) (y1 `Dup` y2) = (-) x1 y1 `Dup` (-) x2 y2
	(*)    (x1 `Dup` x2) (y1 `Dup` y2) = (*) x1 y1 `Dup` (*) x2 y2
	mod    (x1 `Dup` x2) (y1 `Dup` y2) = mod x1 y1 `Dup` mod x2 y2
instance -- Sym_Eq
 ( Sym_Eq r1
 , Sym_Eq r2
 ) => Sym_Eq (Dup r1 r2) where
	(==) (x1 `Dup` x2) (y1 `Dup` y2) = (==) x1 y1 `Dup` (==) x2 y2
instance -- Sym_Ord
 ( Sym_Ord r1
 , Sym_Ord r2
 ) => Sym_Ord (Dup r1 r2) where
	compare (x1 `Dup` x2) (y1 `Dup` y2) =
		compare x1 y1 `Dup` compare x2 y2
instance -- Sym_If
 ( Sym_If r1
 , Sym_If r2
 ) => Sym_If (Dup r1 r2) where
	if_ (c1 `Dup` c2) (ok1 `Dup` ok2) (ko1 `Dup` ko2) =
		if_ c1 ok1 ko1 `Dup` if_ c2 ok2 ko2
instance -- Sym_When
 ( Sym_When r1
 , Sym_When r2
 ) => Sym_When (Dup r1 r2) where
	when (c1 `Dup` c2) (ok1 `Dup` ok2) =
		when c1 ok1 `Dup` when c2 ok2
instance -- Sym_List
 ( Sym_List r1
 , Sym_List r2
 ) => Sym_List (Dup r1 r2) where
	list_empty = list_empty `Dup` list_empty
	list_cons (a1 `Dup` a2) (l1 `Dup` l2) = list_cons a1 l1 `Dup` list_cons a2 l2
	list l =
		let (l1, l2) =
			foldr (\(x1 `Dup` x2) (xs1, xs2) ->
				(x1:xs1, x2:xs2)) ([], []) l in
		list l1 `Dup` list l2
instance -- Sym_List_Lam
 ( Sym_List_Lam lam r1
 , Sym_List_Lam lam r2
 ) => Sym_List_Lam lam (Dup r1 r2) where
	list_filter (f1 `Dup` f2) (l1 `Dup` l2) =
		list_filter f1 l1 `Dup` list_filter f2 l2
instance -- Sym_Maybe
 ( Sym_Maybe r1
 , Sym_Maybe r2
 ) => Sym_Maybe (Dup r1 r2) where
	nothing = nothing `Dup` nothing
	just (a1 `Dup` a2) = just a1 `Dup` just a2
instance -- Sym_Maybe_Lam
 ( Sym_Maybe_Lam lam r1
 , Sym_Maybe_Lam lam r2
 ) => Sym_Maybe_Lam lam (Dup r1 r2) where
	maybe (m1 `Dup` m2) (n1 `Dup` n2) (j1 `Dup` j2) =
		maybe m1 n1 j1 `Dup`
		maybe m2 n2 j2
instance -- Sym_Lambda
 ( Sym_Lambda lam r1
 , Sym_Lambda lam r2
 ) => Sym_Lambda lam (Dup r1 r2) where
	type Lambda_from_Repr (Dup r1 r2) = Lambda_from_Repr r1
	app (f1 `Dup` f2) (x1 `Dup` x2) = app f1 x1 `Dup` app f2 x2
	inline f = dup1 (inline f) `Dup` dup2 (inline f)
	val    f = dup1 (val f)    `Dup` dup2 (val f)
	lazy   f = dup1 (lazy f)   `Dup` dup2 (lazy f)
instance -- Sym_Tuple2
 ( Sym_Tuple2 r1
 , Sym_Tuple2 r2
 ) => Sym_Tuple2 (Dup r1 r2) where
	tuple2 (a1 `Dup` a2) (b1 `Dup` b2) =
		tuple2 a1 b1 `Dup` tuple2 a2 b2
instance -- Sym_Map
 ( Sym_Map r1
 , Sym_Map r2
 ) => Sym_Map (Dup r1 r2) where
	map_from_list (l1 `Dup` l2) =
		map_from_list l1 `Dup` map_from_list l2
instance -- Sym_Map_Lam
 ( Sym_Map_Lam lam r1
 , Sym_Map_Lam lam r2
 ) => Sym_Map_Lam lam (Dup r1 r2) where
	map_map (f1 `Dup` f2) (m1 `Dup` m2) =
		map_map f1 m1 `Dup` map_map f2 m2