X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Focaml%2Fcic_disambiguation%2Fdisambiguate.ml;h=9f4c41d2e709e608b5f7497d27692d6737736598;hb=0aaed6f96b856d1181a3cd1f2ef3ea4a91990771;hp=b39d35f070f68bce422c3ded19ecc7b729a9ed50;hpb=218c0062f93dd3221b0266cfbc26fd9cf787ad18;p=helm.git diff --git a/helm/ocaml/cic_disambiguation/disambiguate.ml b/helm/ocaml/cic_disambiguation/disambiguate.ml index b39d35f07..9f4c41d2e 100644 --- a/helm/ocaml/cic_disambiguation/disambiguate.ml +++ b/helm/ocaml/cic_disambiguation/disambiguate.ml @@ -67,10 +67,11 @@ let refine metasenv context term ugraph = (Ok (term', metasenv')),ugraph1 with | CicRefine.Uncertain _ -> - debug_print ("%%% UNCERTAIN!!! " ^ CicPp.ppterm term) ; + debug_print ("UNCERTAIN!!! " ^ CicPp.ppterm term) ; Uncertain,ugraph - | CicRefine.RefineFailure _ -> - debug_print ("%%% PRUNED!!! " ^ CicPp.ppterm term) ; + | CicRefine.RefineFailure msg -> + debug_print (sprintf "PRUNED!!!\nterm%s\nmessage:%s" + (CicPp.ppterm term) msg); Ko,ugraph | CicUnification.UnificationFailure s -> prerr_endline ("PASSADI QUI: " ^ s); @@ -79,7 +80,9 @@ let refine metasenv context term ugraph = let resolve (env: environment) (item: domain_item) ?(num = "") ?(args = []) () = try snd (Environment.find item env) env num args - with Not_found -> assert false + with Not_found -> + failwith ("Domain item not found: " ^ + (DisambiguateTypes.string_of_domain_item item)) (* TODO move it to Cic *) let find_in_environment name context = @@ -230,44 +233,23 @@ let interpretate ~context ~env ast = subst | None -> List.map (fun uri -> uri, Cic.Implicit None) uris) in - (* the try is for CicTypeChecker.typecheck *) (try match cic with | Cic.Const (uri, []) -> - let uris = - let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in - match o with - (*match CicTypeChecker.typecheck uri with*) - | Cic.Constant (_, _, _, uris) -> uris - | _ -> assert false - in + let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + let uris = CicUtil.params_of_obj o in Cic.Const (uri, mk_subst uris) | Cic.Var (uri, []) -> - let uris = - let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in - match o with - (*match CicTypeChecker.typecheck uri with*) - | Cic.Variable (_, _, _, uris) -> uris - | _ -> assert false - in + let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + let uris = CicUtil.params_of_obj o in Cic.Var (uri, mk_subst uris) | Cic.MutInd (uri, i, []) -> - let uris = - let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in - match o with - (*match CicTypeChecker.typecheck uri with*) - | Cic.InductiveDefinition (_, uris, _) -> uris - | _ -> assert false - in + let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + let uris = CicUtil.params_of_obj o in Cic.MutInd (uri, i, mk_subst uris) | Cic.MutConstruct (uri, i, j, []) -> - let uris = - let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in - match o with - (*match CicTypeChecker.typecheck uri with*) - | Cic.InductiveDefinition (_, uris, _) -> uris - | _ -> assert false - in + let o,_ = CicEnvironment.get_obj CicUniv.empty_ugraph uri in + let uris = CicUtil.params_of_obj o in Cic.MutConstruct (uri, i, j, mk_subst uris) | Cic.Meta _ | Cic.Implicit _ as t -> (* @@ -468,7 +450,7 @@ module Make (C: Callbacks) = uris let disambiguate_term ~(dbd:Mysql.dbd) context metasenv term - ?(initial_ugraph = CicUniv.empty_ugraph) ~aliases:current_env + ?(initial_ugraph = CicUniv.empty_ugraph) ~aliases:current_env = debug_print "NEW DISAMBIGUATE INPUT"; let disambiguate_context = (* cic context -> disambiguate context *) @@ -623,6 +605,6 @@ module Make (C: Callbacks) = res with CicEnvironment.CircularDependency s -> - raise (Failure "e chi la becca sta CircularDependency?"); + failwith "Disambiguate: circular dependency" end