{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE Rank2Types #-}
module Language.Symantic.Interpreting.Dup where
import Control.Applicative (Applicative(..), Alternative(..))
import Data.Functor (Functor(..))
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
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)) ([],[])