]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Compiling/Foldable.hs
Add Parsing.Token.
[haskell/symantic.git] / Language / Symantic / Compiling / Foldable.hs
1 {-# LANGUAGE UndecidableInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 -- | Symantic for 'Foldable'.
4 module Language.Symantic.Compiling.Foldable where
5
6 import Data.Foldable (Foldable)
7 import qualified Data.Foldable as Foldable
8 import Control.Monad (liftM, liftM2, liftM3)
9 import Data.Proxy
10 import Data.Text (Text)
11 import Data.Type.Equality ((:~:)(Refl))
12 import Prelude hiding (Foldable(..)
13 , all, and, any, concat, concatMap
14 , mapM_, notElem, or, sequence, sequence_)
15
16 import Language.Symantic.Parsing
17 import Language.Symantic.Typing
18 import Language.Symantic.Compiling.Term
19 import Language.Symantic.Interpreting
20 import Language.Symantic.Transforming.Trans
21
22 -- * Class 'Sym_Foldable'
23 class Sym_Foldable term where
24 foldMap :: (Foldable f, Monoid m) => term (a -> m) -> term (f a) -> term m
25 foldr :: Foldable f => term (a -> b -> b) -> term b -> term (f a) -> term b
26 foldr' :: Foldable f => term (a -> b -> b) -> term b -> term (f a) -> term b
27 foldl :: Foldable f => term (b -> a -> b) -> term b -> term (f a) -> term b
28 foldl' :: Foldable f => term (b -> a -> b) -> term b -> term (f a) -> term b
29 length :: Foldable f => term (f a) -> term Int
30 null :: Foldable f => term (f a) -> term Bool
31 minimum :: (Foldable f, Ord a) => term (f a) -> term a
32 maximum :: (Foldable f, Ord a) => term (f a) -> term a
33 elem :: (Foldable f, Eq a) => term a -> term (f a) -> term Bool
34 sum :: (Foldable f, Num a) => term (f a) -> term a
35 product :: (Foldable f, Num a) => term (f a) -> term a
36 toList :: Foldable f => term (f a) -> term [a]
37 all :: Foldable f => term (a -> Bool) -> term (f a) -> term Bool
38 and :: Foldable f => term (f Bool) -> term Bool
39 any :: Foldable f => term (a -> Bool) -> term (f a) -> term Bool
40 concat :: Foldable f => term (f [a]) -> term [a]
41 concatMap :: Foldable f => term (a -> [b]) -> term (f a) -> term [b]
42 find :: Foldable f => term (a -> Bool) -> term (f a) -> term (Maybe a)
43 foldlM :: (Foldable f, Monad m) => term (b -> a -> m b) -> term b -> term (f a) -> term (m b)
44 foldrM :: (Foldable f, Monad m) => term (a -> b -> m b) -> term b -> term (f a) -> term (m b)
45 forM_ :: (Foldable f, Monad m) => term (f a) -> term (a -> m b) -> term (m ())
46 for_ :: (Foldable f, Applicative p) => term (f a) -> term (a -> p b) -> term (p ())
47 mapM_ :: (Foldable f, Monad m) => term (a -> m b) -> term (f a) -> term (m ())
48 maximumBy :: Foldable f => term (a -> a -> Ordering) -> term (f a) -> term a
49 minimumBy :: Foldable f => term (a -> a -> Ordering) -> term (f a) -> term a
50 notElem :: (Foldable f, Eq a) => term a -> term (f a) -> term Bool
51 or :: Foldable f => term (f Bool) -> term Bool
52 sequenceA_ :: (Foldable f, Applicative p) => term (f (p a)) -> term (p ())
53 sequence_ :: (Foldable f, Monad m) => term (f (m a)) -> term (m ())
54 traverse_ :: (Foldable f, Applicative p) => term (a -> p b) -> term (f a) -> term (p ())
55 -- asum :: (Foldable t, GHC.Base.Alternative f) => t (f a) -> f a
56 -- msum :: (Foldable t, GHC.Base.MonadPlus m) => t (m a) -> m a
57
58 default foldMap :: (Trans t term, Foldable f, Monoid m) => t term (a -> m) -> t term (f a) -> t term m
59 default foldr :: (Trans t term, Foldable f) => t term (a -> b -> b) -> t term b -> t term (f a) -> t term b
60 default foldr' :: (Trans t term, Foldable f) => t term (a -> b -> b) -> t term b -> t term (f a) -> t term b
61 default foldl :: (Trans t term, Foldable f) => t term (b -> a -> b) -> t term b -> t term (f a) -> t term b
62 default foldl' :: (Trans t term, Foldable f) => t term (b -> a -> b) -> t term b -> t term (f a) -> t term b
63 default length :: (Trans t term, Foldable f) => t term (f a) -> t term Int
64 default null :: (Trans t term, Foldable f) => t term (f a) -> t term Bool
65 default minimum :: (Trans t term, Foldable f, Ord a) => t term (f a) -> t term a
66 default maximum :: (Trans t term, Foldable f, Ord a) => t term (f a) -> t term a
67 default elem :: (Trans t term, Foldable f, Eq a) => t term a -> t term (f a) -> t term Bool
68 default sum :: (Trans t term, Foldable f, Num a) => t term (f a) -> t term a
69 default product :: (Trans t term, Foldable f, Num a) => t term (f a) -> t term a
70 default toList :: (Trans t term, Foldable f) => t term (f a) -> t term [a]
71 default all :: (Trans t term, Foldable f) => t term (a -> Bool) -> t term (f a) -> t term Bool
72 default and :: (Trans t term, Foldable f) => t term (f Bool) -> t term Bool
73 default any :: (Trans t term, Foldable f) => t term (a -> Bool) -> t term (f a) -> t term Bool
74 default concat :: (Trans t term, Foldable f) => t term (f [a]) -> t term [a]
75 default concatMap :: (Trans t term, Foldable f) => t term (a -> [b]) -> t term (f a) -> t term [b]
76 default find :: (Trans t term, Foldable f) => t term (a -> Bool) -> t term (f a) -> t term (Maybe a)
77 default foldlM :: (Trans t term, Foldable f, Monad m) => t term (b -> a -> m b) -> t term b -> t term (f a) -> t term (m b)
78 default foldrM :: (Trans t term, Foldable f, Monad m) => t term (a -> b -> m b) -> t term b -> t term (f a) -> t term (m b)
79 default forM_ :: (Trans t term, Foldable f, Monad m) => t term (f a) -> t term (a -> m b) -> t term (m ())
80 default for_ :: (Trans t term, Foldable f, Applicative p) => t term (f a) -> t term (a -> p b) -> t term (p ())
81 default mapM_ :: (Trans t term, Foldable f, Monad m) => t term (a -> m b) -> t term (f a) -> t term (m ())
82 default maximumBy :: (Trans t term, Foldable f) => t term (a -> a -> Ordering) -> t term (f a) -> t term a
83 default minimumBy :: (Trans t term, Foldable f) => t term (a -> a -> Ordering) -> t term (f a) -> t term a
84 default notElem :: (Trans t term, Foldable f, Eq a) => t term a -> t term (f a) -> t term Bool
85 default or :: (Trans t term, Foldable f) => t term (f Bool) -> t term Bool
86 default sequenceA_ :: (Trans t term, Foldable f, Applicative p) => t term (f (p a)) -> t term (p ())
87 default sequence_ :: (Trans t term, Foldable f, Monad m) => t term (f (m a)) -> t term (m ())
88 default traverse_ :: (Trans t term, Foldable f, Applicative p) => t term (a -> p b) -> t term (f a) -> t term (p ())
89
90 foldMap = trans_map2 foldMap
91 foldr = trans_map3 foldr
92 foldr' = trans_map3 foldr'
93 foldl = trans_map3 foldl
94 foldl' = trans_map3 foldl'
95 length = trans_map1 length
96 null = trans_map1 null
97 minimum = trans_map1 minimum
98 maximum = trans_map1 maximum
99 elem = trans_map2 elem
100 sum = trans_map1 sum
101 product = trans_map1 product
102 toList = trans_map1 toList
103 all = trans_map2 all
104 and = trans_map1 and
105 any = trans_map2 any
106 concat = trans_map1 concat
107 concatMap = trans_map2 concatMap
108 find = trans_map2 find
109 foldlM = trans_map3 foldlM
110 foldrM = trans_map3 foldrM
111 forM_ = trans_map2 forM_
112 for_ = trans_map2 for_
113 mapM_ = trans_map2 mapM_
114 maximumBy = trans_map2 maximumBy
115 minimumBy = trans_map2 minimumBy
116 notElem = trans_map2 notElem
117 or = trans_map1 or
118 sequenceA_ = trans_map1 sequenceA_
119 sequence_ = trans_map1 sequence_
120 traverse_ = trans_map2 traverse_
121
122 type instance Sym_of_Iface (Proxy Foldable) = Sym_Foldable
123 type instance Consts_of_Iface (Proxy Foldable) = Proxy Foldable ': Consts_imported_by Foldable
124 type instance Consts_imported_by Foldable = '[]
125
126 instance Sym_Foldable HostI where
127 foldMap = liftM2 Foldable.foldMap
128 foldr = liftM3 Foldable.foldr
129 foldr' = liftM3 Foldable.foldr'
130 foldl = liftM3 Foldable.foldl
131 foldl' = liftM3 Foldable.foldl'
132 null = liftM Foldable.null
133 length = liftM Foldable.length
134 minimum = liftM Foldable.minimum
135 maximum = liftM Foldable.maximum
136 elem = liftM2 Foldable.elem
137 sum = liftM Foldable.sum
138 product = liftM Foldable.product
139 toList = liftM Foldable.toList
140 all = liftM2 Foldable.all
141 and = liftM Foldable.and
142 any = liftM2 Foldable.any
143 concat = liftM Foldable.concat
144 concatMap = liftM2 Foldable.concatMap
145 find = liftM2 Foldable.find
146 foldlM = liftM3 Foldable.foldlM
147 foldrM = liftM3 Foldable.foldrM
148 forM_ = liftM2 Foldable.forM_
149 for_ = liftM2 Foldable.for_
150 mapM_ = liftM2 Foldable.mapM_
151 maximumBy = liftM2 Foldable.maximumBy
152 minimumBy = liftM2 Foldable.minimumBy
153 notElem = liftM2 Foldable.notElem
154 or = liftM Foldable.or
155 sequenceA_ = liftM Foldable.sequenceA_
156 sequence_ = liftM Foldable.sequence_
157 traverse_ = liftM2 Foldable.traverse_
158 instance Sym_Foldable TextI where
159 foldMap = textI_app2 "foldMap"
160 foldr = textI_app3 "foldr"
161 foldr' = textI_app3 "foldr'"
162 foldl = textI_app3 "foldl"
163 foldl' = textI_app3 "foldl'"
164 null = textI_app1 "null"
165 length = textI_app1 "length"
166 minimum = textI_app1 "minimum"
167 maximum = textI_app1 "maximum"
168 elem = textI_app2 "elem"
169 sum = textI_app1 "sum"
170 product = textI_app1 "product"
171 toList = textI_app1 "toList"
172 all = textI_app2 "all"
173 and = textI_app1 "and"
174 any = textI_app2 "any"
175 concat = textI_app1 "concat"
176 concatMap = textI_app2 "concatMap"
177 find = textI_app2 "find"
178 foldlM = textI_app3 "foldlM"
179 foldrM = textI_app3 "foldrM"
180 forM_ = textI_app2 "forM_"
181 for_ = textI_app2 "for_"
182 mapM_ = textI_app2 "mapM_"
183 maximumBy = textI_app2 "maximumBy"
184 minimumBy = textI_app2 "minimumBy"
185 notElem = textI_app2 "notElem"
186 or = textI_app1 "or"
187 sequenceA_ = textI_app1 "sequenceA_"
188 sequence_ = textI_app1 "sequence_"
189 traverse_ = textI_app2 "traverse_"
190 instance (Sym_Foldable r1, Sym_Foldable r2) => Sym_Foldable (DupI r1 r2) where
191 foldMap = dupI2 (Proxy @Sym_Foldable) foldMap
192 foldr = dupI3 (Proxy @Sym_Foldable) foldr
193 foldr' = dupI3 (Proxy @Sym_Foldable) foldr'
194 foldl = dupI3 (Proxy @Sym_Foldable) foldl
195 foldl' = dupI3 (Proxy @Sym_Foldable) foldl'
196 null = dupI1 (Proxy @Sym_Foldable) null
197 length = dupI1 (Proxy @Sym_Foldable) length
198 minimum = dupI1 (Proxy @Sym_Foldable) minimum
199 maximum = dupI1 (Proxy @Sym_Foldable) maximum
200 elem = dupI2 (Proxy @Sym_Foldable) elem
201 sum = dupI1 (Proxy @Sym_Foldable) sum
202 product = dupI1 (Proxy @Sym_Foldable) product
203 toList = dupI1 (Proxy @Sym_Foldable) toList
204 all = dupI2 (Proxy @Sym_Foldable) all
205 and = dupI1 (Proxy @Sym_Foldable) and
206 any = dupI2 (Proxy @Sym_Foldable) any
207 concat = dupI1 (Proxy @Sym_Foldable) concat
208 concatMap = dupI2 (Proxy @Sym_Foldable) concatMap
209 find = dupI2 (Proxy @Sym_Foldable) find
210 foldlM = dupI3 (Proxy @Sym_Foldable) foldlM
211 foldrM = dupI3 (Proxy @Sym_Foldable) foldrM
212 forM_ = dupI2 (Proxy @Sym_Foldable) forM_
213 for_ = dupI2 (Proxy @Sym_Foldable) for_
214 mapM_ = dupI2 (Proxy @Sym_Foldable) mapM_
215 maximumBy = dupI2 (Proxy @Sym_Foldable) maximumBy
216 minimumBy = dupI2 (Proxy @Sym_Foldable) minimumBy
217 notElem = dupI2 (Proxy @Sym_Foldable) notElem
218 or = dupI1 (Proxy @Sym_Foldable) or
219 sequenceA_ = dupI1 (Proxy @Sym_Foldable) sequenceA_
220 sequence_ = dupI1 (Proxy @Sym_Foldable) sequence_
221 traverse_ = dupI2 (Proxy @Sym_Foldable) traverse_
222
223 instance Const_from Text cs => Const_from Text (Proxy Foldable ': cs) where
224 const_from "Foldable" k = k (ConstZ kind)
225 const_from s k = const_from s $ k . ConstS
226 instance Show_Const cs => Show_Const (Proxy Foldable ': cs) where
227 show_const ConstZ{} = "Foldable"
228 show_const (ConstS c) = show_const c
229
230 instance Proj_ConC cs (Proxy Foldable)
231 data instance TokenT meta (ts::[*]) (Proxy Foldable)
232 = Token_Term_Foldable_foldMap (EToken meta ts) (EToken meta ts)
233 | Token_Term_Foldable_foldr (EToken meta ts) (EToken meta ts) (EToken meta ts)
234 | Token_Term_Foldable_foldr' (EToken meta ts) (EToken meta ts) (EToken meta ts)
235 | Token_Term_Foldable_foldl (EToken meta ts) (EToken meta ts) (EToken meta ts)
236 | Token_Term_Foldable_elem (EToken meta ts) (EToken meta ts)
237 | Token_Term_Foldable_null (EToken meta ts)
238 | Token_Term_Foldable_length (EToken meta ts)
239 | Token_Term_Foldable_minimum (EToken meta ts)
240 | Token_Term_Foldable_maximum (EToken meta ts)
241 | Token_Term_Foldable_sum (EToken meta ts)
242 | Token_Term_Foldable_product (EToken meta ts)
243 | Token_Term_Foldable_toList (EToken meta ts)
244 | Token_Term_Foldable_all (EToken meta ts) (EToken meta ts)
245 | Token_Term_Foldable_any (EToken meta ts) (EToken meta ts)
246 | Token_Term_Foldable_and (EToken meta ts)
247 | Token_Term_Foldable_or (EToken meta ts)
248 | Token_Term_Foldable_concat (EToken meta ts)
249 deriving instance Eq_Token meta ts => Eq (TokenT meta ts (Proxy Foldable))
250 deriving instance Show_Token meta ts => Show (TokenT meta ts (Proxy Foldable))
251 instance -- Term_fromI
252 ( Inj_Const (Consts_of_Ifaces is) Foldable
253 , Inj_Const (Consts_of_Ifaces is) Monoid
254 , Inj_Const (Consts_of_Ifaces is) (->)
255 , Inj_Const (Consts_of_Ifaces is) Int
256 , Inj_Const (Consts_of_Ifaces is) Bool
257 , Inj_Const (Consts_of_Ifaces is) Eq
258 , Inj_Const (Consts_of_Ifaces is) Ord
259 , Inj_Const (Consts_of_Ifaces is) Num
260 , Inj_Const (Consts_of_Ifaces is) []
261 , Proj_Con (Consts_of_Ifaces is)
262 , Term_from is
263 ) => Term_fromI is (Proxy Foldable) where
264 term_fromI
265 :: forall meta ctx ret ls rs.
266 TokenT meta is (Proxy Foldable)
267 -> Term_fromT meta ctx ret is ls (Proxy Foldable ': rs)
268 term_fromI tok ctx k =
269 case tok of
270 Token_Term_Foldable_foldMap tok_a2m tok_ta ->
271 -- foldMap :: (Foldable t, Monoid m) => (a -> m) -> t a -> m
272 term_from tok_a2m ctx $ \ty_a2m (TermLC a2m) ->
273 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
274 check_type2 (ty @(->)) (At (Just tok_a2m) ty_a2m) $ \Refl ty_a2m_a ty_a2m_m ->
275 check_con (At (Just tok_a2m) (ty @Monoid :$ ty_a2m_m)) $ \Con ->
276 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t ty_ta_a ->
277 check_type
278 (At (Just tok_a2m) ty_a2m_a)
279 (At (Just tok_ta) ty_ta_a) $ \Refl ->
280 k ty_a2m_m $ TermLC $
281 \c -> foldMap (a2m c) (ta c)
282 Token_Term_Foldable_foldr tok_a2b2b tok_b tok_ta -> foldr_from tok_a2b2b tok_b tok_ta foldr
283 Token_Term_Foldable_foldr' tok_a2b2b tok_b tok_ta -> foldr_from tok_a2b2b tok_b tok_ta foldr'
284 Token_Term_Foldable_foldl tok_b2a2b tok_b tok_ta -> foldl_from tok_b2a2b tok_b tok_ta foldl
285 Token_Term_Foldable_elem tok_a tok_ta ->
286 -- elem :: (Foldable t, Eq a) => a -> t a -> Bool
287 term_from tok_a ctx $ \ty_a (TermLC a) ->
288 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
289 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t ty_ta_a ->
290 check_con (At (Just tok_ta) (ty @Eq :$ ty_ta_a)) $ \Con ->
291 check_type
292 (At (Just tok_a) ty_a)
293 (At (Just tok_ta) ty_ta_a) $ \Refl ->
294 k (ty @Bool) $ TermLC $
295 \c -> a c `elem` ta c
296 Token_Term_Foldable_null tok_ta -> ta2ty_from tok_ta null
297 Token_Term_Foldable_length tok_ta -> ta2ty_from tok_ta length
298 Token_Term_Foldable_minimum tok_ta -> ta2a_from tok_ta (ty @Ord) minimum
299 Token_Term_Foldable_maximum tok_ta -> ta2a_from tok_ta (ty @Ord) maximum
300 Token_Term_Foldable_sum tok_ta -> ta2a_from tok_ta (ty @Num) sum
301 Token_Term_Foldable_product tok_ta -> ta2a_from tok_ta (ty @Num) product
302 Token_Term_Foldable_toList tok_ta ->
303 -- toList :: Foldable t => t a -> [a]
304 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
305 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t ty_ta_a ->
306 k (ty @[] :$ ty_ta_a) $ TermLC $
307 \c -> toList (ta c)
308 Token_Term_Foldable_all tok_a2Bool tok_ta -> allany_from tok_a2Bool tok_ta all
309 Token_Term_Foldable_any tok_a2Bool tok_ta -> allany_from tok_a2Bool tok_ta any
310 Token_Term_Foldable_and tok_tBool -> andor_from tok_tBool and
311 Token_Term_Foldable_or tok_tBool -> andor_from tok_tBool or
312 Token_Term_Foldable_concat tok_tla ->
313 -- concat :: Foldable t => t [a] -> [a]
314 term_from tok_tla ctx $ \ty_tla (TermLC tla) ->
315 check_con1 (ty @Foldable) (At (Just tok_tla) ty_tla) $ \Refl Con _ty_tla_t ty_tla_la ->
316 check_type1 (ty @[]) (At (Just tok_tla) ty_tla_la) $ \Refl ty_tla_la_a ->
317 k (ty @[] :$ ty_tla_la_a) $ TermLC $
318 \c -> concat (tla c)
319 where
320 foldr_from tok_a2b2b tok_b tok_ta
321 (fold::forall term f a b.
322 (Sym_Foldable term, Foldable f)
323 => term (a -> b -> b) -> term b -> term (f a) -> term b) =
324 -- foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
325 -- foldr' :: Foldable t => (a -> b -> b) -> b -> t a -> b
326 term_from tok_a2b2b ctx $ \ty_a2b2b (TermLC a2b2b) ->
327 term_from tok_b ctx $ \ty_b (TermLC b) ->
328 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
329 check_type2 (ty @(->)) (At (Just tok_a2b2b) ty_a2b2b) $ \Refl ty_a2b2b_a ty_a2b2b_b2b ->
330 check_type2 (ty @(->)) (At (Just tok_a2b2b) ty_a2b2b_b2b) $ \Refl ty_a2b2b_b2b_b0 ty_a2b2b_b2b_b1 ->
331 check_type
332 (At (Just tok_a2b2b) ty_a2b2b_b2b_b0)
333 (At (Just tok_a2b2b) ty_a2b2b_b2b_b1) $ \Refl ->
334 check_type
335 (At (Just tok_a2b2b) ty_a2b2b_b2b_b0)
336 (At (Just tok_b) ty_b) $ \Refl ->
337 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t ty_ta_a ->
338 check_type
339 (At (Just tok_a2b2b) ty_a2b2b_a)
340 (At (Just tok_ta) ty_ta_a) $ \Refl ->
341 k ty_b $ TermLC $
342 \c -> fold (a2b2b c) (b c) (ta c)
343 foldl_from tok_b2a2b tok_b tok_ta
344 (fold::forall term f a b.
345 (Sym_Foldable term, Foldable f)
346 => term (b -> a -> b) -> term b -> term (f a) -> term b) =
347 -- foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b
348 term_from tok_b2a2b ctx $ \ty_b2a2b (TermLC b2a2b) ->
349 term_from tok_b ctx $ \ty_b (TermLC b) ->
350 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
351 check_type2 (ty @(->)) (At (Just tok_b2a2b) ty_b2a2b) $ \Refl ty_b2a2b_b ty_b2a2b_a2b ->
352 check_type2 (ty @(->)) (At (Just tok_b2a2b) ty_b2a2b_a2b) $ \Refl ty_b2a2b_a2b_a ty_b2a2b_a2b_b ->
353 check_type
354 (At (Just tok_b2a2b) ty_b2a2b_b)
355 (At (Just tok_b2a2b) ty_b2a2b_a2b_b) $ \Refl ->
356 check_type
357 (At (Just tok_b2a2b) ty_b2a2b_b)
358 (At (Just tok_b) ty_b) $ \Refl ->
359 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t ty_ta_a ->
360 check_type
361 (At (Just tok_b2a2b) ty_b2a2b_a2b_a)
362 (At (Just tok_ta) ty_ta_a) $ \Refl ->
363 k ty_b $ TermLC $
364 \c -> fold (b2a2b c) (b c) (ta c)
365 ta2ty_from
366 :: forall typ. Inj_Const (Consts_of_Ifaces is) typ
367 => EToken meta is
368 -> (forall term t a. (Sym_Foldable term, Foldable t) => term (t a) -> term typ)
369 -> Either (Error_Term meta is) ret
370 ta2ty_from tok_ta f =
371 -- length :: Foldable t => t a -> Int
372 -- null :: Foldable t => t a -> Bool
373 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
374 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t _ty_ta_a ->
375 k (TyConst inj_const::Type (Consts_of_Ifaces is) typ) $ TermLC $
376 \c -> f (ta c)
377 ta2a_from
378 :: forall con.
379 EToken meta is
380 -> Type (Consts_of_Ifaces is) con
381 -> (forall term t a. (Sym_Foldable term, Foldable t, con a) => term (t a) -> term a)
382 -> Either (Error_Term meta is) ret
383 ta2a_from tok_ta q f =
384 -- minimum :: (Foldable t, Ord a) => t a -> a
385 -- maximum :: (Foldable t, Ord a) => t a -> a
386 -- sum :: (Foldable t, Num a) => t a -> a
387 -- product :: (Foldable t, Num a) => t a -> a
388 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
389 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t ty_ta_a ->
390 check_con (At (Just tok_ta) (q :$ ty_ta_a)) $ \Con ->
391 k ty_ta_a $ TermLC $
392 \c -> f (ta c)
393 allany_from tok_a2Bool tok_ta
394 (g::forall term f a.
395 (Sym_Foldable term, Foldable f)
396 => term (a -> Bool) -> term (f a) -> term Bool) =
397 -- all :: Foldable t => (a -> Bool) -> t a -> Bool
398 -- any :: Foldable t => (a -> Bool) -> t a -> Bool
399 term_from tok_a2Bool ctx $ \ty_a2Bool (TermLC a2Bool) ->
400 term_from tok_ta ctx $ \ty_ta (TermLC ta) ->
401 check_type2 (ty @(->)) (At (Just tok_a2Bool) ty_a2Bool) $ \Refl ty_a2Bool_a ty_a2Bool_Bool ->
402 check_con1 (ty @Foldable) (At (Just tok_ta) ty_ta) $ \Refl Con _ty_ta_t ty_ta_a ->
403 check_type
404 (At (Just tok_a2Bool) ty_a2Bool_a)
405 (At (Just tok_ta) ty_ta_a) $ \Refl ->
406 check_type
407 (At Nothing (ty @Bool))
408 (At (Just tok_a2Bool) ty_a2Bool_Bool) $ \Refl ->
409 k (ty @Bool) $ TermLC $
410 \c -> g (a2Bool c) (ta c)
411 andor_from tok_tBool
412 (g::forall term f.
413 (Sym_Foldable term, Foldable f)
414 => term (f Bool) -> term Bool) =
415 -- and :: Foldable t => t Bool -> Bool
416 -- or :: Foldable t => t Bool -> Bool
417 term_from tok_tBool ctx $ \ty_tBool (TermLC tBool) ->
418 check_con1 (ty @Foldable) (At (Just tok_tBool) ty_tBool) $ \Refl Con _ty_tBool_t ty_tBool_Bool ->
419 check_type
420 (At Nothing (ty @Bool))
421 (At (Just tok_tBool) ty_tBool_Bool) $ \Refl ->
422 k (ty @Bool) $ TermLC $
423 \c -> g (tBool c)