Commit a761ee45 authored by charguer's avatar charguer

restructure cf tactic notation

parent 76cbd8d1
......@@ -10,7 +10,8 @@ License: MIT.
From Sep Require Export LambdaSepLifted LambdaCFLifted.
From Sep Require Export LambdaStructLifted.
From TLC Require Export LibListZ.
From TLC Require Export LibList LibListZ.
Open Scope liblist_scope.
Open Scope Z_scope.
(* Open Scope charac. TODO: not needed? *)
......
......@@ -220,7 +220,8 @@ Lemma rule_test_mkcounter :
\[]
(fun r => \[r = 3]).
Proof using.
xcf. xapp as C.
xcf_trm 100%nat. (* todo: make xcf work *)
xapp as C.
xapps Rule_MCount.
xapps Rule_MCount.
xapps.
......
......@@ -30,6 +30,10 @@ Definition MQueue (L:list val) (p:loc) :=
Hexists (pf:loc), Hexists (pb:loc), Hexists (vx:val), Hexists (vy:val),
MCell pf pb p \* MListSeg pb L pf \* MCell vx vy pb.
(* ---------------------------------------------------------------------- *)
(** Create *)
Definition val_create :=
ValFun 'v :=
Let 'r := val_alloc 2 in
......
This diff is collapsed.
......@@ -11,6 +11,7 @@ License: MIT.
Set Implicit Arguments.
From Sep Require Import LambdaCF LambdaStruct.
From TLC Require Import LibList.
Generalizable Variables A B.
Ltac auto_star ::= jauto.
......
......@@ -10,7 +10,7 @@ License: MIT.
Set Implicit Arguments.
From TLC Require Export LibFix.
From Sep Require Export LambdaSep.
From Sep Require Export LambdaSepRO LambdaCFTactics.
Open Scope heap_scope.
Implicit Types v w : val.
......@@ -408,7 +408,7 @@ Notation "'Register_spec' f" := (Register_rule (trm_apps (trm_val f) _))
the specification that could apply to a goal [G].
It places the specification as hypothesis at the head of the goal. *)
Ltac xapp_basic_prepare tt := (* defined further *)
Ltac xapp_basic_prepare tt ::= (* actually defined further *)
idtac.
Ltac xspec_context G := (* refined only in LambdaCFLifted *)
......@@ -449,41 +449,21 @@ Hint Extern 1 (Register_spec (val_prim val_ptr_add)) => Provide rule_ptr_add.
(* ********************************************************************** *)
(* * Tactics for progressing through proofs *)
(** Extends tactics defined in [LambdaCFTactics.v] *)
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xcf] *)
Ltac xcf_get_fun_remove_encs f :=
constr:(f).
Ltac xcf_get_fun_from_trm t :=
match t with
| trm_apps (trm_val ?f) _ => xcf_get_fun_remove_encs f
| trm_app ?t1 ?t2 =>
match t1 with
| trm_app ?t11 ?t12 => xcf_get_fun_from_trm t1
| ?f => xcf_get_fun_remove_encs f
end
end.
Ltac xcf_get_fun_from_goal tt :=
Ltac xcf_get_fun_from_goal tt ::=
match goal with |- triple ?t _ _ => xcf_get_fun_from_trm t end.
Ltac xcf_get_fun tt :=
xcf_get_fun_from_goal tt.
Ltac xcf_reveal_fun tt :=
try (let f := xcf_get_fun tt in
first [ unfold f
| match goal with H: f = _ |- _ => rewrite H end ]).
Ltac xcf_post tt :=
simpl.
Ltac xcf_trm n :=
Ltac xcf_trm n ::=
applys triple_trm_of_cf_iter n; [ xcf_post tt ].
Ltac xcf_basic_fun n f' :=
Ltac xcf_basic_fun n f' ::=
let f := xcf_get_fun tt in
match f with
| val_funs _ _ => (* TODO: use (apply (@..)) instead of applys? same in cflifted *)
......@@ -497,79 +477,37 @@ Ltac xcf_basic_fun n f' :=
| xcf_post tt ]
end.
Ltac xcf_prepare_args tt :=
rew_nary.
Ltac xcf_fun n :=
xcf_prepare_args tt;
let f' := xcf_get_fun tt in
xcf_reveal_fun tt;
rew_nary;
rew_vals_to_trms;
xcf_basic_fun n f'.
Ltac xcf_core n :=
intros; first [ xcf_fun n | xcf_trm n ].
Tactic Notation "xcf" :=
xcf_core 100%nat.
Tactic Notation "xcf_depth" constr(depth) :=
xcf_core depth.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xseq] *)
Ltac xseq_core tt :=
Ltac xseq_core tt ::=
applys local_erase; esplit; split.
Tactic Notation "xseq" :=
xseq_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xlet] *)
Ltac xlet_core tt :=
Ltac xlet_core tt ::=
applys local_erase; esplit; split.
Tactic Notation "xlet" :=
xlet_core tt.
Ltac xlet_as_core X :=
xlet_core tt; [ | intros X ].
Tactic Notation "xlet" "as" simple_intropattern(X) :=
xlet_as_core X.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xif] *)
Ltac xif_post tt :=
rew_bool_eq.
Ltac xif_core tt :=
Ltac xif_core tt ::=
applys local_erase; esplit; splits;
[ try reflexivity
| xif_post tt
| xif_post tt ].
Tactic Notation "xif" :=
xif_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xfail] *)
Ltac xfail_core tt :=
Ltac xfail_core tt ::=
applys local_erase; unfold cf_fail.
Tactic Notation "xfail" :=
xfail_core tt.
(* ---------------------------------------------------------------------- *)
(* * [xapp] and [xapps] and [xapp as] *)
......@@ -588,19 +526,25 @@ Tactic Notation "xfail" :=
*)
Ltac xapp_let_cont tt :=
Ltac hpull_cont tt ::=
try hpull.
Ltac hsimpl_cont tt ::=
hsimpl.
Ltac xapp_let_cont tt ::=
let X := fresh "X" in intros X;
instantiate; try xpull; gen X.
Ltac xapp_as_let_cont tt :=
Ltac xapp_as_let_cont tt ::=
instantiate; try xpull.
Ltac xapps_let_cont tt :=
Ltac xapps_let_cont tt ::=
let X := fresh "X" in intros X;
instantiate; try xpull;
first [ intro_subst | gen X ].
Ltac xapp_template xlet_tactic xapp_tactic xlet_cont :=
Ltac xapp_template xlet_tactic xapp_tactic xlet_cont ::=
match goal with
| |- local (cf_let _ _) _ _ => xlet_tactic tt; [ xapp_tactic tt | xlet_cont tt ]
| |- local (cf_if _ _ _) _ _ => xlet_tactic tt; [ xapp_tactic tt | xlet_cont tt ]
......@@ -620,13 +564,7 @@ Ltac xapp_basic_prepare tt ::=
try match goal with |- local _ _ _ => apply local_erase end;
rew_nary.
Ltac hpull_cont tt :=
try hpull.
Ltac hsimpl_cont tt :=
hsimpl.
Ltac xapp_with_args E cont_xapply :=
Ltac xapp_with_args E cont_xapply ::=
match E with
| __ => (* no spec provided *)
let S := fresh "Spec" in
......@@ -647,75 +585,11 @@ Ltac xapp_with_args E cont_xapply :=
end
end.
Ltac xapp_basic E cont_post tt :=
Ltac xapp_basic E cont_post tt ::=
xapp_basic_prepare tt;
xapp_with_args E ltac:(fun H =>
xapp_xapply H cont_post).
Ltac xapp_debug tt :=
xapp_basic_prepare tt;
xapp_with_args __ ltac:(fun H => generalize H).
Ltac xapp_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ idcont) ltac:(xapp_let_cont).
Ltac xapp_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E idcont) ltac:(xapp_let_cont).
Ltac xapp_as_core X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic __ idcont) ltac:(xapp_as_let_cont).
Ltac xapp_arg_as_core E X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic E idcont) ltac:(xapp_as_let_cont).
Ltac xapps_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ hpull_cont) ltac:(xapps_let_cont).
Ltac xapps_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E hpull_cont) ltac:(xapps_let_cont).
Tactic Notation "xapp" :=
xapp_core tt.
Tactic Notation "xapp" "~" :=
xapp; auto_tilde.
Tactic Notation "xapp" "*" :=
xapp; auto_star.
Tactic Notation "xapp" constr(E) :=
xapp_arg_core E.
Tactic Notation "xapp" "~" constr(E) :=
xapp E; auto_tilde.
Tactic Notation "xapp" "*" constr(E) :=
xapp E; auto_star.
Tactic Notation "xapps" :=
xapps_core tt.
Tactic Notation "xapps" "~" :=
xapps; auto_tilde.
Tactic Notation "xapps" "*" :=
xapps; auto_star.
Tactic Notation "xapps" constr(E) :=
xapps_arg_core E.
Tactic Notation "xapps" "~" constr(E) :=
xapps E; auto_tilde.
Tactic Notation "xapps" "*" constr(E) :=
xapps E; auto_star.
Tactic Notation "xapp" "as" simple_intropattern(X) :=
xapp_as_core X.
Tactic Notation "xapp" "~" "as" simple_intropattern(X) :=
xapp as X; auto_tilde.
Tactic Notation "xapp" "*" "as" simple_intropattern(X) :=
xapp as X; auto_star.
Tactic Notation "xapp" constr(E) "as" simple_intropattern(X) :=
xapp_arg_as_core E X.
Tactic Notation "xapp" "~" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_tilde.
Tactic Notation "xapp" "*" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_star.
(* TODO: xapps should do hsimpl if not in a let *)
......@@ -762,42 +636,21 @@ Ltac xval_as_basic X EX :=
| _ => applys xval_htop_as_lemma; intros X EX
end.
Ltac xval_core tt :=
Ltac xval_core tt ::=
xval_template ltac:(fun tt => xlet) ltac:(xval_basic) ltac:(xapp_let_cont).
Ltac xval_as_core X :=
Ltac xval_as_core X ::=
match goal with
| |- local (cf_val _) _ _ => let EX := fresh "E" X in xval_as_basic X EX
| _ => xval_template ltac:(fun tt => xlet as X) ltac:(xval_basic) ltac:(xapp_as_let_cont)
end.
Ltac xvals_core tt :=
Ltac xvals_core tt ::=
match goal with
| |- local (cf_val _) _ _ => xval_basic tt; hsimpl
| _ => xval_template ltac:(fun tt => xlet) ltac:(xval_basic) ltac:(xapps_let_cont)
end.
Tactic Notation "xval" :=
xval_core tt.
Tactic Notation "xval" "~" :=
xval; auto_tilde.
Tactic Notation "xval" "*" :=
xval; auto_star.
Tactic Notation "xvals" :=
xvals_core tt.
Tactic Notation "xvals" "~" :=
xvals; auto_tilde.
Tactic Notation "xvals" "*" :=
xvals; auto_star.
Tactic Notation "xval" "as" simple_intropattern(X) :=
xval_as_core X.
Tactic Notation "xval" "~" "as" simple_intropattern(X) :=
xval as X; auto_tilde.
Tactic Notation "xval" "*" "as" simple_intropattern(X) :=
xval as X; auto_star.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xwhile] *)
......@@ -808,28 +661,21 @@ Ltac xwhile_template xwhile_tactic xseq_cont :=
| _ => xwhile_tactic tt
end.
Ltac xwhile_intros_all R LR HR :=
Ltac xwhile_intros_all R LR HR ::=
intros R LR; hnf; intros HR.
Ltac xwhile_intros R :=
Ltac xwhile_intros R ::=
let LR := fresh "L" R in
let HR := fresh "H" R in
xwhile_intros_all R LR HR.
Ltac xwhile_basic xwhile_intros_tactic :=
Ltac xwhile_basic xwhile_intros_tactic ::=
applys local_erase;
xwhile_intros_tactic tt.
Ltac xwhile_core xwhile_tactic :=
Ltac xwhile_core xwhile_tactic ::=
xwhile_template ltac:(xwhile_tactic) ltac:(fun tt => xpull).
Tactic Notation "xwhile" "as" ident(R) :=
xwhile_core ltac:(fun tt => xwhile_basic ltac:(fun tt => xwhile_intros R)).
Tactic Notation "xwhile" "as" ident(R) ident(LR) ident(HR) :=
xwhile_core ltac:(fun tt => xwhile_basic ltac:(fun tt => xwhile_intros_all R LR HR)).
(* ********************************************************************** *)
......
......@@ -13,7 +13,7 @@ License: MIT.
Set Implicit Arguments.
From TLC Require Export LibCore.
From Sep Require Export LambdaCF LambdaSepLifted.
Import LibList.
From TLC Require Import LibList.
Generalizable Variables A B.
Open Scope charac.
......@@ -404,6 +404,8 @@ Qed.
(* ********************************************************************** *)
(* * CFLifted tactics *)
(** Extends tactics defined in [LambdaCFTactics.v] and [LambdaCF.v] *)
(* ---------------------------------------------------------------------- *)
(* ** Registering specifications *)
......
This diff is collapsed.
(**
This file defines tactic notations useful for characteristic formulae
Author: Arthur Charguéraud.
License: MIT.
*)
Set Implicit Arguments.
From Sep Require Export LambdaSemantics.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xcf] *)
Ltac xcf_trm n :=
fail "not instantiated".
Ltac xcf_basic_fun n f' :=
fail "not instantiated".
Ltac xcf_get_fun_remove_encs f :=
constr:(f).
Ltac xcf_get_fun_from_trm t :=
match t with
| trm_apps (trm_val ?f) _ => xcf_get_fun_remove_encs f
| trm_app ?t1 ?t2 =>
match t1 with
| trm_app ?t11 ?t12 => xcf_get_fun_from_trm t1
| ?f => xcf_get_fun_remove_encs f
end
end.
Ltac xcf_get_fun_from_goal tt :=
fail "not instantiated".
Ltac xcf_get_fun tt :=
xcf_get_fun_from_goal tt.
Ltac xcf_reveal_fun tt :=
try (let f := xcf_get_fun tt in
first [ unfold f
| match goal with H: f = _ |- _ => rewrite H end ]).
Ltac xcf_prepare_args tt :=
rew_nary.
Ltac xcf_fun n :=
xcf_prepare_args tt;
let f' := xcf_get_fun tt in
xcf_reveal_fun tt;
rew_nary;
rew_vals_to_trms;
xcf_basic_fun n f'.
Ltac xcf_core n :=
intros; first [ xcf_fun n | xcf_trm n ].
Tactic Notation "xcf" :=
xcf_core 100%nat.
Tactic Notation "xcf_depth" constr(depth) :=
xcf_core depth.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xseq] *)
Ltac xseq_core tt :=
fail "not instantiated".
Tactic Notation "xseq" :=
xseq_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xlet] *)
Ltac xlet_core tt :=
fail "not instantiated".
Tactic Notation "xlet" :=
xlet_core tt.
Ltac xlet_as_core X :=
xlet_core tt; [ | intros X ].
Tactic Notation "xlet" "as" simple_intropattern(X) :=
xlet_as_core X.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xif] *)
Ltac xif_post tt :=
rew_bool_eq.
Ltac xif_core tt :=
fail "not instantiated".
Tactic Notation "xif" :=
xif_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xfail] *)
Ltac xfail_core tt :=
fail "not instantiated".
Tactic Notation "xfail" :=
xfail_core tt.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xapp] *)
Ltac hpull_cont tt :=
fail "not instantiated".
Ltac hsimpl_cont tt :=
fail "not instantiated".
Ltac xapp_let_cont tt :=
fail "not instantiated".
Ltac xapp_as_let_cont tt :=
fail "not instantiated".
Ltac xapps_let_cont tt :=
fail "not instantiated".
Ltac xapp_template xlet_tactic xapp_tactic xlet_cont :=
fail "not instantiated".
Ltac xapp_basic_prepare tt :=
fail "not instantiated".
Ltac xapp_with_args E cont_xapply :=
fail "not instantiated".
Ltac xapp_basic E cont_post tt :=
fail "not instantiated".
Ltac xapp_debug tt :=
xapp_basic_prepare tt;
xapp_with_args __ ltac:(fun H => generalize H).
Ltac xapp_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ idcont) ltac:(xapp_let_cont).
Ltac xapp_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E idcont) ltac:(xapp_let_cont).
Ltac xapp_as_core X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic __ idcont) ltac:(xapp_as_let_cont).
Ltac xapp_arg_as_core E X :=
xapp_template ltac:(fun tt => xlet as X) ltac:(xapp_basic E idcont) ltac:(xapp_as_let_cont).
Ltac xapps_core tt :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic __ hpull_cont) ltac:(xapps_let_cont).
Ltac xapps_arg_core E :=
xapp_template ltac:(fun tt => xlet) ltac:(xapp_basic E hpull_cont) ltac:(xapps_let_cont).
Tactic Notation "xapp" :=
xapp_core tt.
Tactic Notation "xapp" "~" :=
xapp; auto_tilde.
Tactic Notation "xapp" "*" :=
xapp; auto_star.
Tactic Notation "xapp" constr(E) :=
xapp_arg_core E.
Tactic Notation "xapp" "~" constr(E) :=
xapp E; auto_tilde.
Tactic Notation "xapp" "*" constr(E) :=
xapp E; auto_star.
Tactic Notation "xapps" :=
xapps_core tt.
Tactic Notation "xapps" "~" :=
xapps; auto_tilde.
Tactic Notation "xapps" "*" :=
xapps; auto_star.
Tactic Notation "xapps" constr(E) :=
xapps_arg_core E.
Tactic Notation "xapps" "~" constr(E) :=
xapps E; auto_tilde.
Tactic Notation "xapps" "*" constr(E) :=
xapps E; auto_star.
Tactic Notation "xapp" "as" simple_intropattern(X) :=
xapp_as_core X.
Tactic Notation "xapp" "~" "as" simple_intropattern(X) :=
xapp as X; auto_tilde.
Tactic Notation "xapp" "*" "as" simple_intropattern(X) :=
xapp as X; auto_star.
Tactic Notation "xapp" constr(E) "as" simple_intropattern(X) :=
xapp_arg_as_core E X.
Tactic Notation "xapp" "~" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_tilde.
Tactic Notation "xapp" "*" constr(E) "as" simple_intropattern(X) :=
xapp E as X; auto_star.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xval] and [xvals] *)
Ltac xval_core tt :=
fail "not instantiated".
Ltac xval_as_core X :=
fail "not instantiated".
Ltac xvals_core tt :=
fail "not instantiated".
Tactic Notation "xval" :=
xval_core tt.
Tactic Notation "xval" "~" :=
xval; auto_tilde.
Tactic Notation "xval" "*" :=
xval; auto_star.
Tactic Notation "xvals" :=
xvals_core tt.
Tactic Notation "xvals" "~" :=
xvals; auto_tilde.
Tactic Notation "xvals" "*" :=
xvals; auto_star.
Tactic Notation "xval" "as" simple_intropattern(X) :=
xval_as_core X.
Tactic Notation "xval" "~" "as" simple_intropattern(X) :=
xval as X; auto_tilde.
Tactic Notation "xval" "*" "as" simple_intropattern(X) :=
xval as X; auto_star.
(* ---------------------------------------------------------------------- *)
(* ** Tactic [xwhile] *)
Ltac xwhile_intros_all R LR HR :=
fail "not instantiated".
Ltac xwhile_intros R :=
fail "not instantiated".
Ltac xwhile_basic xwhile_intros_tactic :=
fail "not instantiated".
Ltac xwhile_core xwhile_tactic :=
fail "not instantiated".
Tactic Notation "xwhile" "as" ident(R) :=
xwhile_core ltac:(fun tt => xwhile_basic ltac:(fun tt => xwhile_intros R)).
Tactic Notation "xwhile" "as" ident(R) ident(LR) ident(HR) :=
xwhile_core ltac:(fun tt => xwhile_basic ltac:(fun tt => xwhile_intros_all R LR HR)).
......@@ -13,6 +13,7 @@ From TLC Require LibListZ.
From Sep Require Import LambdaCF TLCbuffer.
Open Scope trm_scope.
Open Scope heap_scope.
Open Scope liblist_scope.
Open Scope charac.
Ltac auto_star ::= jauto.
......
......@@ -10,6 +10,7 @@ License: MIT.
Set Implicit Arguments.
From Sep Require Export LambdaStruct LambdaCFLifted.
From TLC Require Import LibList.
Open Scope trm_scope.
Open Scope charac.
Generalizable Variables A.
......
......@@ -14,7 +14,7 @@ COQFLAGS:=-w -notation-overridden,-implicits-in-term
# Compilation.
# Note: double space below is important for export.sh
SRC := TLCbuffer Fmap SepFunctor SepTactics LambdaSemantics LambdaSep LambdaCF LambdaStruct LambdaSepLifted LambdaCFLifted LambdaStructLifted Example ExampleBasicNonlifted ExampleListNonlifted ExampleQueueNonlifted ExampleBasic ExampleTrees ExampleUnionFind ExampleHigherOrder LambdaSepCredits LambdaCFCredits LambdaSepRO ExampleList
SRC := TLCbuffer Fmap SepFunctor SepTactics LambdaSemantics LambdaSep LambdaCFTactics LambdaCF LambdaStruct LambdaSepLifted LambdaCFLifted LambdaStructLifted Example ExampleBasicNonlifted ExampleListNonlifted ExampleQueueNonlifted ExampleBasic ExampleTrees ExampleUnionFind ExampleHigherOrder LambdaSepCredits LambdaCFCredits LambdaSepRO ExampleList
# The official list of files that should be compiled by [make]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment