Commit 11e082f4 by charguer

### progress_tactics

parent 3d98a723
This diff is collapsed.
 ... ... @@ -8,47 +8,6 @@ open Pervasives *) (********************************************************************) (* ** Top-level values *) let top_val_int = 5 let top_val_int_list : int list = [] let top_val_poly_list = [] let top_val_poly_list_pair = ([],[]) (********************************************************************) (* ** Polymorphic functions *) let top_fun_poly_id x = x let top_fun_poly_proj1 (x,y) = x let top_fun_poly_pair_homogeneous (x:'a) (y:'a) = (x,y) (********************************************************************) (* ** Infix functions *) let (+++) x y = x + y let infix_aux x y = x + y let (---) = infix_aux (********************************************************************) (* ** Inlined total functions *) let f () = 1 - 1/(-1) + (2 / 2) mod 3 (********************************************************************) (* ** Return *) ... ... @@ -169,7 +128,6 @@ let app_partial_builtin () = f 2 (********************************************************************) (* ** Over applications *) ... ... @@ -178,6 +136,48 @@ let app_over_id () = f f 3 (********************************************************************) (* ** Infix functions *) let (+++) x y = x + y let infix_aux x y = x + y let (---) = infix_aux (********************************************************************) (* ** Inlined total functions *) let f () = 1 - 1/(-1) + (2 / 2) mod 3 (********************************************************************) (* ** Polymorphic functions *) let top_fun_poly_id x = x let top_fun_poly_proj1 (x,y) = x let top_fun_poly_pair_homogeneous (x:'a) (y:'a) = (x,y) (********************************************************************) (* ** Top-level values *) let top_val_int = 5 let top_val_int_list : int list = [] let top_val_poly_list = [] let top_val_poly_list_pair = ([],[]) (********************************************************************) (* ** Polymorphic let bindings *) ... ... @@ -330,6 +330,9 @@ let for_incr () = done; !n (* "for .. down to" not yet supported *) (********************************************************************) (* ** Recursive function *) ... ...
