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 newgoalty = mk_cic_term newgoalctx newgoalty in
let status, instance =
- mk_meta status newgoalctx (`Decl newgoalty)
+ mk_meta status newgoalctx (`Decl newgoalty) `IsTerm
in
instantiate status goal instance)
;;
let l = ref [] in
block_tac [
select_tac ~where ~job:(`Collect l) true;
- print_tac true "ha selezionato?";
(fun s -> distribute_tac (fun status goal ->
let goalty = get_goalty status goal in
let status,canon,rest =
block_tac [
exact_tac ("",0, Ast.Appl [Ast.Implicit `JustOne; Ast.Implicit `JustOne]);
branch_tac;
- pos_tac [2]; exact_tac t;
- shift_tac; pos_tac [1]; skip_tac;
+ pos_tac [3]; exact_tac t;
+ shift_tac; pos_tac [2]; skip_tac;
merge_tac ]
;;
}
;;
+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
let sort_of_goal_tac sortref = distribute_tac (fun status goal ->
let goalty = get_goalty status goal in
let status,sort = typeof status (ctx_of goalty) goalty in
- let sort = fix_sorts sort in
+ let status, sort = fix_sorts status sort in
let status, sort = term_of_cic_term status sort (ctx_of goalty) in
sortref := sort;
status)
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])