From 170f0003dedcd7c5a914dfcf47b196b5adc326e1 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Tue, 17 May 2005 13:08:11 +0000 Subject: [PATCH] bugfix: avoid duplicate entries while indexing (changed implementation so that sets are internally used everywhere instead of lists, which are now used only for implementing API) --- helm/ocaml/metadata/metadataExtractor.ml | 83 ++++++++++++++---------- 1 file changed, 48 insertions(+), 35 deletions(-) diff --git a/helm/ocaml/metadata/metadataExtractor.ml b/helm/ocaml/metadata/metadataExtractor.ml index f9a26637d..a1c24d9c6 100644 --- a/helm/ocaml/metadata/metadataExtractor.ml +++ b/helm/ocaml/metadata/metadataExtractor.ml @@ -241,25 +241,21 @@ let compute_metas term = let compute_type pos uri typeno (name, _, ty, constructors) = let consno = ref 0 in let type_metadata = - (UriManager.string_of_uriref (uri, [typeno]), name, - S.elements (compute_term pos ty)) + (UriManager.string_of_uriref (uri, [typeno]), name, (compute_term pos ty)) in let constructors_metadata = List.map (fun (name, term) -> incr consno; let uri = UriManager.string_of_uriref (uri, [typeno; !consno]) in - (uri, name, S.elements - (compute_term pos term))) + (uri, name, (compute_term pos term))) constructors in type_metadata :: constructors_metadata let compute_ind pos ~uri ~types = let idx = ref ~-1 in - List.concat - (List.map - (fun ty -> incr idx; compute_type pos uri !idx ty) types) + List.map (fun ty -> incr idx; compute_type pos uri !idx ty) types let compute (pos:position) ~body ~ty = let type_metadata = compute_term pos ty in @@ -276,16 +272,13 @@ let compute (pos:position) ~body ~ty = | _ -> uris) type_metadata StringSet.empty in - S.elements - (S.union - (S.filter - (function - | `Obj (uri, _) when StringSet.mem uri uris -> false - | _ -> true) - body_metadata) - type_metadata) - -let compute_term start_pos term = S.elements (compute_term start_pos term) + S.union + (S.filter + (function + | `Obj (uri, _) when StringSet.mem uri uris -> false + | _ -> true) + body_metadata) + type_metadata let depth_offset params = let non p x = not (p x) in @@ -294,17 +287,23 @@ let depth_offset params = let rec compute_var pos uri = let o, _ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in match o with - | Cic.Variable (_, Some body, ty, params, _) -> [] + | Cic.Variable (_, Some _, _, _, _) -> S.empty | Cic.Variable (_, None, ty, params, _) -> - let metadata_of_vars = - List.flatten - (List.map (compute_var (next_pos pos)) params) in + let var_metadata = + List.fold_left + (fun metadata uri -> + S.union metadata (compute_var (next_pos pos) uri)) + S.empty + params + in (match pos with | `MainHypothesis (Some (Eq 0)) -> let pos = `MainHypothesis (Some (Eq (depth_offset params))) in - (compute pos ~body:None ~ty)@metadata_of_vars + let ty_metadata = compute_term pos ty in + S.union ty_metadata var_metadata | `InHypothesis -> - (compute pos ~body:None ~ty)@metadata_of_vars + let ty_metadata = compute_term pos ty in + S.union ty_metadata var_metadata | _ -> assert false) | _ -> assert false @@ -314,22 +313,36 @@ let compute_obj uri = | Cic.Variable (_, body, ty, params, _) | Cic.Constant (_, body, ty, params, _) -> let pos = `MainConclusion (Some (Eq (depth_offset params))) in - let metadata = compute pos ~body ~ty - in - let metadata_of_vars = - List.flatten - (List.map (compute_var (`MainHypothesis (Some (Eq 0)))) params) + let metadata = compute pos ~body ~ty in + let var_metadata = + List.fold_left + (fun metadata uri -> + S.union metadata (compute_var (`MainHypothesis (Some (Eq 0))) uri)) + S.empty + params in - [UriManager.string_of_uri uri, - UriManager.name_of_uri uri,metadata @ metadata_of_vars] + [ UriManager.string_of_uri uri, + UriManager.name_of_uri uri, + S.union metadata var_metadata ] | Cic.InductiveDefinition (types, params, _, _) -> let pos = `MainConclusion(Some (Eq (depth_offset params))) in - let metadata_of_vars = - List.flatten - (List.map (compute_var (`MainHypothesis (Some (Eq 0)))) params) in let metadata = compute_ind pos ~uri ~types in - List.map (fun (uri,name,md) -> (uri,name,md@metadata_of_vars)) metadata + let var_metadata = + List.fold_left + (fun metadata uri -> + S.union metadata (compute_var (`MainHypothesis (Some (Eq 0))) uri)) + S.empty params + in + List.fold_left + (fun acc m -> + (List.map (fun (uri,name,md) -> (uri,name,S.union md var_metadata)) m) + @ acc) + [] metadata | Cic.CurrentProof _ -> assert false +let compute_obj uri = + List.map (fun (u, n, md) -> (u, n, S.elements md)) (compute_obj uri) + +let compute ~body ~ty = + S.elements (compute (`MainConclusion (Some (Eq 0))) ~body ~ty) -let compute ~body ~ty = compute (`MainConclusion (Some (Eq 0))) ~body ~ty -- 2.39.2