# HG changeset patch # User haftmann # Date 1350925356 -7200 # Node ID 8b50286c36d3f1ff584ecc64afe505b5056f9988 # Parent ca5ab959c0ae265ae976debf0360fdf59a3f0b7a close code theorems explicitly after preprocessing diff -r ca5ab959c0ae -r 8b50286c36d3 src/Pure/Isar/code.ML --- a/src/Pure/Isar/code.ML Mon Oct 22 17:09:49 2012 +0200 +++ b/src/Pure/Isar/code.ML Mon Oct 22 19:02:36 2012 +0200 @@ -31,6 +31,7 @@ val empty_cert: theory -> string -> cert val cert_of_eqns: theory -> string -> (thm * bool) list -> cert val constrain_cert: theory -> sort list -> cert -> cert + val conclude_cert: cert -> cert val typargs_deps_of_cert: theory -> cert -> (string * sort) list * (string * typ list) list val equations_of_cert: theory -> cert -> ((string * sort) list * typ) * (((term * string option) list * (term * string option)) * (thm option * bool)) list @@ -782,6 +783,13 @@ | constrain_cert thy sorts (Abstract (abs_thm, tyco)) = Abstract (snd (constrain_thm thy (fst (typscheme_abs thy abs_thm)) sorts abs_thm), tyco); +fun conclude_cert (Equations (cert_thm, propers)) = + (Equations (Thm.close_derivation cert_thm, propers)) + | conclude_cert (cert as Projection _) = + cert + | conclude_cert (Abstract (abs_thm, tyco)) = + (Abstract (Thm.close_derivation abs_thm, tyco)); + fun typscheme_of_cert thy (Equations (cert_thm, _)) = fst (get_head thy cert_thm) | typscheme_of_cert thy (Projection (proj, _)) = diff -r ca5ab959c0ae -r 8b50286c36d3 src/Tools/Code/code_preproc.ML --- a/src/Tools/Code/code_preproc.ML Mon Oct 22 17:09:49 2012 +0200 +++ b/src/Tools/Code/code_preproc.ML Mon Oct 22 19:02:36 2012 +0200 @@ -395,7 +395,9 @@ else let val lhs = map_index (fn (k, (v, _)) => (v, snd (Vargraph.get_node vardeps (Fun c, k)))) proto_lhs; - val cert = Code.constrain_cert thy (map (Sign.minimize_sort thy o snd) lhs) proto_cert; + val cert = proto_cert + |> Code.constrain_cert thy (map (Sign.minimize_sort thy o snd) lhs) + |> Code.conclude_cert; val (vs, rhss') = Code.typargs_deps_of_cert thy cert; val eqngr' = Graph.new_node (c, (vs, cert)) eqngr; in (map (pair c) rhss' @ rhss, eqngr') end;