]> Git — Sourcephile - haskell/symantic.git/blob - symantic/Language/Symantic/Interpreting/Dup.hs
Clarify a few names in Grammar.Fixity.
[haskell/symantic.git] / symantic / Language / Symantic / Interpreting / Dup.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE ConstraintKinds #-}
3 {-# LANGUAGE Rank2Types #-}
4 -- | Interpreter to duplicate the representation of an expression
5 -- in order to evaluate it with different interpreters.
6 --
7 -- NOTE: this is a more verbose, less clear,
8 -- and maybe less efficient alternative
9 -- to maintaining the universal polymorphism of @repr@
10 -- either using @NoMonomorphismRestriction@ when writing an EDSL,
11 -- or with a @forall repr.@ within a data type
12 -- when writing a DSL; as is done when parsing 'Term' in this library;
13 -- it is thus mainly here for the sake of curiosity.
14 module Language.Symantic.Interpreting.Dup where
15
16 import Control.Applicative (Applicative(..), Alternative(..))
17 import Data.Functor (Functor(..))
18
19 -- * Type 'Dup'
20 -- | Duplicate an implicitly generated representation.
21 --
22 -- Useful to combine two symantic interpreters into one.
23 data Dup repr1 repr2 a
24 = Dup
25 { dup_1 :: repr1 a
26 , dup_2 :: repr2 a
27 }
28 infixl 2 `Dup`
29 instance (Functor x, Functor y) => Functor (Dup x y) where
30 fmap f (x`Dup`y) = fmap f x `Dup` fmap f y
31 instance (Applicative x, Applicative y) => Applicative (Dup x y) where
32 pure a = pure a `Dup` pure a
33 (f`Dup`g) <*> (x`Dup`y) = f <*> x `Dup` g <*> y
34 (f`Dup`g) <* (x`Dup`y) = f <* x `Dup` g <* y
35 (f`Dup`g) *> (x`Dup`y) = f *> x `Dup` g *> y
36 instance (Alternative x, Alternative y) => Alternative (Dup x y) where
37 empty = empty `Dup` empty
38 (f`Dup`g) <|> (x`Dup`y) = f <|> x `Dup` g <|> y
39 many (x`Dup`y) = many x `Dup` many y
40 some (x`Dup`y) = some x `Dup` some y
41
42 -- * Helpers
43 -- | To be used with the @TypeApplications@ language extension:
44 -- @
45 -- dup0 \@Sym_Foo foo
46 -- @
47 dup0 :: (cl x, cl y) => (forall repr. cl repr => repr a) -> Dup x y a
48 dup0 f = f `Dup` f
49 {-# INLINE dup0 #-}
50
51 dup1 ::
52 (cl x, cl y) =>
53 (forall repr. cl repr => repr a -> repr b) ->
54 Dup x y a -> Dup x y b
55 dup1 f (a1 `Dup` a2) =
56 f a1 `Dup` f a2
57 {-# INLINE dup1 #-}
58
59 dup2 ::
60 (cl x, cl y) =>
61 (forall repr. cl repr => repr a -> repr b -> repr c) ->
62 Dup x y a -> Dup x y b -> Dup x y c
63 dup2 f (a1 `Dup` a2) (b1 `Dup` b2) =
64 f a1 b1 `Dup` f a2 b2
65 {-# INLINE dup2 #-}
66
67 dup3 ::
68 (cl x, cl y) =>
69 (forall repr. cl repr => repr a -> repr b -> repr c -> repr d)
70 -> Dup x y a -> Dup x y b -> Dup x y c -> Dup x y d
71 dup3 f (a1 `Dup` a2) (b1 `Dup` b2) (c1 `Dup` c2) =
72 f a1 b1 c1 `Dup` f a2 b2 c2
73 {-# INLINE dup3 #-}
74
75 dupList :: [Dup x y a] -> ([x a], [y a])
76 dupList = foldr (\(a`Dup`b) ~(as, bs) -> (a:as, b:bs)) ([],[])