X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_tactics%2FnTactics.ml;h=67568154088e1d54f47c7b6de7662044166354ce;hb=81e3d11cbb2a7a6498b4b19876bbb5ababc8942b;hp=10fa168d492517123eff7b4b18861cb9827cfa47;hpb=2dd6e8f11fa3ac2995f326ecb742d9b4e8948fce;p=helm.git diff --git a/helm/software/components/ng_tactics/nTactics.ml b/helm/software/components/ng_tactics/nTactics.ml index 10fa168d4..675681540 100644 --- a/helm/software/components/ng_tactics/nTactics.ml +++ b/helm/software/components/ng_tactics/nTactics.ml @@ -46,13 +46,14 @@ let dot_tac status = 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 @@ -644,10 +645,33 @@ let assert_tac seqs status = | [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]) ) status ;; +let inversion_tac ~what:(txt,len,what) ~where = + let what = txt, len, Ast.Appl [what; Ast.Implicit `Vector] in + let indtyinfo = ref None in + let sort = ref (NCic.Rel 1) in + atomic_tac (block_tac [ + analyze_indty_tac ~what indtyinfo; + (fun s -> select_tac + ~where ~job:(`Substexpand ((HExtlib.unopt !indtyinfo).rightno+1)) true s); + sort_of_goal_tac sort; + (fun status -> + let ity = HExtlib.unopt !indtyinfo in + let NReference.Ref (uri, _) = ity.reference in + let name = + NUri.name_of_uri uri ^ "_inv_" ^ + snd (NCicElim.ast_of_sort + (match !sort with NCic.Sort x -> x | _ -> assert false)) + in + let eliminator = + let _,_,w = what in + Ast.Appl [ Ast.Ident (name,None) ; Ast.Implicit `Vector ; w ] + in + exact_tac ("",0,eliminator) status) ]) +;;