| (g, t, k, tag) :: s ->
match init_pos g with (* TODO *)
| [] -> fail (lazy "empty goals")
- | [_] when (not force) -> fail (lazy "too few goals to branch")
+ | [_] when (not force) -> fail (lazy "too few goals to branch")
| loc :: loc_tl ->
([ loc ], [], [], `BranchTag) :: (loc_tl, t, k, tag) :: s
in
_,_,(None,_,_) -> fail (lazy "No term to generalize")
| txt,txtlen,(Some what,_,_) ->
let status, what =
- disambiguate status (ctx_of goalty) (txt,txtlen,what) None
+ disambiguate status (ctx_of goalty) (txt,txtlen,what) `XTNone
in
status,what,[]
)
let change_tac ~where ~with_what =
let change status t =
- let status, ww = disambiguate status (ctx_of t) with_what None in
+(* FG: `XTSort could be used when we change the whole goal *)
+ let status, ww = disambiguate status (ctx_of t) with_what `XTNone in
let status = unify status (ctx_of t) t ww in
status, ww
in
leftno: int;
consno: int;
reference: NReference.reference;
+ cl: NCic.constructor list;
}
;;
let analyze_indty_tac ~what indtyref =
distribute_tac (fun (status as orig_status) goal ->
let goalty = get_goalty status goal in
- let status, what = disambiguate status (ctx_of goalty) what None in
+ let status, what = disambiguate status (ctx_of goalty) what `XTInd in
let status, ty_what = typeof status (ctx_of what) what in
- let status, (r,consno,lefts,rights) = analyse_indty status ty_what in
+ let status, (r,consno,lefts,rights,cl) = analyse_indty status ty_what in
let leftno = List.length lefts in
let rightno = List.length rights in
indtyref := Some {
rightno = rightno; leftno = leftno; consno = consno; reference = r;
+ cl = cl;
};
exec id_tac orig_status goal)
;;
let goalty = get_goalty status goal in
let status,sort = typeof status (ctx_of goalty) goalty in
let status, sort = fix_sorts status sort in
- let status, sort = term_of_cic_term status sort (ctx_of goalty) in
+ let ctx = ctx_of goalty in
+ let status, sort = whd status (ctx_of sort) sort in
+ let status, sort = term_of_cic_term status sort ctx in
sortref := sort;
status)
;;
+let pp_ref reference =
+ let NReference.Ref (uri,spec) = reference in
+ let nstring = NUri.string_of_uri uri in
+ (*"Shareno: " ^ (string_of_int nuri) ^*) "Uri: " ^ nstring ^
+ (match spec with
+ | NReference.Decl -> "Decl"
+ | NReference.Def n -> "Def " ^ (string_of_int n)
+ | NReference.Fix (n1,n2,n3) -> "Fix " ^ (string_of_int n1) ^ " " ^ (string_of_int n2) ^ " " ^ (string_of_int n3)(* fixno, recparamno, height *)
+ | NReference.CoFix n -> "CoFix " ^ (string_of_int n)
+ | NReference.Ind (b,n1,n2) -> "Ind " ^ (string_of_bool b) ^ " " ^ (string_of_int n1) ^ " " ^ (string_of_int n2)(* inductive, indtyno, leftno *)
+ | NReference.Con (n1,n2,n3) -> "Con " ^ (string_of_int n1) ^ " " ^ (string_of_int n2) ^ " " ^ (string_of_int n3)(* indtyno, constrno, leftno *)
+ ) ;;
+
+let pp_cl cl =
+ let rec pp_aux acc =
+ match acc with
+ | [] -> ""
+ | (_,consname,_) :: tl -> consname ^ ", " ^ pp_aux tl
+ in
+ pp_aux cl
+;;
+
+let pp_indtyinfo ity = "leftno: " ^ (string_of_int ity.leftno) ^ ", consno: " ^ (string_of_int
+ ity.consno) ^ ", rightno: " ^
+ (string_of_int ity.rightno) ^ ", reference: " ^ (pp_ref ity.reference) ^ ",
+ cl: " ^ (pp_cl ity.cl);;
+
let elim_tac ~what:(txt,len,what) ~where =
let what = txt, len, Ast.Appl [what; Ast.Implicit `Vector] in
let indtyinfo = ref None in
let cases ~what status goal =
let gty = get_goalty status goal in
- let status, what = disambiguate status (ctx_of gty) what None in
+ let status, what = disambiguate status (ctx_of gty) what `XTInd in
let status, ty = typeof status (ctx_of what) what in
- let status, (ref, consno, _, _) = analyse_indty status ty in
+ let status, (ref, consno, _, _,_) = analyse_indty status ty in
let status, what = term_of_cic_term status what (ctx_of gty) in
let t =
NCic.Match (ref,NCic.Implicit `Term, what,
HExtlib.mk_list (NCic.Implicit `Term) consno)
- in
+ in
instantiate status goal (mk_cic_term (ctx_of gty) t)
;;
let constructor_tac ?(num=1) ~args = distribute_tac (fun status goal ->
let gty = get_goalty status goal in
- let status, (r,consno,_,_) = analyse_indty status gty in
+ let status, (r,consno,_,_,_) = analyse_indty status gty in
if num < 1 || num > consno then fail (lazy "Non existant constructor");
let ref = NReference.mk_constructor num r in
let t =
let assert0_tac (hyps,concl) = distribute_tac (fun status goal ->
let gty = get_goalty status goal in
let eq status ctx t1 t2 =
- let status,t1 = disambiguate status ctx t1 None in
+ let status,t1 = disambiguate status ctx t1 `XTSort in
let status,t1 = apply_subst status ctx t1 in
let status,t1 = term_of_cic_term status t1 ctx in
let t2 = mk_cic_term ctx t2 in