X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_tactics%2FnTactics.ml;h=93d8c965c41e1b6181cf29d7f2808e20265992bc;hb=a0b7db9844126ebcdf4b5dbb586514854cef5d93;hp=019aac2f1e328e8ca78b2331b218b42608a237c3;hpb=d3d800c2489ea484c5e9891f494ca8b07a681c15;p=helm.git diff --git a/helm/software/components/ng_tactics/nTactics.ml b/helm/software/components/ng_tactics/nTactics.ml index 019aac2f1..93d8c965c 100644 --- a/helm/software/components/ng_tactics/nTactics.ml +++ b/helm/software/components/ng_tactics/nTactics.ml @@ -22,7 +22,7 @@ module Ast = CicNotationPt let id_tac status = status ;; let print_tac print_status message status = - if print_status then pp_status status; + if print_status then pp_tac_status status; prerr_endline message; status ;; @@ -261,10 +261,13 @@ let repeat_tac t s = let try_tac tac status = + let try_tac status = try tac status with NTacStatus.Error _ -> status + in + atomic_tac try_tac status ;; let first_tac tacl status = @@ -371,7 +374,7 @@ let select0_tac ~where:(wanted,hyps,where) ~job = let status, instance = mk_meta status newgoalctx (`Decl newgoalty) `IsTerm in - instantiate status goal instance) + instantiate ~refine:false status goal instance) ;; let select_tac ~where ~job move_down_hyps = @@ -420,12 +423,12 @@ let generalize_tac ~where = ;; let cut_tac t = - block_tac [ + atomic_tac (block_tac [ exact_tac ("",0, Ast.Appl [Ast.Implicit `JustOne; Ast.Implicit `JustOne]); branch_tac; pos_tac [3]; exact_tac t; shift_tac; pos_tac [2]; skip_tac; - merge_tac ] + merge_tac ]) ;; let lapply_tac (s,n,t) = @@ -473,8 +476,6 @@ type indtyinfo = { rightno: int; leftno: int; consno: int; - lefts: NCic.term list; - rights: NCic.term list; reference: NReference.reference; } ;; @@ -482,7 +483,7 @@ type indtyinfo = { let ref_of_indtyinfo iti = iti.reference;; let analyze_indty_tac ~what indtyref = - distribute_tac (fun status goal -> + 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, ty_what = typeof status (ctx_of what) what in @@ -490,10 +491,9 @@ let analyze_indty_tac ~what indtyref = let leftno = List.length lefts in let rightno = List.length rights in indtyref := Some { - rightno = rightno; leftno = leftno; consno = consno; - lefts = lefts; rights = rights; reference = r; + rightno = rightno; leftno = leftno; consno = consno; reference = r; }; - exec id_tac status goal) + exec id_tac orig_status goal) ;; let sort_of_goal_tac sortref = distribute_tac (fun status goal -> @@ -540,6 +540,7 @@ let rewrite_tac ~dir ~what:(_,_,what) ~where status = `LeftToRight -> "eq" ^ suffix ^ "_r" | `RightToLeft -> "eq" ^ suffix in + let what = Ast.Appl [what; Ast.Implicit `Vector] in block_tac [ select_tac ~where ~job:(`Substexpand 2) true; exact_tac @@ -556,6 +557,25 @@ let intro_tac name = if name = "_" then clear_tac [name] else id_tac ] ;; +let name_counter = ref 0;; +let intros_tac ?names_ref names s = + let names_ref, prefix = + match names_ref with | None -> ref [], "__" | Some r -> r, "H" + in + if names = [] then + repeat_tac + (fun s -> + incr name_counter; + (* TODO: generate better names *) + let name = prefix ^ string_of_int !name_counter in + let s = intro_tac name s in + names_ref := !names_ref @ [name]; + s) + s + else + block_tac (List.map intro_tac names) s +;; + let cases ~what status goal = let gty = get_goalty status goal in let status, what = disambiguate status (ctx_of gty) what None in