status#set_stack gstatus
;;
-let branch_tac status =
+let branch_tac ?(force=false) status =
let gstatus =
match status#stack with
| [] -> assert false
| (g, t, k, tag) :: s ->
match init_pos g with (* TODO *)
- | [] | [ _ ] -> fail (lazy "too few goals to branch");
+ | [] -> fail (lazy "empty goals")
+ | [_] when (not force) -> fail (lazy "too few goals to branch")
| loc :: loc_tl ->
([ loc ], [], [], `BranchTag) :: (loc_tl, t, k, tag) :: s
in
names
in
let n,h,metasenv,subst,o = status#obj in
- let metasenv,subst,_ = NCicMetaSubst.restrict metasenv subst goal js in
+ let metasenv,subst,_,_ = NCicMetaSubst.restrict metasenv subst goal js in
status#set_obj (n,h,metasenv,subst,o))
;;
}
;;
+let ref_of_indtyinfo iti = iti.reference;;
+
let analyze_indty_tac ~what indtyref =
distribute_tac (fun status goal ->
let goalty = get_goalty status goal in
if name = "_clearme" then clear_tac ["_clearme"] else id_tac ]
;;
-let constructor ?(num=1) ~args status goal =
+let constructor_tac ?(num=1) ~args = distribute_tac (fun status goal ->
if num < 1 then fail (lazy "constructor numbers begin with 1");
let gty = get_goalty status goal in
let status, (r,_,_,_) = analyse_indty status gty in
Ast.Appl (HExtlib.list_concat ~sep:[Ast.Implicit `Vector]
([Ast.NRef ref] :: List.map (fun _,_,x -> [x]) args))
in
- exec (apply_tac ("",0,t)) status goal
+ exec (apply_tac ("",0,t)) status goal)
;;
-let constructor_tac ?num ~args = distribute_tac (constructor ?num ~args);;
-
let assert0_tac (hyps,concl) = distribute_tac (fun status goal ->
let gty = get_goalty status goal in
let eq status ctx t1 t2 =
| [seq] -> assert0_tac seq
| _ ->
block_tac
- (branch_tac::
+ ((branch_tac ~force:false)::
HExtlib.list_concat ~sep:[shift_tac]
(List.map (fun seq -> [assert0_tac seq]) seqs)@
[merge_tac])