]> Git — Sourcephile - haskell/symantic.git/blob - symantic-lib/Language/Symantic/Lib/MonoFoldable.hs
Support GHC-8.4.3.
[haskell/symantic.git] / symantic-lib / Language / Symantic / Lib / MonoFoldable.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 -- | Symantic for 'MonoFoldable'.
4 module Language.Symantic.Lib.MonoFoldable where
5
6 import Data.Bool
7 import Data.Function (($), (.))
8 import Data.Monoid (Monoid)
9 import Data.Int (Int)
10 import Data.MonoTraversable (MonoFoldable)
11 import qualified Data.MonoTraversable as MT
12
13 import Language.Symantic
14 import Language.Symantic.Lib.Bool (tyBool)
15 import Language.Symantic.Lib.Function ()
16 import Language.Symantic.Lib.Int (tyInt)
17 import Language.Symantic.Lib.List (tyList)
18 import Language.Symantic.Lib.MonoFunctor (famElement, o0, e1)
19 import Language.Symantic.Lib.Monoid (tyMonoid)
20
21 -- * Class 'Sym_MonoFoldable'
22 type instance Sym MonoFoldable = Sym_MonoFoldable
23 class Sym_MonoFoldable term where
24 ofoldMap :: (MonoFoldable o, Monoid m) => term (MT.Element o -> m) -> term o -> term m
25 ofoldr :: MonoFoldable o => term (MT.Element o -> b -> b) -> term b -> term o -> term b
26 ofoldl' :: MonoFoldable o => term (b -> MT.Element o -> b) -> term b -> term o -> term b
27 olength :: MonoFoldable o => term o -> term Int
28 onull :: MonoFoldable o => term o -> term Bool
29 oall :: MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
30 oany :: MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
31 otoList :: MonoFoldable o => term o -> term [MT.Element o]
32 default ofoldMap :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => Monoid m => term (MT.Element o -> m) -> term o -> term m
33 default ofoldr :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (MT.Element o -> b -> b) -> term b -> term o -> term b
34 default ofoldl' :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (b -> MT.Element o -> b) -> term b -> term o -> term b
35 default olength :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term o -> term Int
36 default onull :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term o -> term Bool
37 default oall :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
38 default oany :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term (MT.Element o -> Bool) -> term o -> term Bool
39 default otoList :: Sym_MonoFoldable (UnT term) => Trans term => MonoFoldable o => term o -> term [MT.Element o]
40 ofoldMap = trans2 ofoldMap
41 ofoldr = trans3 ofoldr
42 ofoldl' = trans3 ofoldl'
43 olength = trans1 olength
44 onull = trans1 onull
45 oall = trans2 oall
46 oany = trans2 oany
47 otoList = trans1 otoList
48
49 -- Interpreting
50 instance Sym_MonoFoldable Eval where
51 ofoldMap = eval2 MT.ofoldMap
52 ofoldr = eval3 MT.ofoldr
53 ofoldl' = eval3 MT.ofoldl'
54 olength = eval1 MT.olength
55 onull = eval1 MT.onull
56 oall = eval2 MT.oall
57 oany = eval2 MT.oany
58 otoList = eval1 MT.otoList
59 instance Sym_MonoFoldable View where
60 ofoldMap = view2 "ofoldMap"
61 ofoldr = view3 "ofoldr"
62 ofoldl' = view3 "ofoldl'"
63 olength = view1 "olength"
64 onull = view1 "onull"
65 oall = view2 "oall"
66 oany = view2 "oany"
67 otoList = view1 "otoList"
68 instance (Sym_MonoFoldable r1, Sym_MonoFoldable r2) => Sym_MonoFoldable (Dup r1 r2) where
69 ofoldMap = dup2 @Sym_MonoFoldable ofoldMap
70 ofoldr = dup3 @Sym_MonoFoldable ofoldr
71 ofoldl' = dup3 @Sym_MonoFoldable ofoldl'
72 olength = dup1 @Sym_MonoFoldable olength
73 onull = dup1 @Sym_MonoFoldable onull
74 oall = dup2 @Sym_MonoFoldable oall
75 oany = dup2 @Sym_MonoFoldable oany
76 otoList = dup1 @Sym_MonoFoldable otoList
77
78 -- Transforming
79 instance (Sym_MonoFoldable term, Sym_Lambda term) => Sym_MonoFoldable (BetaT term)
80
81 -- Typing
82 instance NameTyOf MonoFoldable where
83 nameTyOf _c = ["MonoFoldable"] `Mod` "MonoFoldable"
84 instance FixityOf MonoFoldable
85 instance ClassInstancesFor MonoFoldable
86 instance TypeInstancesFor MonoFoldable
87
88 -- Compiling
89 instance Gram_Term_AtomsFor src ss g MonoFoldable
90 instance (Source src, SymInj ss MonoFoldable) => ModuleFor src ss MonoFoldable where
91 moduleFor = ["MonoFoldable"] `moduleWhere`
92 [ "ofoldMap" := teMonoFoldable_ofoldMap
93 , "otoList" := teMonoFoldable_otoList
94 , "ofoldr" := teMonoFoldable_ofoldr
95 , "ofoldl'" := teMonoFoldable_ofoldl'
96 , "olength" := teMonoFoldable_olength
97 , "onull" := teMonoFoldable_onull
98 , "oall" := teMonoFoldable_oall
99 , "oany" := teMonoFoldable_oany
100 ]
101
102 -- ** 'Type's
103 tyMonoFoldable :: Source src => Type src vs a -> Type src vs (MonoFoldable a)
104 tyMonoFoldable a = tyConstLen @(K MonoFoldable) @MonoFoldable (lenVars a) `tyApp` a
105
106 -- ** 'Term's
107 teMonoFoldable_ofoldMap :: TermDef MonoFoldable '[Proxy o, Proxy e, Proxy m] (MonoFoldable o # Monoid m # e #~ MT.Element o #> ((e -> m) -> o -> m))
108 teMonoFoldable_ofoldMap = Term (tyMonoFoldable o0 # tyMonoid m # e1 #~ famElement o0) ((e1 ~> m) ~> o0 ~> m) $ teSym @MonoFoldable $ lam2 ofoldMap
109 where
110 m :: Source src => LenInj vs => KindInj (K m) => Type src (Proxy a ': Proxy b ': Proxy m ': vs) m
111 m = tyVar "m" $ VarS $ VarS varZ
112
113 teMonoFoldable_otoList :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> (o -> [MT.Element o]))
114 teMonoFoldable_otoList = Term (tyMonoFoldable o0 # e1 #~ famElement o0) (o0 ~> tyList (famElement o0)) $ teSym @MonoFoldable $ lam1 otoList
115
116 teMonoFoldable_ofoldr :: TermDef MonoFoldable '[Proxy o, Proxy e, Proxy a] (MonoFoldable o # e #~ MT.Element o #> ((e -> a -> a) -> a -> o -> a))
117 teMonoFoldable_ofoldr = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((e1 ~> a ~> a) ~> a ~> o0 ~> a) $ teSym @MonoFoldable $ lam1 $ \f -> lam $ lam . ofoldr f
118 where
119 a :: Source src => LenInj vs => KindInj (K a) => Type src (Proxy _a ': Proxy b ': Proxy a ': vs) a
120 a = tyVar "a" $ VarS $ VarS varZ
121
122 teMonoFoldable_ofoldl' :: TermDef MonoFoldable '[Proxy o, Proxy e, Proxy a] (MonoFoldable o # e #~ MT.Element o #> ((a -> e -> a) -> a -> o -> a))
123 teMonoFoldable_ofoldl' = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((a ~> e1 ~> a) ~> a ~> o0 ~> a) $ teSym @MonoFoldable $ lam1 $ \f -> lam $ lam . ofoldl' f
124 where
125 a :: Source src => LenInj vs => KindInj (K a) => Type src (Proxy _a ': Proxy b ': Proxy a ': vs) a
126 a = tyVar "a" $ VarS $ VarS varZ
127
128 teMonoFoldable_olength :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> (o -> Int))
129 teMonoFoldable_olength = Term (tyMonoFoldable o0 # e1 #~ famElement o0) (o0 ~> tyInt) $ teSym @MonoFoldable $ lam1 olength
130
131 teMonoFoldable_onull :: TermDef MonoFoldable '[Proxy o] (MonoFoldable o #> (o -> Bool))
132 teMonoFoldable_onull = Term (tyMonoFoldable o0) (o0 ~> tyBool) $ teSym @MonoFoldable $ lam1 onull
133
134 teMonoFoldable_oall :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> ((e -> Bool) -> o -> Bool))
135 teMonoFoldable_oall = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((e1 ~> tyBool) ~> o0 ~> tyBool) $ teSym @MonoFoldable $ lam2 oall
136
137 teMonoFoldable_oany :: TermDef MonoFoldable '[Proxy o, Proxy e] (MonoFoldable o # e #~ MT.Element o #> ((e -> Bool) -> o -> Bool))
138 teMonoFoldable_oany = Term (tyMonoFoldable o0 # e1 #~ famElement o0) ((e1 ~> tyBool) ~> o0 ~> tyBool) $ teSym @MonoFoldable $ lam2 oany