adbrucker
/
lh-l4v
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

lib: add warnings to crunch_ignore 

These warn when attempting to add a constant to crunch_ignore that is
already being ignored, or when removing a constant that is not being ignored.

Signed-off-by: Corey Lewis <corey.lewis@proofcraft.systems>
This commit is contained in:
Corey Lewis 2022-05-27 14:59:02 +10:00
parent 141983368b
commit 71b208edf5
4 changed files with 35 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lib/Crunch.ML
View File

@ -10,7 +10,7 @@ structure CrunchTheoryData = Theory_Data
((Token.src list -> string -> string
-> (string * ((Facts.ref * Token.src list), xstring) sum) list
-> string list -> local_theory -> local_theory)
* (string list -> string list -> theory -> theory)) Symtab.table
* (string list -> string list -> local_theory -> local_theory)) Symtab.table
val empty = Symtab.empty
val merge = Symtab.merge (fn _ => true);
end);
@ -132,10 +132,8 @@ val crunch_ignoreP =
| SOME x => snd x);
val crunch_ignore_add_dels =
map (fn inst => crunch_ignore_add_del inst add del) crunch_instances
val crunch_ignore_add_dels' =
fold (curry (op #>)) (tl crunch_ignore_add_dels) (hd crunch_ignore_add_dels)
in
Local_Theory.raw_theory crunch_ignore_add_dels' lthy
fold (curry (op #>)) crunch_ignore_add_dels I lthy
end));
end;

8
lib/Crunch_Instances_NonDet.thy
View File

@ -137,16 +137,16 @@ structure CrunchValidE : CRUNCH = Crunch(CrunchValidEInstance);
\<close>
setup \<open>
add_crunch_instance "" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_del)
add_crunch_instance "" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_dels)
\<close>
setup \<open>
add_crunch_instance "valid" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_del)
add_crunch_instance "valid" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_dels)
\<close>
setup \<open>
add_crunch_instance "no_fail" (CrunchNoFail.crunch_x, CrunchNoFail.crunch_ignore_add_del)
add_crunch_instance "no_fail" (CrunchNoFail.crunch_x, CrunchNoFail.crunch_ignore_add_dels)
\<close>
setup \<open>
add_crunch_instance "empty_fail" (CrunchEmptyFail.crunch_x, CrunchEmptyFail.crunch_ignore_add_del)
add_crunch_instance "empty_fail" (CrunchEmptyFail.crunch_x, CrunchEmptyFail.crunch_ignore_add_dels)
\<close>
end

8
lib/Crunch_Instances_Trace.thy
View File

@ -136,16 +136,16 @@ structure CrunchPrefixClosed : CRUNCH = Crunch(CrunchPrefixClosedInstance);
\<close>
setup \<open>
add_crunch_instance "" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_del)
add_crunch_instance "" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_dels)
\<close>
setup \<open>
add_crunch_instance "valid" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_del)
add_crunch_instance "valid" (CrunchValid.crunch_x, CrunchValid.crunch_ignore_add_dels)
\<close>
setup \<open>
add_crunch_instance "no_fail" (CrunchNoFail.crunch_x, CrunchNoFail.crunch_ignore_add_del)
add_crunch_instance "no_fail" (CrunchNoFail.crunch_x, CrunchNoFail.crunch_ignore_add_dels)
\<close>
setup \<open>
add_crunch_instance "pfx_closed" (CrunchPrefixClosed.crunch_x, CrunchPrefixClosed.crunch_ignore_add_del)
add_crunch_instance "pfx_closed" (CrunchPrefixClosed.crunch_x, CrunchPrefixClosed.crunch_ignore_add_dels)
\<close>
end

32
lib/crunch-cmd.ML
View File

@ -161,7 +161,7 @@ sig
-> (string * ((Facts.ref * Token.src list), xstring) sum) list
-> string list -> local_theory -> local_theory;
val crunch_ignore_add_del : string list -> string list -> theory -> theory
val crunch_ignore_add_dels : string list -> string list -> local_theory -> local_theory
val mism_term_trace : (term * extra) list Unsynchronized.ref
end
@ -182,14 +182,32 @@ structure CrunchIgnore = Theory_Data
val merge = Library.merge (op =);
end);
fun crunch_ignore_add thms thy =
CrunchIgnore.map (curry (Library.merge (op =)) thms) thy
fun crunch_ignore_add' thm =
CrunchIgnore.map (curry (Library.merge (op =)) [thm])
fun crunch_ignore_del thms thy =
CrunchIgnore.map (Library.subtract (op =) thms) thy
fun crunch_ignore_add thm lthy =
if Library.member (op =) (CrunchIgnore.get (Proof_Context.theory_of lthy)) thm
then (Proof_Context.markup_const lthy thm ^ " is already in the crunch ignore set for "
^ Instance.name |> warning; lthy)
else Local_Theory.raw_theory (crunch_ignore_add' thm) lthy;
fun crunch_ignore_add_del adds dels =
crunch_ignore_add adds #> crunch_ignore_del dels
fun crunch_ignore_adds thms =
fold (curry (op #>)) (map crunch_ignore_add thms) I;
fun crunch_ignore_del' thm =
CrunchIgnore.map (Library.subtract (op =) [thm])
fun crunch_ignore_del thm lthy =
if Library.member (op =) (CrunchIgnore.get (Proof_Context.theory_of lthy)) thm
then Local_Theory.raw_theory (crunch_ignore_del' thm) lthy
else (Proof_Context.markup_const lthy thm ^ " is not in the crunch ignore set for "
^ Instance.name |> warning; lthy);
fun crunch_ignore_dels thms =
fold (curry (op #>)) (map crunch_ignore_del thms) I;
fun crunch_ignore_add_dels adds dels =
crunch_ignore_adds adds #> crunch_ignore_dels dels
fun crunch_ignores cfg ctxt =
subtract (op =) (#ig_dels cfg) (#igs cfg @ CrunchIgnore.get (Proof_Context.theory_of ctxt))