src/Tools/Code/code_thingol.ML
changeset 55188 7ca0204ece66
parent 55150 0940309ed8f1
child 55189 2f829a3cf9bc
--- a/src/Tools/Code/code_thingol.ML	Thu Jan 30 16:09:03 2014 +0100
+++ b/src/Tools/Code/code_thingol.ML	Thu Jan 30 16:09:04 2014 +0100
@@ -83,8 +83,8 @@
     -> ((Code_Symbol.T * stmt) list * (Code_Symbol.T * stmt) list
       * ((Code_Symbol.T * stmt) list * (Code_Symbol.T * stmt) list)) list
 
-  val read_const_exprs: theory -> string list -> string list * string list
-  val consts_program: theory -> bool -> string list -> program
+  val read_const_exprs: theory -> string list -> string list
+  val consts_program: theory -> string list -> program
   val dynamic_conv: theory -> (program
     -> ((string * sort) list * typscheme) * iterm -> Code_Symbol.T list -> conv)
     -> conv
@@ -743,19 +743,25 @@
 
 (* program generation *)
 
-fun consts_program thy permissive consts =
+fun consts_program_internal thy permissive consts =
   let
-    fun project program =
-      if permissive then program
-      else Code_Symbol.Graph.restrict
-        (member (op =) (Code_Symbol.Graph.all_succs program
-          (map Constant consts))) program;
     fun generate_consts thy algebra eqngr =
       fold_map (ensure_const thy algebra eqngr permissive);
   in
     invoke_generation permissive thy (Code_Preproc.obtain false thy consts [])
       generate_consts consts
     |> snd
+  end;
+
+fun consts_program_permissive thy = consts_program_internal thy true;
+
+fun consts_program thy consts =
+  let
+    fun project program = Code_Symbol.Graph.restrict
+      (member (op =) (Code_Symbol.Graph.all_succs program
+        (map Constant consts))) program;
+  in
+    consts_program_internal thy false consts
     |> project
   end;
 
@@ -838,9 +844,9 @@
   Code_Preproc.static_value thy postproc consts (lift_evaluator thy evaluator consts);
 
 
-(** diagnostic commands **)
+(** constant expressions **)
 
-fun read_const_exprs thy =
+fun read_const_exprs_internal thy =
   let
     fun consts_of thy' = Symtab.fold (fn (c, (_, NONE)) => cons c | _ => I)
       ((snd o #constants o Consts.dest o Sign.consts_of) thy') [];
@@ -859,6 +865,17 @@
       | NONE => ([Code.read_const thy str], []));
   in pairself flat o split_list o map read_const_expr end;
 
+fun read_const_exprs_all thy = op @ o read_const_exprs_internal thy;
+
+fun read_const_exprs thy const_exprs =
+  let
+    val (consts, consts_permissive) = read_const_exprs_internal thy const_exprs;
+    val consts' = implemented_deps (consts_program_permissive thy consts_permissive);
+  in union (op =) consts' consts end;
+
+
+(** diagnostic commands **)
+
 fun code_depgr thy consts =
   let
     val (_, eqngr) = Code_Preproc.obtain true thy consts [];
@@ -888,8 +905,8 @@
 
 local
 
-fun code_thms_cmd thy = code_thms thy o op @ o read_const_exprs thy;
-fun code_deps_cmd thy = code_deps thy o op @ o read_const_exprs thy;
+fun code_thms_cmd thy = code_thms thy o read_const_exprs_all thy;
+fun code_deps_cmd thy = code_deps thy o read_const_exprs_all thy;
 
 in