X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_disambiguation%2Fdisambiguate.ml;h=667c50770536bb7187df52a2cc460991b32cf20f;hb=f1dc70ca55058b2983cd23b829d856df3b41b9a7;hp=2ab3b37060cd66829a9696e4206b099a20687ae3;hpb=cd8062bb6dbbc4564c4d35e3bc1557b030568902;p=helm.git diff --git a/helm/ocaml/cic_disambiguation/disambiguate.ml b/helm/ocaml/cic_disambiguation/disambiguate.ml index 2ab3b3706..667c50770 100644 --- a/helm/ocaml/cic_disambiguation/disambiguate.ml +++ b/helm/ocaml/cic_disambiguation/disambiguate.ml @@ -23,6 +23,8 @@ * http://helm.cs.unibo.it/ *) +(* $Id$ *) + open Printf open DisambiguateTypes @@ -116,7 +118,7 @@ let resolve (env: codomain_item Environment.t) (item: domain_item) ?(num = "") ? (DisambiguateTypes.string_of_domain_item item)) (* TODO move it to Cic *) -let find_in_context name (context: Cic.name list) = +let find_in_context name context = let rec aux acc = function | [] -> raise Not_found | Cic.Name hd :: tl when hd = name -> acc @@ -409,7 +411,7 @@ let interpretate_term ~(context: Cic.name list) ~env ~uri ~is_path ast | None -> Cic.Implicit annotation | Some term -> aux ~localize loc context term in - aux ~localize:true dummy_floc context ast + aux ~localize:true HExtlib.dummy_floc context ast let interpretate_path ~context path = let localization_tbl = Cic.CicHash.create 23 in @@ -536,7 +538,7 @@ let rev_uniq = (* "aux" keeps domain in reverse order and doesn't care about duplicates. * Domain item more in deep in the list will be processed first. *) -let rec domain_rev_of_term ?(loc = dummy_floc) context = function +let rec domain_rev_of_term ?(loc = HExtlib.dummy_floc) context = function | CicNotationPt.AttributedTerm (`Loc loc, term) -> domain_rev_of_term ~loc context term | CicNotationPt.AttributedTerm (_, term) -> @@ -612,7 +614,8 @@ let rec domain_rev_of_term ?(loc = dummy_floc) context = function where_dom @ defs_dom | CicNotationPt.Ident (name, subst) -> (try - let index = find_in_context name context in + (* the next line can raise Not_found *) + ignore(find_in_context name context); if subst <> None then CicNotationPt.fail loc "Explicit substitutions not allowed here" else @@ -681,16 +684,16 @@ let domain_of_obj ~context ast = List.flatten (List.rev_map (fun (_,ty,_) -> domain_rev_of_term [] ty) fields) in let dom = + List.fold_left + (fun dom (_,ty) -> + domain_rev_of_term [] ty @ dom + ) (dom @ domain_rev_of_term [] ty) params + in List.filter (fun name-> not ( List.exists (fun (name',_) -> name = Id name') params || List.exists (fun (name',_,_) -> name = Id name') fields) ) dom - in - List.fold_left - (fun dom (_,ty) -> - domain_rev_of_term [] ty @ dom - ) (dom @ domain_rev_of_term [] ty) params in rev_uniq domain_rev