let set_default_eqP() = eqPref := default_eqP
-module type NCicContext =
- sig
- val metasenv : NCic.metasenv
- val subst : NCic.substitution
- val context : NCic.context
- end
-
-module NCicBlob(C : NCicContext) : Terms.Blob
+let saturate status metasenv subst context t ty =
+ let sty, _, args =
+ (* CSC: NCicPp.status is the best I can put here *)
+ NCicMetaSubst.saturate status ~delta:0 metasenv subst context ty 0
+ in
+ let proof =
+ if args = [] then t
+ else NCic.Appl (t :: args)
+ in
+ proof, sty
+;;
+
+
+module NCicBlob: Terms.Blob
with type t = NCic.term and type input = NCic.term = struct
type t = NCic.term
let pp t =
(* CSC: NCicPp.status is the best I can put here *)
- (* WR: and I can't guess a user id, so I must put None *)
- (new NCicPp.status None)#ppterm ~context:C.context
- ~metasenv:C.metasenv ~subst:C.subst t;;
+ (new NCicPp.status None)#ppterm ~context:[] ~metasenv:[] ~subst:[] t
type input = NCic.term
let embed t = fst (embed t) ;;
- let saturate t ty =
- let sty, _, args =
- (* CSC: NCicPp.status is the best I can put here *)
- (* WR: and I can't guess a user id, so I must put None *)
- NCicMetaSubst.saturate (new NCicPp.status None) ~delta:0 C.metasenv C.subst
- C.context ty 0
- in
- let proof =
- if args = [] then Terms.Leaf t
- else Terms.Node (Terms.Leaf t :: List.map embed args)
- in
- let sty = embed sty in
- proof, sty
- ;;
-
end
val set_eqP: NCic.term -> unit
val set_default_eqP: unit -> unit
+val saturate:
+ #NCicEnvironment.status ->
+ NCic.metasenv ->
+ NCic.substitution ->
+ NCic.context -> NCic.term -> NCic.term -> NCic.term * NCic.term
+(*
module type NCicContext =
sig
val metasenv : NCic.metasenv
val subst : NCic.substitution
val context : NCic.context
end
+*)
-module NCicBlob(C : NCicContext) : Terms.Blob
+module NCicBlob: Terms.Blob
with type t = NCic.term and type input = NCic.term
let print s = prerr_endline (Lazy.force s);;
let debug = noprint;;
-module B(C : NCicBlob.NCicContext): Orderings.Blob
+module B : Orderings.Blob
with type t = NCic.term and type input = NCic.term
- = Orderings.LPO(NCicBlob.NCicBlob(C))
+ = Orderings.LPO(NCicBlob.NCicBlob)
-module NCicParamod(C : NCicBlob.NCicContext) = Paramod.Paramod(B(C))
+module NCicParamod = Paramod.Paramod(B)
let readback status ?(demod=false) metasenv subst context (bag,i,fo_subst,l) =
(*
proofterm, prooftype, metasenv, subst
let nparamod status metasenv subst context t table =
- let module C =
- struct
- let metasenv = metasenv
- let subst = subst
- let context = context
- end
- in
- let module B = B(C) in
- let module P = NCicParamod(C) in
+ let module P = NCicParamod in
let module Pp = Pp.Pp(B) in
let bag, maxvar = Terms.empty_bag, 0 in
+ let saturate (t,ty) =
+ NCicBlob.saturate status metasenv subst context t ty in
let (bag,maxvar), goals =
- HExtlib.list_mapi_acc (fun x _ a -> P.mk_goal a x) (bag,maxvar) [t]
+ HExtlib.list_mapi_acc
+ (fun x _ a -> P.mk_goal a (saturate x)) (bag,maxvar) [t]
in
- let (bag,maxvar), passives =
- HExtlib.list_mapi_acc (fun x _ a -> P.mk_passive a x) (bag,maxvar) table
+ let (bag,maxvar), passives =
+ HExtlib.list_mapi_acc
+ (fun x _ a -> P.mk_passive a (saturate x)) (bag,maxvar) table
in
match
P.paramod ~useage:true ~max_steps:max_int ~timeout:(Unix.gettimeofday () +. 300.0)
List.map (readback status metasenv subst context) solutions
;;
-module EmptyC =
- struct
- let metasenv = []
- let subst = []
- let context = []
- end
-
-module CB = NCicBlob.NCicBlob(EmptyC)
-module P = NCicParamod(EmptyC)
+module CB = NCicBlob.NCicBlob
+module P = NCicParamod
type state = P.state
let empty_state = P.empty_state
-let forward_infer_step s t ty =
+let forward_infer_step status metasenv subst context s t ty =
let bag = P.bag_of_state s in
+ let saturate (t,ty) =
+ NCicBlob.saturate status metasenv subst context t ty in
let bag,clause = P.mk_passive bag (t,ty) in
if Terms.is_eq_clause clause then
P.forward_infer_step (P.replace_bag s bag) clause 0
match obj with
| (_,_,[],[],NCic.Constant(_,_,None,ty,_)) ->
let nref = NReference.reference_of_spec uri NReference.Decl in
- forward_infer_step s (NCic.Const nref) ty
+ forward_infer_step status [] [] [] s (NCic.Const nref) ty
| (_,d,[],[],NCic.Constant(_,_,Some(_),ty,_)) ->
let nref = NReference.reference_of_spec uri (NReference.Def d) in
- forward_infer_step s (NCic.Const nref) ty
+ forward_infer_step status [] [] [] s (NCic.Const nref) ty
| _ -> s
;;
type state
val empty_state: state
-val forward_infer_step: state -> NCic.term -> NCic.term -> state
+val forward_infer_step:
+ #NCicCoercion.status ->
+ NCic.metasenv ->
+ NCic.substitution ->
+ NCic.context ->
+ state ->
+ NCic.term ->
+ NCic.term ->
+ state
val index_obj: #NCicEnvironment.status -> state -> NUri.uri -> state
val is_equation:
#NCicEnvironment.status -> NCic.metasenv -> NCic.substitution -> NCic.context ->
match t with
| Terms.Leaf _
| Terms.Var _ ->
- let module NCicBlob = NCicBlob.NCicBlob(
- struct
- let metasenv = [] let subst = [] let context = []
- end)
- in
+ let module NCicBlob = NCicBlob.NCicBlob in
let module Pp = Pp.Pp(NCicBlob) in
prerr_endline ("term: " ^ Pp.pp_foterm ft);
prerr_endline ("path: " ^ String.concat ","
let mk_proof status ?(demod=false) (bag : NCic.term Terms.bag) mp subst steps=
let module NCicBlob =
- NCicBlob.NCicBlob(
- struct
- let metasenv = [] let subst = [] let context = []
- end)
+ NCicBlob.NCicBlob
in
let module Pp = Pp.Pp(NCicBlob)
in
(bag, maxvar), c
;;
- let mk_clause bag maxvar (t,ty) =
- let (proof,ty) = B.saturate t ty in
+(*
+ let mk_clause bag maxvar (proof,ty) =
+ let (proof,ty) = B.saturate t ty in
let c, maxvar = Utils.mk_unit_clause maxvar ty proof in
let bag, c = Terms.add_to_bag c bag in
(bag, maxvar), c
- ;;
+ ;; *)
- let mk_passive (bag,maxvar) = mk_clause bag maxvar;;
+ let mk_passive (bag,maxvar) = mk_unit_clause bag maxvar;;
- let mk_goal (bag,maxvar) = mk_clause bag maxvar;;
+ let mk_goal (bag,maxvar) = mk_unit_clause bag maxvar;;
let initialize_goal (bag,maxvar,actives,passives,_,_) t =
let (bag,maxvar), g = mk_unit_clause bag maxvar t in
val empty_state : state
val bag_of_state :state -> bag
val replace_bag : state -> bag -> state
+ (* we suppose input has been already saturated *)
val mk_passive : bag -> input * input -> bag * t Terms.unit_clause
val mk_goal : bag -> input * input -> bag * t Terms.unit_clause
val forward_infer_step :
val pp : t -> string
type input
val embed : input -> t foterm
- val saturate : input -> input -> t foterm * t foterm
+(* val saturate : input -> input -> t foterm * t foterm *)
end
type input
val embed : input -> t foterm
(* saturate [proof] [type] -> [proof] * [type] *)
- val saturate : input -> input -> t foterm * t foterm
+ (* val saturate : input -> input -> t foterm * t foterm *)
end
let ty = NCicTypeChecker.typeof status [] [] ctx t in
if is_a_fact status (mk_cic_term ctx ty) then
(debug_print(lazy("eq indexing " ^ (status#ppterm ctx [] [] ty)));
- NCicParamod.forward_infer_step eq_cache t ty)
+ NCicParamod.forward_infer_step status [] [] ctx eq_cache t ty)
else
(debug_print (lazy ("not a fact: " ^ (status#ppterm ctx [] [] ty)));
eq_cache)