X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fcic_disambiguation%2FdisambiguateChoices.ml;h=9f3c554c6ec626ae5f4c2a7d3ea28c43940a6540;hb=91a095f0686ee569ba035e4e30c7d071588cb8e7;hp=9caf77aabf0618bdac3f2071a056a569d2398ff7;hpb=b3bfd6b249600b15552c890306a635aee30c2a74;p=helm.git diff --git a/helm/ocaml/cic_disambiguation/disambiguateChoices.ml b/helm/ocaml/cic_disambiguation/disambiguateChoices.ml index 9caf77aab..9f3c554c6 100644 --- a/helm/ocaml/cic_disambiguation/disambiguateChoices.ml +++ b/helm/ocaml/cic_disambiguation/disambiguateChoices.ml @@ -30,59 +30,38 @@ open DisambiguateTypes exception Invalid_choice exception Choice_not_found of string -let symbol_choices = Hashtbl.create 1023 let num_choices = ref [] -let add_symbol_choice symbol codomain_item = - let current_choices = - try - Hashtbl.find symbol_choices symbol - with Not_found -> [] - in - Hashtbl.replace symbol_choices symbol (codomain_item :: current_choices) - -let add_binary_op symbol dsc appl_head = - add_symbol_choice symbol - (dsc, - (fun env _ args -> - let t1, t2 = - match args with - | [t1; t2] -> t1, t2 - | _ -> raise Invalid_choice - in - Cic.Appl [ appl_head; t1; t2 ])) - -let add_unary_op symbol dsc appl_head = - add_symbol_choice symbol - (dsc, - (fun env _ args -> - let t = match args with [t] -> t | _ -> raise Invalid_choice in - Cic.Appl [ appl_head; t ])) - let add_num_choice choice = num_choices := choice :: !num_choices -let lookup_symbol_choices symbol = - try - Hashtbl.find symbol_choices symbol - with Not_found -> [] - -let lookup_num_choices () = !num_choices - let has_description dsc = (fun x -> fst x = dsc) -let lookup_symbol_by_dsc symb dsc = - try - List.find (has_description dsc) (Hashtbl.find symbol_choices symb) - with Not_found -> - raise (Choice_not_found (sprintf "Symbol %s, dsc %s" symb dsc)) +let lookup_num_choices () = !num_choices let lookup_num_by_dsc dsc = try List.find (has_description dsc) !num_choices with Not_found -> raise (Choice_not_found ("Num with dsc " ^ dsc)) - (** initial table contents *) +let mk_choice (dsc, args, appl_pattern) = + dsc, + (fun env _ cic_args -> + let env' = + let names = + List.map (function CicNotationPt.IdentArg (_, name) -> name) args + in + try + List.combine names cic_args + with Invalid_argument _ -> raise Invalid_choice + in + CicNotationFwd.instantiate_appl_pattern env' appl_pattern) + +let lookup_symbol_by_dsc symbol dsc = + try + mk_choice + (List.find + (fun (dsc', _, _) -> dsc = dsc') + (CicNotationRew.lookup_interpretations symbol)) + with CicNotationRew.Interpretation_not_found | Not_found -> + raise (Choice_not_found (sprintf "Symbol %s, dsc %s" symbol dsc)) -let _ = - add_binary_op "exists" "exists" - (Cic.MutInd (HelmLibraryObjects.Logic.ex_URI, 0, []))