-- | 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