Add common instances to Interpreting.Dup.

diff --git a/symantic/Language/Symantic/Interpreting/Dup.hs b/symantic/Language/Symantic/Interpreting/Dup.hs
index f789ef61385e5c360dca71634b3601cefb0cba65..c4a7158f43ba7205620c317d39fac7f4dd4c65d4 100644 (file)
--- a/symantic/Language/Symantic/Interpreting/Dup.hs
+++ b/symantic/Language/Symantic/Interpreting/Dup.hs
@@ -1,51 +1,76 @@
 {-# 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 @term@
--- at parsing time as done with 'Term';
--- it is mainly here for the sake of curiosity.
+-- 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
 
--- | Interpreter's data.
-data Dup term1 term2 a
+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 :: term1 a
- ,   dup_2 :: term2 a
+ {   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 r, cl s)
- => (forall term. cl term => term a)
- -> Dup r s a
+-- * 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 r, cl s)
- => (forall term. cl term => term a -> term b)
- -> Dup r s a
- -> Dup r s b
+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 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 ::
+ (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 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 ::
+ (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)) ([],[])