int (* arity *) * int (* saturations *)
| PreferCoercion of loc * 'term
| Inverter of loc * string * 'term * bool list
- | UnificationHint of loc * 'term * int (* term, precedence *)
+ | UnificationHint of loc * CicNotationPt.term * int (* term, precedence *)
| Default of loc * string * UriManager.uri list
| Drop of loc
| Include of loc * bool (* normal? *) * string
| Inverter (_,n,ty,params) ->
"inverter " ^ n ^ " for " ^ term_pp ty ^ " " ^ List.fold_left (fun acc x -> acc ^ (match x with true -> "%" | _ -> "?")) "" params
| UnificationHint (_,t, n) ->
- "unification hint " ^ string_of_int n ^ " " ^ term_pp t
+ "unification hint " ^ string_of_int n ^ " " ^ CicNotationPp.pp_term t
| Default (_,what,uris) -> pp_default what uris
| Drop _ -> "drop"
| Include (_,true,path) -> "include \"" ^ path ^ "\""
;;
let inject_unification_hint =
- NRstatus.Serializer.register "unification_hints" basic_eval_unification_hint
+ let basic_eval_unification_hint (t,n) ~refresh_uri_in_term =
+ let t = refresh_uri_in_term t in basic_eval_unification_hint (t,n)
+ in
+ NRstatus.Serializer.register "unification_hints" basic_eval_unification_hint
;;
let eval_unification_hint status t n =
+ let estatus = GrafiteTypes.get_estatus status in
+ let metasenv,subst,estatus,t =
+ GrafiteDisambiguate.disambiguate_nterm None estatus [] [] [] ("",0,t) in
+ assert (metasenv=[]);
+ let t = NCicUntrusted.apply_subst subst [] t in
+ let status = GrafiteTypes.set_estatus estatus status in
let rstatus =
basic_eval_unification_hint (t,n) (GrafiteTypes.get_rstatus status) in
let status = GrafiteTypes.set_rstatus rstatus status in
Inversion_principle.build_inverter ~add_obj status uri indty_uri params
in
res,`Old uris
- | GrafiteAst.UnificationHint (loc, t, n) ->
- eval_unification_hint status t n
+ | GrafiteAst.UnificationHint (loc, t, n) -> eval_unification_hint status t n
| GrafiteAst.Default (loc, what, uris) as cmd ->
LibraryObjects.set_default what uris;
GrafiteTypes.add_moo_content [cmd] status,`Old []
let metasenv,indty = disambiguate_term metasenv indty in
{ estatus with NEstatus.lstatus = !lexicon_status_ref },
metasenv, GrafiteAst.Inverter (loc,n,indty,params)
- | GrafiteAst.UnificationHint (loc, t, n) ->
- let lexicon_status_ref = ref estatus.NEstatus.lstatus in
- let disambiguate_term =
- disambiguate_term None text prefix_len lexicon_status_ref [] in
- let metasenv,t = disambiguate_term metasenv t in
- { estatus with NEstatus.lstatus = !lexicon_status_ref },
- metasenv, GrafiteAst.UnificationHint (loc,t,n)
+ | GrafiteAst.UnificationHint _
| GrafiteAst.Default _
| GrafiteAst.Drop _
| GrafiteAst.Include _
sig
type status
type obj
- val register: string -> ('a -> status -> status) -> ('a -> obj)
+ val register:
+ string ->
+ ('a -> refresh_uri_in_term:(NCic.term -> NCic.term) -> status -> status) ->
+ ('a -> obj)
val serialize: baseuri:NUri.uri -> obj list -> unit
val require: baseuri:NUri.uri -> status -> status
end
already_registered := tag :: !already_registered;
require1 :=
(fun (tag',data) as x ->
- if tag=tag' then require (Obj.magic data) else !require1 x);
+ if tag=tag' then
+ require (Obj.magic data) ~refresh_uri_in_term
+ else
+ !require1 x);
(fun x -> tag,Obj.repr x)
let serialize = serialize
sig
type status
type obj
- val register: string -> ('a -> status -> status) -> ('a -> obj)
+ val register:
+ string ->
+ ('a -> refresh_uri_in_term:(NCic.term -> NCic.term) -> status -> status) ->
+ ('a -> obj)
val serialize: baseuri:NUri.uri -> obj list -> unit
val require: baseuri:NUri.uri -> status -> status
end
let empty_db = DB.empty ;;
let add_user_provided_hint db t precedence =
- let u = UriManager.uri_of_string "cic:/foo/bar.con" in
let c, a, b =
let rec aux ctx = function
| NCic.Appl l ->
(match List.rev l with
| b::a::_ -> ctx, a, b
| _ -> assert false)
- | NCic.Prod (n,s,t) ->
- aux ((n, NCic.Decl s) :: ctx) t
- | NCic.LetIn (n,ty,t,b) ->
- aux ((n, NCic.Def (t,ty)) :: ctx) b
+ | NCic.Prod (n,s,t) -> aux ((n, NCic.Decl s) :: ctx) t
+ | NCic.LetIn (n,ty,t,b) -> aux ((n, NCic.Def (t,ty)) :: ctx) b
| _ -> assert false
in
- aux [] (fst (OCic2NCic.convert_term u t))
+ aux [] t
in
index_hint db c a b precedence
;;
val index_hint:
db -> NCic.context -> NCic.term -> NCic.term -> int -> db
-val add_user_provided_hint : db -> Cic.term -> int -> db
+val add_user_provided_hint : db -> NCic.term -> int -> db
val empty_db : db