# HG changeset patch
# User haftmann
# Date 1284556299 -7200
# Node ID 9b0a8d72edc83b175ff79cf5b45b6052312494ae
# Parent  e9cad160aa0f522436d1cbac8f12794e1c86f00c
ignore code cache optionally

diff -r e9cad160aa0f -r 9b0a8d72edc8 src/Pure/Isar/code.ML
--- a/src/Pure/Isar/code.ML	Wed Sep 15 13:44:11 2010 +0200
+++ b/src/Pure/Isar/code.ML	Wed Sep 15 15:11:39 2010 +0200
@@ -89,16 +89,14 @@
 signature CODE_DATA =
 sig
   type T
-  val change: theory -> (T -> T) -> T
-  val change_yield: theory -> (T -> 'a * T) -> 'a * T
+  val change: theory option -> (T -> T) -> T
+  val change_yield: theory option -> (T -> 'a * T) -> 'a * T
 end;
 
 signature PRIVATE_CODE =
 sig
   include CODE
   val declare_data: Object.T -> serial
-  val change_data: serial * ('a -> Object.T) * (Object.T -> 'a)
-    -> theory -> ('a -> 'a) -> 'a
   val change_yield_data: serial * ('a -> Object.T) * (Object.T -> 'a)
     -> theory -> ('a -> 'b * 'a) -> 'b * 'a
 end;
@@ -310,8 +308,6 @@
       ((K o SOME) (Datatab.update (kind, mk data') datatab, thy_ref));
   in result end;
 
-fun change_data ops theory f = change_yield_data ops theory (f #> pair ()) |> snd;
-
 end; (*local*)
 
 
@@ -1277,8 +1273,10 @@
 
 val data_op = (kind, Data, dest);
 
-val change = Code.change_data data_op;
-fun change_yield thy = Code.change_yield_data data_op thy;
+fun change_yield (SOME thy) f = Code.change_yield_data data_op thy f
+  | change_yield NONE f = f Data.empty
+
+fun change some_thy f = snd (change_yield some_thy (pair () o f));
 
 end;
 
diff -r e9cad160aa0f -r 9b0a8d72edc8 src/Tools/Code/code_thingol.ML
--- a/src/Tools/Code/code_thingol.ML	Wed Sep 15 13:44:11 2010 +0200
+++ b/src/Tools/Code/code_thingol.ML	Wed Sep 15 15:11:39 2010 +0200
@@ -832,15 +832,11 @@
   val empty = (empty_naming, Graph.empty);
 );
 
-fun cache_generation thy (algebra, eqngr) f name =
-  Program.change_yield thy (fn naming_program => (NONE, naming_program)
-    |> f thy algebra eqngr name
-    |-> (fn name => fn (_, naming_program) => (name, naming_program)));
-
-fun transient_generation thy (algebra, eqngr) f name =
-  (NONE, (empty_naming, Graph.empty))
-  |> f thy algebra eqngr name
-  |-> (fn name => fn (_, naming_program) => (name, naming_program));
+fun invoke_generation ignore_cache thy (algebra, eqngr) f name =
+  Program.change_yield (if ignore_cache then NONE else SOME thy)
+    (fn naming_program => (NONE, naming_program)
+      |> f thy algebra eqngr name
+      |-> (fn name => fn (_, naming_program) => (name, naming_program)));
 
 
 (* program generation *)
@@ -853,10 +849,9 @@
       in (cs, (naming, Graph.subgraph (member (op =) cs_all) program)) end;
     fun generate_consts thy algebra eqngr =
       fold_map (ensure_const thy algebra eqngr permissive);
-    val invoke_generation = if permissive
-      then transient_generation else cache_generation
   in
-    invoke_generation thy (Code_Preproc.obtain thy cs []) generate_consts cs
+    invoke_generation (not permissive) thy (Code_Preproc.obtain false thy cs [])
+      generate_consts cs
     |-> project_consts
   end;
 
@@ -892,7 +887,7 @@
 fun base_evaluator thy evaluator algebra eqngr vs t =
   let
     val (((naming, program), (((vs', ty'), t'), deps)), _) =
-      cache_generation thy (algebra, eqngr) ensure_value t;
+      invoke_generation false thy (algebra, eqngr) ensure_value t;
     val vs'' = map (fn (v, _) => (v, (the o AList.lookup (op =) vs o prefix "'") v)) vs';
   in evaluator naming program ((vs'', (vs', ty')), t') deps end;
 
@@ -926,7 +921,7 @@
 
 fun code_depgr thy consts =
   let
-    val (_, eqngr) = Code_Preproc.obtain thy consts [];
+    val (_, eqngr) = Code_Preproc.obtain true thy consts [];
     val all_consts = Graph.all_succs eqngr consts;
   in Graph.subgraph (member (op =) all_consts) eqngr end;