X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fsoftware%2Fcomponents%2Fcic_disambiguation%2FdisambiguateChoices.ml;h=6d4d63b704e367c0c64cf3f0989d8c68de527031;hb=f9abd21eb0d26cf9b632af4df819225be4d091e3;hp=64d2cf8e0343155736784a6c67d9370fc9ab8343;hpb=f9ec0bd466364409050ffccc94e9cb863e2ddf28;p=helm.git diff --git a/helm/software/components/cic_disambiguation/disambiguateChoices.ml b/helm/software/components/cic_disambiguation/disambiguateChoices.ml index 64d2cf8e0..6d4d63b70 100644 --- a/helm/software/components/cic_disambiguation/disambiguateChoices.ml +++ b/helm/software/components/cic_disambiguation/disambiguateChoices.ml @@ -32,8 +32,10 @@ open DisambiguateTypes exception Choice_not_found of string Lazy.t let num_choices = ref [] +let nnum_choices = ref [] let add_num_choice choice = num_choices := choice :: !num_choices +let nadd_num_choice choice = nnum_choices := choice :: !nnum_choices let has_description dsc = (fun x -> fst x = dsc) @@ -44,9 +46,15 @@ let lookup_num_by_dsc dsc = List.find (has_description dsc) !num_choices with Not_found -> raise (Choice_not_found (lazy ("Num with dsc " ^ dsc))) -let mk_choice (dsc, args, appl_pattern) = +let nlookup_num_by_dsc dsc = + try + List.find (has_description dsc) !nnum_choices + with Not_found -> raise (Choice_not_found (lazy ("Num with dsc " ^ dsc))) + +let mk_choice ~mk_appl ~mk_implicit ~term_of_uri ~term_of_nref (dsc, args, appl_pattern)= dsc, - (fun env _ cic_args -> + `Sym_interp + (fun cic_args -> let env',rest = let names = List.map (function CicNotationPt.IdentArg (_, name) -> name) args @@ -62,21 +70,29 @@ let mk_choice (dsc, args, appl_pattern) = try combine_with_rest names cic_args with Invalid_argument _ -> - raise (Invalid_choice (lazy ("The notation " ^ dsc ^ " expects more arguments"))) + raise (Invalid_choice (lazy (Stdpp.dummy_loc, + "The notation " ^ dsc ^ " expects more arguments"))) in let combined = - TermAcicContent.instantiate_appl_pattern env' appl_pattern + TermAcicContent.instantiate_appl_pattern + ~mk_appl ~mk_implicit ~term_of_uri ~term_of_nref env' appl_pattern in match rest with [] -> combined - | _::_ -> Cic.Appl (combined::rest)) + | _::_ -> mk_appl (combined::rest)) -let lookup_symbol_by_dsc symbol dsc = +let lookup_symbol_by_dsc ~mk_appl ~mk_implicit ~term_of_uri ~term_of_nref symbol dsc = + let interpretations = TermAcicContent.lookup_interpretations ~sorted:false symbol in try - mk_choice - (List.find - (fun (dsc', _, _) -> dsc = dsc') - (TermAcicContent.lookup_interpretations symbol)) + mk_choice ~mk_appl ~mk_implicit ~term_of_uri ~term_of_nref + (List.find (fun (dsc', _, _) -> dsc = dsc') interpretations) with TermAcicContent.Interpretation_not_found | Not_found -> raise (Choice_not_found (lazy (sprintf "Symbol %s, dsc %s" symbol dsc))) +let cic_lookup_symbol_by_dsc = lookup_symbol_by_dsc + ~mk_implicit:(function + | true -> Cic.Implicit (Some `Type) + | false -> Cic.Implicit None) + ~mk_appl:(function (Cic.Appl l)::tl -> Cic.Appl (l@tl) | l -> Cic.Appl l) + ~term_of_uri:CicUtil.term_of_uri ~term_of_nref:(fun _ -> assert false) +;;