1 (* Copyright (C) 2004, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://helm.cs.unibo.it/
26 exception Meta_not_found of int
27 exception Subst_not_found of int
30 let lookup_meta index metasenv =
32 List.find (fun (index', _, _) -> index = index') metasenv
33 with Not_found -> raise (Meta_not_found index)
35 let lookup_subst n subst =
38 with Not_found -> raise (Subst_not_found n)
40 let exists_meta index = List.exists (fun (index', _, _) -> (index = index'))
42 (* clean_up_meta take a substitution, a metasenv a meta_inex and a local
43 context l and clean up l with respect to the hidden hipothesis in the
46 let clean_up_local_context subst metasenv n l =
49 let (cc,_) = lookup_subst n subst in cc
50 with Subst_not_found _ ->
52 let (_,cc,_) = lookup_meta n metasenv in cc
53 with Meta_not_found _ -> assert false) in
61 Invalid_argument _ -> assert false)
67 C.Rel m when m > k -> false
71 (fun i t -> i && (match t with None -> true | Some t -> is_closed k t)
74 | C.Implicit _ -> assert false
75 | C.Cast (te,ty) -> is_closed k te && is_closed k ty
76 | C.Prod (name,so,dest) -> is_closed k so && is_closed (k+1) dest
77 | C.Lambda (_,so,dest) -> is_closed k so && is_closed (k+1) dest
78 | C.LetIn (_,so,dest) -> is_closed k so && is_closed (k+1) dest
80 List.fold_right (fun x i -> i && is_closed k x) l true
81 | C.Var (_,exp_named_subst)
82 | C.Const (_,exp_named_subst)
83 | C.MutInd (_,_,exp_named_subst)
84 | C.MutConstruct (_,_,_,exp_named_subst) ->
85 List.fold_right (fun (_,x) i -> i && is_closed k x)
87 | C.MutCase (_,_,out,te,pl) ->
88 is_closed k out && is_closed k te &&
89 List.fold_right (fun x i -> i && is_closed k x) pl true
91 let len = List.length fl in
92 let k_plus_len = k + len in
94 (fun (_,_,ty,bo) i -> i && is_closed k ty && is_closed k_plus_len bo
97 let len = List.length fl in
98 let k_plus_len = k + len in
100 (fun (_,ty,bo) i -> i && is_closed k ty && is_closed k_plus_len bo
106 (* CPS iterators on Cic.term ************************************************)
108 let rec visit_l visit_t map f r = function
111 let f r = visit_l visit_t map f r tail in
115 let rec visit_t f r = function
116 | Cic.Meta _ -> raise Exit
122 | Cic.Lambda (_, t, u)
123 | Cic.LetIn (_, t, u) ->
124 let f r = visit_t f r u in visit_t f r t
126 visit_l visit_t (fun x -> x) f r tl
128 let f r = visit_l visit_t (fun (_, _, _, u) -> u) f r tl in
129 visit_l visit_t (fun (_, _, t, _) -> t) f r tl
130 | Cic.CoFix (_, tl) ->
131 let f r = visit_l visit_t (fun (_, _, u) -> u) f r tl in
132 visit_l visit_t (fun (_, t, _) -> t) f r tl
135 | Cic.MutInd (k, _, tl)
136 | Cic.MutConstruct (k, _, _, tl) ->
137 visit_l visit_t (fun (_, u) -> u) f r tl
138 | Cic.MutCase (_, _, t, u, tl) ->
139 let f r = visit_l visit_t (fun u -> u) f r tl in
140 let f r = visit_t f r u in
143 try visit_t (fun x -> x) () t; false with Exit -> true
145 let xpointer_RE = Str.regexp "\\([^#]+\\)#xpointer(\\(.*\\))"
146 let slash_RE = Str.regexp "/"
149 let uri = UriManager.uri_of_string s in
151 (if String.sub s (String.length s - 4) 4 = ".con" then
153 else if String.sub s (String.length s - 4) 4 = ".var" then
155 else if not (Str.string_match xpointer_RE s 0) then
156 raise (UriManager.IllFormedUri s)
158 let (baseuri,xpointer) = (Str.matched_group 1 s, Str.matched_group 2 s) in
159 let baseuri = UriManager.uri_of_string baseuri in
160 (match Str.split slash_RE xpointer with
161 | [_; tyno] -> Cic.MutInd (baseuri, int_of_string tyno - 1, [])
162 | [_; tyno; consno] ->
164 (baseuri, int_of_string tyno - 1, int_of_string consno, [])
169 | Not_found -> raise (UriManager.IllFormedUri s)