]> Git — Sourcephile - haskell/symantic.git/blob - symantic-lib/Language/Symantic/Lib/Alternative.hs
Sync with ghc-8.2.2 and megaparsec-6.3.0.
[haskell/symantic.git] / symantic-lib / Language / Symantic / Lib / Alternative.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 -- | Symantic for 'Alternative'.
4 module Language.Symantic.Lib.Alternative where
5
6 import Control.Applicative (Alternative)
7 import Prelude hiding (Functor(..))
8 import qualified Control.Applicative as Alternative
9
10 import Language.Symantic
11 import Language.Symantic.Lib.Functor (Sym_Functor(..), f1)
12 import Language.Symantic.Lib.Function (a0)
13
14 -- * Class 'Sym_Alternative'
15 type instance Sym Alternative = Sym_Alternative
16 class Sym_Functor term => Sym_Alternative term where
17 empty :: Alternative f => term (f a)
18 (<|>) :: Alternative f => term (f a) -> term (f a) -> term (f a)
19 infixl 3 <|>
20
21 default empty :: Sym_Alternative (UnT term) => Trans term => Alternative f => term (f a)
22 default (<|>) :: Sym_Alternative (UnT term) => Trans term => Alternative f => term (f a) -> term (f a) -> term (f a)
23
24 empty = trans empty
25 (<|>) = trans2 (<|>)
26
27 -- Interpreting
28 instance Sym_Alternative Eval where
29 empty = Eval Alternative.empty
30 (<|>) = eval2 (Alternative.<|>)
31 instance Sym_Alternative View where
32 empty = view0 "empty"
33 (<|>) = viewInfix "<|>" (infixL 3)
34 instance (Sym_Alternative r1, Sym_Alternative r2) => Sym_Alternative (Dup r1 r2) where
35 empty = dup0 @Sym_Alternative empty
36 (<|>) = dup2 @Sym_Alternative (<|>)
37
38 -- Transforming
39 instance (Sym_Lambda term, Sym_Alternative term) => Sym_Alternative (BetaT term)
40
41 -- Typing
42 instance NameTyOf Alternative where
43 nameTyOf _c = ["Alternative"] `Mod` "Alternative"
44 instance FixityOf Alternative
45 instance ClassInstancesFor Alternative
46 instance TypeInstancesFor Alternative
47
48 -- Compiling
49 instance Gram_Term_AtomsFor src ss g Alternative
50 instance (Source src, SymInj ss Alternative) => ModuleFor src ss Alternative where
51 moduleFor = ["Alternative"] `moduleWhere`
52 [ "empty" := teAlternative_empty
53 , "<|>" `withInfixL` 3 := teAlternative_alt
54 ]
55
56 -- ** 'Type's
57 tyAlternative :: Source src => Type src vs a -> Type src vs (Alternative a)
58 tyAlternative a = tyConstLen @(K Alternative) @Alternative (lenVars a) `tyApp` a
59
60 -- ** 'Term's
61 teAlternative_empty :: TermDef Alternative '[Proxy a, Proxy f] (Alternative f #> f a)
62 teAlternative_empty = Term (tyAlternative f1) (f1 `tyApp` a0) $ teSym @Alternative $ empty
63
64 teAlternative_alt :: TermDef Alternative '[Proxy a, Proxy f] (Alternative f #> (f a -> f a -> f a))
65 teAlternative_alt = Term (tyAlternative f1) (f1 `tyApp` a0 ~> f1 `tyApp` a0 ~> f1 `tyApp` a0) $ teSym @Alternative $ lam2 (<|>)