This diff is collapsed.
 ... ... @@ -95,7 +95,8 @@ cf: \$(ML) # Make sure TLC and CFML itself are up-to-date. # Needed only when developing TLC and CFML. Ideally, should be removed. @\$(MAKE) -C \$(CFML)/lib/tlc --no-print-directory quick @\$(MAKE) -C \$(CFML) --no-print-directory tools coqlib_quick_cf # @\$(MAKE) -C \$(CFML) --no-print-directory tools coqlib_quick_cf @\$(MAKE) -C \$(CFML) --no-print-directory tools coqlib_quick @\$(MAKE) -C \$(CFML)/lib/stdlib --no-print-directory quick @\$(MAKE) CFML=\$(CFML) OCAML_FLAGS=\$(OCAML_FLAGS) COQINCLUDE="\$(COQINCLUDE)" ML="\$(ML)" --no-print-directory -f \$(CFML)/lib/make/Makefile.cf all ... ...
 ... ... @@ -5,7 +5,7 @@ open Renaming (*#########################################################################*) (* ** Conversion of IMPERATIVE characteristic formulae to Coq *) (* ** Conversion of characteristic formulae to Coq *) (* TODO: extract hard coded constants*) ... ...
 ... ... @@ -61,9 +61,8 @@ Ltac cfml_get_tag tt := (** [cfml_check_not_tagged tt] fails if the head of the goal contains a tag *) Ltac cfml_check_not_tagged tt := match goal with |- @tag ?t _ _ => fail 1 end. Ltac cfml_check_not_tagged tt ::= match goal with |- @tag ?t _ _ => fail 1 | _ => idtac end. (** [xuntag T] removes the tag [T] at the head of the goal, and fails if it is not there. *) ... ...
 ... ... @@ -2082,18 +2082,54 @@ Tactic Notation "xspec" := - [xapps_spec] is not supported, use [xapp_spec], then [subst]. *) (** Debugging for [xapp]: - [xapp1] sets the goal in the right form for [xapp], by calling [xseq] or [xlet], or [xgc] if applicable - [xapp2] looks up the specification for the function and pushes it into the goal. [xapp2_spec H] can be used to provide a custom specification. - [xapp3] exploits the last hypothesis in the goal as a specification and instantiates it using the tactic [forward]. [xapp3 args] can be used to provide arguments. At this point, sides conditions should be discarded. //TODO: [xapp3_skip] can be used to skip all side conditions. - [xapp4] applies the frame rule, exploiting lemma [local_wframe]. - [xapp5] applies the last hypothesis in the goal to the goal. From there, [xsimpl] should be called on the other two goals produced by [xapp4]. - [xapp12] is short for [xapp1; xapp2]. - [xapp45] is short for [xapp4; xapp5]. *) (* TODO: xapp_spec_no_simpl *) (* Retreives only the "app" part of the spec *) (* Retreives only the "app" part of the spec, from the head of the goal, into an hypothesis named [Sf]. *) Ltac xapp_extract_app_from_spec H := Ltac xapp_extract_app_from_spec_as Sf := match goal with | |- (spec _ _ _) -> _ => intros [_ H] (* drops the curried part *) | |- (_) -> _ => intros H | |- (spec _ _ _) -> _ => intros [_ Sf] (* drops the curried part *) | |- (_) -> _ => intros Sf end. Ltac xspec_for_xapp H := xspec; xapp_extract_app_from_spec H. (* [xapp_use_of_find H Sf] creates an hypothesis [Sf] that is equal to [H] if [H] is not [___], else finds a spec for the current function, and names it [Sf]. *) Ltac xapp_use_of_find H Sf := match H with | ___ => xspec | _ => generalize H end; xapp_extract_app_from_spec_as Sf. (* [xapp_prepare_goal] tactic for settings things up *) ... ... @@ -2109,9 +2145,21 @@ Ltac xapp_prepare_goal cont := | tag_seq => xseq; [ xuntag tag_apply; cont tt | instantiate; xextract ] end. Ltac xapp_instantiate H args := Ltac xapp_instantiate Sf args := let args := list_boxer_of args in constr:((boxer H)::args). constr:((boxer Sf)::args). (* [xapp_instantiate_and_apply Sf args xapp_core cont] instantiate the spec [Sf] on the arguments [args], then calls [xapp_core] on the resulting lemma, then calls the continuation on subgoals then clears [Sf]. *) Ltac xapp_instantiate_and_apply Sf args xapp_core cont := let K := xapp_instantiate Sf args in xapp_core K; cont tt; clear Sf. (* [xapp_common] executes [xapp] given [H] as specification (or [___]), ... ... @@ -2122,8 +2170,9 @@ Ltac xapp_instantiate H args := Ltac xapp_common H E xapp_core cont := xapp_prepare_goal ltac:(fun _ => let K := xapp_instantiate H E in xapp_core K; cont tt). let Sf := fresh "Spec" in xapp_use_of_find H Sf; xapp_instantiate_and_apply Sf E xapp_core cont). (* helper for [xapp] internal implementation *) ... ... @@ -2170,6 +2219,73 @@ Ltac xapp_as_core E X := [ xapp_core ___ (>>) ltac:(fun _ => idtac) (* = xapp *) | instantiate; try xextract ]. (* Implementation for [xapp] debugging versions *) Ltac xapp1_core tt := xapp_prepare_goal ltac:(fun _ => idtac). Ltac xapp2_core tt := let Sf := fresh "Spec" in xapp_use_of_find ___ Sf. Ltac xapp2_spec_core H := let Sf := fresh "Spec" in xapp_use_of_find H Sf. Ltac xapp3_core args := let Sf := get_last_hyp tt in let Sfi := fresh "SpecI" in let K := xapp_instantiate Sf args in generalize K; intros Sfi. (* ; clear Sf. *) Ltac xapp4_core tt := eapply local_wframe; [ xlocal | | | ]. Ltac xapp5_core tt := let K := get_last_hyp tt in sapply K. Ltac xapp45_core tt := let K := get_last_hyp tt in xapp_xapply_generic K ltac:(fun _ => idtac) ltac:(fun _ => idtac). (* Notation for [xapp] debugging versions *) Tactic Notation "xapp1" := xapp1_core tt. Tactic Notation "xapp2" := xapp2_core tt. Tactic Notation "xapp2_spec" constr(H) := xapp2_spec_core H. Tactic Notation "xapp12" := xapp1; xapp2_core tt. Tactic Notation "xapp12_spec" constr(H) := xapp1; xapp2_spec_core H. Tactic Notation "xapp3" := xapp3_core (>>). Tactic Notation "xapp3" constr(args) := xapp3_core args. Tactic Notation "xapp4" := xapp4_core tt. Tactic Notation "xapp5" := xapp5_core tt. Tactic Notation "xapp45" := xapp45_core tt. (* FUTURE - [xapp_1] is like [xapp1] - [xapp_2] is like [xapp1; xapp2] - [xapp_3] is like [xapp1; xapp2; xapp3] - [xapp_4] is like [xapp1; xapp2; xapp3; xapp4] - [xapp_5] is like [xapp1; xapp2; xapp3; xapp4; xapp5] Tactic Notation "xapp_1" := xapp1. Tactic Notation "xapp_2" := xapp1; xapp2. Tactic Notation "xapp_2_spec" constr(H) := xapp_1; xapp2_spec H. Tactic Notation "xapp_3" := xapp_2; xapp3. Tactic Notation "xapp_3" constr(args) := xapp_2; xapp3 args. Tactic Notation "xapp_3_spec" constr(H) := xapp_2_spec H; xapp3. Tactic Notation "xapp_3_spec" constr(H) constr(args) := xapp_2_spec H; xapp3 args. Tactic Notation "xapp_4" := xapp_3; xapp4. Tactic Notation "xapp_4" constr(args) := xapp_3 args; xapp4. Tactic Notation "xapp_4_spec" constr(H) := xapp_spec H; xapp4. Tactic Notation "xapp_4_spec" constr(H) constr(args) := xapp_3_spec H args; xapp4. *) (* Notation for [xapp] with automation and with hints *) Tactic Notation "xapp" := ... ... @@ -2485,8 +2601,12 @@ Tactic Notation "xapp" "*" constr(E) "as" simple_intropattern(X) := Variants: - [xcf f] brings to the front of the goal the specification for [f]. - [xcf_show] will only display the CF lemma found in the database, putting it in a fresh hypothesis. - [xcf_show f] is similar, only [f] is provided explicitly. *) (* TODO: extend to support partial application *) ... ... @@ -2526,20 +2646,56 @@ Ltac xcf_core_app f := intros [_ H]; (* curried part not needed *) xcf_core_app_exploit H. (* todo: might need sapply here *) Ltac xcf_top_value f := xcf_find f; let Sf := fresh "Spec" in intros Sf; try (rewrite Sf; clear Sf). Ltac xcf_core tt := intros; match goal with | |- spec ?f ?n ?P => xcf_core_spec f | |- app ?f ?xs ?H ?Q => xcf_core_app f | |- tag tag_apply (app ?f ?xs ?H ?Q) => xuntag tag_apply; xcf_core_app f end . | |- ?f = _ => xcf_top_value f | _ => fail 1 "need to call [xcf f; => H], where [f] is the name of the definition" end. Tactic Notation "xcf" := xcf_core tt. Tactic Notation "xcf" constr(f) := xcf_find f; try match goal with |- tag tag_top_val _ -> _ => let H := fresh in intros H; hnf in H; revert H end. Ltac xcf_show_name f := let H := fresh "S" (*f*) in intros H; try match type of H with tag tag_top_val _ => hnf in H end. (* TODO: can't we make a name based on f? *) Ltac xcf_show_core tt := intros; let f := match goal with | |- spec ?f ?n ?P => constr:(f) | |- app ?f ?xs ?H ?Q => constr:(f) | |- tag tag_apply (app ?f ?xs ?H ?Q) => constr:(f) | |- ?f = _ => constr:(f) | _ => fail 1 "need to call [xcf_show f], where [f] is the name of the definition" end in xcf_find f; xcf_show_name f. Tactic Notation "xcf_show" := let f := cfml_get_goal_fun tt in xcf_find f; let H := fresh "S" f in intros H. xcf_show_core tt. Tactic Notation "xcf_show" constr(f) := xcf_find f; xcf_show_name f. Tactic Notation "xcf" "~" := xcf; xauto_tilde. Tactic Notation "xcf" "*" := xcf; xauto_star. (********************************************************************) ... ...
 ... ... @@ -19,11 +19,11 @@ SRC :=\ CFPrint \ CFHeader \ CFTactics \ CFRep \ CFLib # CFLibCredits \ # CFLibCreditsNat # CFRep \ V := \$(SRC:=.v) ... ...
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!