]> Git — Sourcephile - haskell/symantic.git/blob - symantic-lib/Language/Symantic/Lib/Semigroup.hs
Support GHC-8.4.3.
[haskell/symantic.git] / symantic-lib / Language / Symantic / Lib / Semigroup.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 -- | Symantic for 'Semigroup'.
4 module Language.Symantic.Lib.Semigroup where
5
6 import Data.Function (($))
7 import Data.Semigroup (Semigroup)
8 import Prelude (Integral)
9 import qualified Data.Semigroup as Semigroup
10
11 import Language.Symantic
12 import Language.Symantic.Lib.Function (a0, b1)
13 import Language.Symantic.Lib.Integral (tyIntegral)
14
15 -- * Class 'Sym_Semigroup'
16 type instance Sym Semigroup = Sym_Semigroup
17 class Sym_Semigroup term where
18 (<>) :: Semigroup a => term a -> term a -> term a
19 stimes :: (Semigroup a, Integral b) => term b -> term a -> term a
20 -- sconcat :: NonEmpty a -> a
21 default (<>) :: Sym_Semigroup (UnT term) => Trans term => Semigroup a => term a -> term a -> term a
22 default stimes :: Sym_Semigroup (UnT term) => Trans term => Semigroup a => Integral b => term b -> term a -> term a
23 (<>) = trans2 (<>)
24 stimes = trans2 stimes
25
26 -- Interpreting
27 instance Sym_Semigroup Eval where
28 (<>) = eval2 (Semigroup.<>)
29 stimes = eval2 Semigroup.stimes
30 instance Sym_Semigroup View where
31 (<>) = viewInfix "-" (infixR 6)
32 stimes = view2 "stimes"
33 instance (Sym_Semigroup r1, Sym_Semigroup r2) => Sym_Semigroup (Dup r1 r2) where
34 (<>) = dup2 @Sym_Semigroup (<>)
35 stimes = dup2 @Sym_Semigroup stimes
36
37 -- Transforming
38 instance (Sym_Semigroup term, Sym_Lambda term) => Sym_Semigroup (BetaT term)
39
40 -- Typing
41 instance NameTyOf Semigroup where
42 nameTyOf _c = ["Semigroup"] `Mod` "Semigroup"
43 instance FixityOf Semigroup
44 instance ClassInstancesFor Semigroup
45 instance TypeInstancesFor Semigroup
46
47 -- Compiling
48 instance Gram_Term_AtomsFor src ss g Semigroup
49 instance (Source src, SymInj ss Semigroup) => ModuleFor src ss Semigroup where
50 moduleFor = ["Semigroup"] `moduleWhere`
51 [ "<>" `withInfixR` 6 := teSemigroup_sappend
52 , "stimes" := teSemigroup_stimes
53 ]
54
55 -- ** 'Type's
56 tySemigroup :: Source src => Type src vs a -> Type src vs (Semigroup a)
57 tySemigroup a = tyConstLen @(K Semigroup) @Semigroup (lenVars a) `tyApp` a
58
59 -- ** 'Term's
60 teSemigroup_sappend :: TermDef Semigroup '[Proxy a] (Semigroup a #> (a -> a -> a))
61 teSemigroup_sappend = Term (tySemigroup a0) (a0 ~> a0 ~> a0) $ teSym @Semigroup $ lam2 (<>)
62
63 teSemigroup_stimes :: TermDef Semigroup '[Proxy a, Proxy b] (Semigroup a # Integral b #> (b -> a -> a))
64 teSemigroup_stimes = Term (tySemigroup a0 # tyIntegral b1) (b1 ~> a0 ~> a0) $ teSym @Semigroup $ lam2 stimes