49 (* singleton inductive, whose constructor was mk_universe *)
51 (** val universe_rect_Type4 :
52 PreIdentifiers.identifierTag -> (Positive.pos -> 'a1) -> universe -> 'a1 **)
53 let rec universe_rect_Type4 tag h_mk_universe x_3239 =
54 let next_identifier = x_3239 in h_mk_universe next_identifier
56 (** val universe_rect_Type5 :
57 PreIdentifiers.identifierTag -> (Positive.pos -> 'a1) -> universe -> 'a1 **)
58 let rec universe_rect_Type5 tag h_mk_universe x_3241 =
59 let next_identifier = x_3241 in h_mk_universe next_identifier
61 (** val universe_rect_Type3 :
62 PreIdentifiers.identifierTag -> (Positive.pos -> 'a1) -> universe -> 'a1 **)
63 let rec universe_rect_Type3 tag h_mk_universe x_3243 =
64 let next_identifier = x_3243 in h_mk_universe next_identifier
66 (** val universe_rect_Type2 :
67 PreIdentifiers.identifierTag -> (Positive.pos -> 'a1) -> universe -> 'a1 **)
68 let rec universe_rect_Type2 tag h_mk_universe x_3245 =
69 let next_identifier = x_3245 in h_mk_universe next_identifier
71 (** val universe_rect_Type1 :
72 PreIdentifiers.identifierTag -> (Positive.pos -> 'a1) -> universe -> 'a1 **)
73 let rec universe_rect_Type1 tag h_mk_universe x_3247 =
74 let next_identifier = x_3247 in h_mk_universe next_identifier
76 (** val universe_rect_Type0 :
77 PreIdentifiers.identifierTag -> (Positive.pos -> 'a1) -> universe -> 'a1 **)
78 let rec universe_rect_Type0 tag h_mk_universe x_3249 =
79 let next_identifier = x_3249 in h_mk_universe next_identifier
81 (** val next_identifier :
82 PreIdentifiers.identifierTag -> universe -> Positive.pos **)
83 let rec next_identifier tag xxx =
86 (** val universe_inv_rect_Type4 :
87 PreIdentifiers.identifierTag -> universe -> (Positive.pos -> __ -> 'a1)
89 let universe_inv_rect_Type4 x1 hterm h1 =
90 let hcut = universe_rect_Type4 x1 h1 hterm in hcut __
92 (** val universe_inv_rect_Type3 :
93 PreIdentifiers.identifierTag -> universe -> (Positive.pos -> __ -> 'a1)
95 let universe_inv_rect_Type3 x1 hterm h1 =
96 let hcut = universe_rect_Type3 x1 h1 hterm in hcut __
98 (** val universe_inv_rect_Type2 :
99 PreIdentifiers.identifierTag -> universe -> (Positive.pos -> __ -> 'a1)
101 let universe_inv_rect_Type2 x1 hterm h1 =
102 let hcut = universe_rect_Type2 x1 h1 hterm in hcut __
104 (** val universe_inv_rect_Type1 :
105 PreIdentifiers.identifierTag -> universe -> (Positive.pos -> __ -> 'a1)
107 let universe_inv_rect_Type1 x1 hterm h1 =
108 let hcut = universe_rect_Type1 x1 h1 hterm in hcut __
110 (** val universe_inv_rect_Type0 :
111 PreIdentifiers.identifierTag -> universe -> (Positive.pos -> __ -> 'a1)
113 let universe_inv_rect_Type0 x1 hterm h1 =
114 let hcut = universe_rect_Type0 x1 h1 hterm in hcut __
116 (** val universe_discr :
117 PreIdentifiers.identifierTag -> universe -> universe -> __ **)
118 let universe_discr a1 x y =
119 Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y
121 (** val universe_jmdiscr :
122 PreIdentifiers.identifierTag -> universe -> universe -> __ **)
123 let universe_jmdiscr a1 x y =
124 Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y
126 (** val new_universe : PreIdentifiers.identifierTag -> universe **)
127 let new_universe tag =
131 PreIdentifiers.identifierTag -> universe -> (PreIdentifiers.identifier,
132 universe) Types.prod **)
133 let rec fresh tag u =
134 let id = next_identifier tag u in
135 { Types.fst = id; Types.snd = (Positive.succ id) }
137 (** val eq_identifier :
138 PreIdentifiers.identifierTag -> PreIdentifiers.identifier ->
139 PreIdentifiers.identifier -> Bool.bool **)
140 let eq_identifier t l r =
141 let l' = l in let r' = r in Positive.eqb l' r'
143 (** val eq_identifier_elim :
144 PreIdentifiers.identifierTag -> PreIdentifiers.identifier ->
145 PreIdentifiers.identifier -> (__ -> 'a1) -> (__ -> 'a1) -> 'a1 **)
146 let eq_identifier_elim t clearme =
150 (fun t0 f -> Positive.eqb_elim x y (fun _ -> t0 __) (fun _ -> f __)))
154 (** val deq_identifier : PreIdentifiers.identifierTag -> Deqsets.deqSet **)
155 let deq_identifier tag =
156 Obj.magic (eq_identifier tag)
158 (** val word_of_identifier :
159 PreIdentifiers.identifierTag -> PreIdentifiers.identifier -> Positive.pos **)
160 let word_of_identifier t l =
163 (** val identifier_eq :
164 PreIdentifiers.identifierTag -> PreIdentifiers.identifier ->
165 PreIdentifiers.identifier -> (__, __) Types.sum **)
166 let identifier_eq tag clearme =
170 (match Positive.eqb x y with
171 | Bool.True -> (fun _ -> Types.Inl __)
172 | Bool.False -> (fun _ -> Types.Inr __)) __)
174 (** val identifier_of_nat :
175 PreIdentifiers.identifierTag -> Nat.nat -> PreIdentifiers.identifier **)
176 let identifier_of_nat tag n =
177 Positive.succ_pos_of_nat n
179 (** val check_member_env :
180 PreIdentifiers.identifierTag -> PreIdentifiers.identifier ->
181 (PreIdentifiers.identifier, 'a1) Types.prod List.list -> __ Errors.res **)
182 let rec check_member_env tag id = function
183 | List.Nil -> Errors.OK __
184 | List.Cons (hd, tl) ->
185 (match identifier_eq tag id hd.Types.fst with
187 Errors.Error (List.Cons ((Errors.MSG ErrorMessages.DuplicateVariable),
188 (List.Cons ((Errors.CTX (tag, id)), List.Nil))))
191 (Monad.m_bind0 (Monad.max_def Errors.res0)
192 (Obj.magic (check_member_env tag id tl)) (fun _ ->
193 Obj.magic (Errors.OK __))))
195 (** val check_distinct_env :
196 PreIdentifiers.identifierTag -> (PreIdentifiers.identifier, 'a1)
197 Types.prod List.list -> __ Errors.res **)
198 let rec check_distinct_env tag = function
199 | List.Nil -> Errors.OK __
200 | List.Cons (hd, tl) ->
202 (Monad.m_bind0 (Monad.max_def Errors.res0)
203 (Obj.magic (check_member_env tag hd.Types.fst tl)) (fun _ ->
204 Monad.m_bind0 (Monad.max_def Errors.res0)
205 (Obj.magic (check_distinct_env tag tl)) (fun _ ->
206 Obj.magic (Errors.OK __))))
210 type 'a identifier_map =
211 'a PositiveMap.positive_map
212 (* singleton inductive, whose constructor was an_id_map *)
214 (** val identifier_map_rect_Type4 :
215 PreIdentifiers.identifierTag -> ('a1 PositiveMap.positive_map -> 'a2) ->
216 'a1 identifier_map -> 'a2 **)
217 let rec identifier_map_rect_Type4 tag h_an_id_map x_3411 =
218 let x_3412 = x_3411 in h_an_id_map x_3412
220 (** val identifier_map_rect_Type5 :
221 PreIdentifiers.identifierTag -> ('a1 PositiveMap.positive_map -> 'a2) ->
222 'a1 identifier_map -> 'a2 **)
223 let rec identifier_map_rect_Type5 tag h_an_id_map x_3414 =
224 let x_3415 = x_3414 in h_an_id_map x_3415
226 (** val identifier_map_rect_Type3 :
227 PreIdentifiers.identifierTag -> ('a1 PositiveMap.positive_map -> 'a2) ->
228 'a1 identifier_map -> 'a2 **)
229 let rec identifier_map_rect_Type3 tag h_an_id_map x_3417 =
230 let x_3418 = x_3417 in h_an_id_map x_3418
232 (** val identifier_map_rect_Type2 :
233 PreIdentifiers.identifierTag -> ('a1 PositiveMap.positive_map -> 'a2) ->
234 'a1 identifier_map -> 'a2 **)
235 let rec identifier_map_rect_Type2 tag h_an_id_map x_3420 =
236 let x_3421 = x_3420 in h_an_id_map x_3421
238 (** val identifier_map_rect_Type1 :
239 PreIdentifiers.identifierTag -> ('a1 PositiveMap.positive_map -> 'a2) ->
240 'a1 identifier_map -> 'a2 **)
241 let rec identifier_map_rect_Type1 tag h_an_id_map x_3423 =
242 let x_3424 = x_3423 in h_an_id_map x_3424
244 (** val identifier_map_rect_Type0 :
245 PreIdentifiers.identifierTag -> ('a1 PositiveMap.positive_map -> 'a2) ->
246 'a1 identifier_map -> 'a2 **)
247 let rec identifier_map_rect_Type0 tag h_an_id_map x_3426 =
248 let x_3427 = x_3426 in h_an_id_map x_3427
250 (** val identifier_map_inv_rect_Type4 :
251 PreIdentifiers.identifierTag -> 'a1 identifier_map -> ('a1
252 PositiveMap.positive_map -> __ -> 'a2) -> 'a2 **)
253 let identifier_map_inv_rect_Type4 x1 hterm h1 =
254 let hcut = identifier_map_rect_Type4 x1 h1 hterm in hcut __
256 (** val identifier_map_inv_rect_Type3 :
257 PreIdentifiers.identifierTag -> 'a1 identifier_map -> ('a1
258 PositiveMap.positive_map -> __ -> 'a2) -> 'a2 **)
259 let identifier_map_inv_rect_Type3 x1 hterm h1 =
260 let hcut = identifier_map_rect_Type3 x1 h1 hterm in hcut __
262 (** val identifier_map_inv_rect_Type2 :
263 PreIdentifiers.identifierTag -> 'a1 identifier_map -> ('a1
264 PositiveMap.positive_map -> __ -> 'a2) -> 'a2 **)
265 let identifier_map_inv_rect_Type2 x1 hterm h1 =
266 let hcut = identifier_map_rect_Type2 x1 h1 hterm in hcut __
268 (** val identifier_map_inv_rect_Type1 :
269 PreIdentifiers.identifierTag -> 'a1 identifier_map -> ('a1
270 PositiveMap.positive_map -> __ -> 'a2) -> 'a2 **)
271 let identifier_map_inv_rect_Type1 x1 hterm h1 =
272 let hcut = identifier_map_rect_Type1 x1 h1 hterm in hcut __
274 (** val identifier_map_inv_rect_Type0 :
275 PreIdentifiers.identifierTag -> 'a1 identifier_map -> ('a1
276 PositiveMap.positive_map -> __ -> 'a2) -> 'a2 **)
277 let identifier_map_inv_rect_Type0 x1 hterm h1 =
278 let hcut = identifier_map_rect_Type0 x1 h1 hterm in hcut __
280 (** val identifier_map_discr :
281 PreIdentifiers.identifierTag -> 'a1 identifier_map -> 'a1 identifier_map
283 let identifier_map_discr a1 x y =
284 Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y
286 (** val identifier_map_jmdiscr :
287 PreIdentifiers.identifierTag -> 'a1 identifier_map -> 'a1 identifier_map
289 let identifier_map_jmdiscr a1 x y =
290 Logic.eq_rect_Type2 x (let a0 = x in Obj.magic (fun _ dH -> dH __)) y
292 (** val empty_map : PreIdentifiers.identifierTag -> 'a1 identifier_map **)
297 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
298 PreIdentifiers.identifier -> 'a1 Types.option **)
299 let rec lookup tag m l =
300 PositiveMap.lookup_opt (let l' = l in l') (let m' = m in m')
303 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
304 PreIdentifiers.identifier -> 'a1 -> 'a1 **)
305 let lookup_def tag m l d =
306 match lookup tag m l with
311 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
312 PreIdentifiers.identifier -> Bool.bool **)
314 match lookup tag m l with
315 | Types.None -> Bool.False
316 | Types.Some x -> Bool.True
318 (** val lookup_safe :
319 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
320 PreIdentifiers.identifier -> 'a1 **)
321 let lookup_safe tag m i =
322 (match lookup tag m i with
323 | Types.None -> (fun _ -> assert false (* absurd case *))
324 | Types.Some x -> (fun _ -> x)) __
327 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
328 PreIdentifiers.identifier -> 'a1 -> 'a1 identifier_map **)
329 let rec add tag m l a =
330 PositiveMap.insert (let l' = l in l') a (let m' = m in m')
333 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
334 (PreIdentifiers.identifier, 'a1) Types.prod List.list **)
336 PositiveMap.fold (fun l a el -> List.Cons ({ Types.fst = l; Types.snd =
337 a }, el)) (let m' = m in m') List.Nil
340 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
341 (PreIdentifiers.identifier -> 'a1 -> __ -> Bool.bool) -> Bool.bool **)
342 let idmap_all tag m f =
343 PositiveMap.pm_all (let m' = m in m') (fun p a _ -> f p a __)
346 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
347 PreIdentifiers.identifier -> 'a1 -> 'a1 identifier_map Errors.res **)
348 let update tag m l a =
349 match PositiveMap.update (let l' = l in l') a (let m' = m in m') with
351 Errors.Error (List.Cons ((Errors.MSG ErrorMessages.MissingId), (List.Cons
352 ((Errors.CTX (tag, l)), List.Nil))))
353 | Types.Some m' -> Errors.OK m'
356 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
357 PreIdentifiers.identifier -> 'a1 identifier_map **)
358 let remove tag m id =
359 PositiveMap.pm_set (let p = id in p) Types.None (let m0 = m in m0)
362 PreIdentifiers.identifierTag -> (PreIdentifiers.identifier -> 'a1 -> 'a2
363 -> 'a2) -> 'a1 identifier_map -> 'a2 -> 'a2 **)
364 let foldi tag f m b =
365 let m' = m in PositiveMap.fold (fun bv -> f bv) m' b
368 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
369 (PreIdentifiers.identifier -> 'a1 -> __ -> 'a2 -> 'a2) -> 'a2 -> 'a2 **)
372 (fun f b -> PositiveMap.pm_fold_inf m' (fun bv a _ -> f bv a __) b)
375 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
376 (PreIdentifiers.identifier -> 'a1 -> Bool.bool) ->
377 (PreIdentifiers.identifier, 'a1) Types.prod Types.option **)
380 Types.option_map (fun x -> { Types.fst = x.Types.fst; Types.snd =
381 x.Types.snd }) (PositiveMap.pm_find m' (fun id -> p id))
383 (** val lookup_present :
384 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
385 PreIdentifiers.identifier -> 'a1 **)
386 let lookup_present tag m id =
387 (match lookup tag m id with
388 | Types.None -> (fun _ -> assert false (* absurd case *))
389 | Types.Some a -> (fun _ -> a)) __
391 (** val update_present :
392 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
393 PreIdentifiers.identifier -> 'a1 -> 'a1 identifier_map **)
394 let update_present tag m l a =
395 let l' = let l' = l in l' in
396 let m' = let m' = m in m' in
397 let u' = PositiveMap.update l' a m' in
399 | Types.None -> (fun _ -> assert false (* absurd case *))
400 | Types.Some m'0 -> (fun _ -> m'0)) __
402 type identifier_set = Types.unit0 identifier_map
404 (** val empty_set : PreIdentifiers.identifierTag -> identifier_set **)
409 PreIdentifiers.identifierTag -> identifier_set ->
410 PreIdentifiers.identifier -> identifier_set **)
411 let add_set tag s i =
414 (** val singleton_set :
415 PreIdentifiers.identifierTag -> PreIdentifiers.identifier ->
417 let singleton_set tag i =
418 add_set tag (empty_set tag) i
421 PreIdentifiers.identifierTag -> 'a1 identifier_map -> 'a2 identifier_map
422 -> identifier_set **)
423 let rec union_set tag s s' =
424 PositiveMap.merge (fun o o' ->
428 (Monad.m_bind0 (Monad.max_def Option.option) (Obj.magic o') (fun x ->
429 Monad.m_return0 (Monad.max_def Option.option) Types.It))
430 | Types.Some x -> Types.Some Types.It) (let s0 = s in s0)
434 PreIdentifiers.identifierTag -> 'a1 identifier_map -> 'a2 identifier_map
435 -> 'a1 identifier_map **)
436 let rec minus_set tag s s' =
437 PositiveMap.merge (fun o o' ->
440 | Types.Some x -> Types.None) (let s0 = s in s0) (let s1 = s' in s1)
442 (** val identifierSet : PreIdentifiers.identifierTag -> Setoids.setoid **)
443 let identifierSet tag =
446 (** val id_map_size :
447 PreIdentifiers.identifierTag -> 'a1 identifier_map -> Nat.nat **)
448 let id_map_size tag s =
449 let p = s in PositiveMap.domain_size p
453 (** val set_from_list :
454 PreIdentifiers.identifierTag -> PreIdentifiers.identifier List.list ->
455 Types.unit0 identifier_map **)
456 let set_from_list tag =
457 Util.foldl (add_set tag) (empty_set tag)
459 (** val dpi1__o__id_set_from_list__o__inject :
460 PreIdentifiers.identifierTag -> (PreIdentifiers.identifier List.list,
461 'a1) Types.dPair -> Types.unit0 identifier_map Types.sig0 **)
462 let dpi1__o__id_set_from_list__o__inject x0 x3 =
463 set_from_list x0 x3.Types.dpi1
465 (** val eject__o__id_set_from_list__o__inject :
466 PreIdentifiers.identifierTag -> PreIdentifiers.identifier List.list
467 Types.sig0 -> Types.unit0 identifier_map Types.sig0 **)
468 let eject__o__id_set_from_list__o__inject x0 x3 =
469 set_from_list x0 (Types.pi1 x3)
471 (** val id_set_from_list__o__inject :
472 PreIdentifiers.identifierTag -> PreIdentifiers.identifier List.list ->
473 Types.unit0 identifier_map Types.sig0 **)
474 let id_set_from_list__o__inject x0 x2 =
477 (** val dpi1__o__id_set_from_list :
478 PreIdentifiers.identifierTag -> (PreIdentifiers.identifier List.list,
479 'a1) Types.dPair -> Types.unit0 identifier_map **)
480 let dpi1__o__id_set_from_list x0 x2 =
481 set_from_list x0 x2.Types.dpi1
483 (** val eject__o__id_set_from_list :
484 PreIdentifiers.identifierTag -> PreIdentifiers.identifier List.list
485 Types.sig0 -> Types.unit0 identifier_map **)
486 let eject__o__id_set_from_list x0 x2 =
487 set_from_list x0 (Types.pi1 x2)
490 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
491 ((PreIdentifiers.identifier, 'a1) Types.prod, 'a1 identifier_map)
492 Types.prod Types.option **)
494 match PositiveMap.pm_choose (let m' = m in m') with
495 | Types.None -> Types.None
497 Types.Some { Types.fst = { Types.fst = x.Types.fst.Types.fst; Types.snd =
498 x.Types.fst.Types.snd }; Types.snd = x.Types.snd }
501 PreIdentifiers.identifierTag -> 'a1 identifier_map ->
502 PreIdentifiers.identifier -> ('a1, 'a1 identifier_map) Types.prod
504 let try_remove tag m id =
505 match PositiveMap.pm_try_remove (let id' = id in id') (let m' = m in m') with
506 | Types.None -> Types.None
508 Types.Some { Types.fst = x.Types.fst; Types.snd = x.Types.snd }
510 (** val id_set_of_map :
511 PreIdentifiers.identifierTag -> 'a1 identifier_map -> identifier_set **)
512 let id_set_of_map tag m =
513 PositiveMap.map (fun x -> Types.It) (let m' = m in m')
515 (** val set_of_list :
516 PreIdentifiers.identifierTag -> PreIdentifiers.identifier List.list ->
518 let set_of_list tag l =
519 Util.foldl (fun s id -> add_set tag s id) (empty_set tag) l
521 (** val domain_of_map :
522 PreIdentifiers.identifierTag -> 'a1 identifier_map -> identifier_set **)
523 let domain_of_map tag m =
524 PositiveMap.domain_of_pm (let m0 = m in m0)