110 lines
3.3 KiB
Plaintext
110 lines
3.3 KiB
Plaintext
(*
|
|
* Copyright 2014, NICTA
|
|
*
|
|
* This software may be distributed and modified according to the terms of
|
|
* the BSD 2-Clause license. Note that NO WARRANTY is provided.
|
|
* See "LICENSE_BSD2.txt" for details.
|
|
*
|
|
* @TAG(NICTA_BSD)
|
|
*)
|
|
|
|
theory AutoLevity_Run
|
|
imports AutoLevity
|
|
begin
|
|
|
|
(* Custom run of AutoLevity for seL4 *)
|
|
|
|
(* Requires up-to-date graph report *)
|
|
(* Might be worth just running the report in-place instead of reading in seralized one*)
|
|
(*TODO: Warn on revision mismatch?*)
|
|
|
|
|
|
ML {*fun generic_facts_of spec_theories excluded_theories (spec_graph : Spec_Graph.graph_entry Int_Graph.T) (proof_graph : Proof_Graph.proof_entry String_Graph.T) =
|
|
let
|
|
fun in_theory i = member (op =) spec_theories (#theory (Int_Graph.get_node spec_graph i))
|
|
fun is_excluded n = member (op =) excluded_theories (Long_Name.explode n |> hd)
|
|
|
|
(* The most fine-grained filter for "general" lemmas *)
|
|
fun any_contains n =
|
|
let
|
|
val e = String_Graph.get_node proof_graph n
|
|
in
|
|
exists (in_theory) (#contains e)
|
|
orelse (#kind e) = Proof_Count.Crunch
|
|
orelse (#kind e) = Proof_Count.Other
|
|
end
|
|
|
|
|
|
fun remove_contains n g = if any_contains n then
|
|
fold (String_Graph.del_node) (String_Graph.all_preds g [n] handle String_Graph.UNDEF _ => []) g
|
|
else
|
|
g
|
|
|
|
in
|
|
fold remove_contains (String_Graph.keys proof_graph) proof_graph
|
|
|> String_Graph.dest
|
|
|> map fst
|
|
|> filter_out (fn (n,e) => #lines e = (~1,~1) orelse is_excluded n) end
|
|
*}
|
|
|
|
(*Theories whose constants are considered part of the seL4 spec/proof *)
|
|
ML {* val spec_theories = Symtab.dest thy_deps
|
|
|> map_filter (fn (nm,(f,_)) =>
|
|
if String.isSubstring "~~/../l4v/proof/" f orelse
|
|
String.isSubstring "~~/../l4v/spec/" f orelse
|
|
String.isSubstring "~~/../l4v/tools/c-parser/" f then SOME nm else NONE)
|
|
|> cons "ProofGraph_Serialize_InfoflowC"
|
|
|> cons "TypHeapLib"
|
|
|> cons "TypHeap"
|
|
|> cons "BCorres_UL"
|
|
|> cons "LemmaBucket_C"
|
|
|> cons "WPC"
|
|
*}
|
|
|
|
(*Theories which are not to be considered for levitation *)
|
|
ML {* val excluded_theories = Symtab.dest thy_deps
|
|
|> map_filter (fn (nm,(f,_)) =>
|
|
if String.isSubstring "~~/../l4v/lib" f orelse
|
|
String.isSubstring "~~/../l4v/spec/cspec" f orelse
|
|
String.isSubstring "~~/../l4v/spec/abstract" f orelse
|
|
String.isSubstring "~~/../l4v/isabelle/" f then SOME nm else NONE)
|
|
|> cons "EmptyFail"
|
|
|> cons "EmptyFail_H"
|
|
|> cons "CLevityCatch"
|
|
*}
|
|
|
|
|
|
|
|
ML {* val gen_facts = generic_facts_of spec_theories excluded_theories full_spec proof_spec *}
|
|
|
|
|
|
(*TODO: Some taint analysis to avoid overwriting modified proofs?*)
|
|
ML {*
|
|
|
|
let
|
|
val _ = Isabelle_System.bash "rm -r $ISABELLE_HOME/../lib/autolevity_buckets"
|
|
val _ = Isabelle_System.mkdir (Path.explode "~~/../l4v/lib/autolevity_buckets")
|
|
|
|
in
|
|
() end
|
|
*}
|
|
|
|
|
|
ML {* val sorted = sort_lemmas (proof_spec,full_spec,thy_deps) (spec_theories) gen_facts
|
|
|> parse_attribs*}
|
|
|
|
(*Debug flag writes out original thm dependencies after the proof *)
|
|
ML {* write_thys true sorted (Path.explode "~~/../l4v/lib/autolevity_buckets/") *}
|
|
|
|
(*CAREFUL: This line refactors the proof to remove bucketed lemmas *)
|
|
(*NOTE: Running this twice in a row will fail for obvious reasons.
|
|
Revert the proof before attempting to run it again*)
|
|
|
|
ML {* val refactor_proof = true
|
|
|
|
val _ = if refactor_proof then clear_thys thy_deps sorted else () *}
|
|
|
|
|
|
end
|
|
|