rename map_theory/proof to theory/proof_map;
authorwenzelm
Sat, 21 Jan 2006 23:02:23 +0100
changeset 18731 3989c3c41983
parent 18730 843da46f89ac
child 18732 c0511e120f17
rename map_theory/proof to theory/proof_map; added separate map_theory/proof;
src/Pure/context.ML
--- a/src/Pure/context.ML	Sat Jan 21 23:02:21 2006 +0100
+++ b/src/Pure/context.ML	Sat Jan 21 23:02:23 2006 +0100
@@ -75,8 +75,10 @@
   val cases: (theory -> 'a) -> (proof -> 'a) -> generic -> 'a
   val the_theory: generic -> theory
   val the_proof: generic -> proof
-  val map_theory: (generic -> generic) -> theory -> theory
-  val map_proof: (generic -> generic) -> proof -> proof
+  val map_theory: (theory -> theory) -> generic -> generic
+  val map_proof: (proof -> proof) -> generic -> generic
+  val theory_map: (generic -> generic) -> theory -> theory
+  val proof_map: (generic -> generic) -> proof -> proof
   val theory_of: generic -> theory   (*total*)
   val proof_of: generic -> proof     (*total*)
 end;
@@ -186,8 +188,8 @@
 fun make_ancestry parents ancestors = {parents = parents, ancestors = ancestors};
 fun make_history name vers ints = {name = name, version = vers, intermediates = ints};
 
-fun map_theory f {theory, proof} = make_data (f theory) proof;
-fun map_proof f {theory, proof} = make_data theory (f proof);
+fun map_theory_data f {theory, proof} = make_data (f theory) proof;
+fun map_proof_data f {theory, proof} = make_data theory (f proof);
 
 val the_self = the o #self o identity_of;
 val parents_of = #parents o ancestry_of;
@@ -332,8 +334,9 @@
     val (self', data', ancestry') =
       if is_draft thy then (self, data, ancestry)    (*destructive change!*)
       else if #version history > 0
-      then (NONE, map_theory copy_data data, ancestry)
-      else (NONE, map_theory extend_data data, make_ancestry [thy] (thy :: #ancestors ancestry));
+      then (NONE, map_theory_data copy_data data, ancestry)
+      else (NONE, map_theory_data extend_data data,
+        make_ancestry [thy] (thy :: #ancestors ancestry));
     val data'' = f data';
   in create_thy name self' id ids iids data'' ancestry' history end;
 
@@ -343,7 +346,7 @@
 
 fun copy_thy (thy as Theory ({id, ids, iids, ...}, data, ancestry, history)) =
   (check_thy thy;
-    create_thy draftN NONE id ids iids (map_theory copy_data data) ancestry history);
+    create_thy draftN NONE id ids iids (map_theory_data copy_data data) ancestry history);
 
 val pre_pure_thy = create_thy draftN NONE (serial (), draftN) Inttab.empty Inttab.empty
   (make_data Inttab.empty Inttab.empty) (make_ancestry [] []) (make_history ProtoPureN 0 []);
@@ -430,7 +433,7 @@
       error ("Failed to access theory data " ^ quote (invoke_name k)))
   | NONE => error ("Uninitialized theory data " ^ quote (invoke_name k)));
 
-fun put k mk x = modify_thy (map_theory (Inttab.update (k, mk x)));
+fun put k mk x = modify_thy (map_theory_data (Inttab.update (k, mk x)));
 fun init k = put k I (invoke_empty k);
 
 end;
@@ -553,7 +556,7 @@
     val _ = change kinds (Inttab.update (k, kind));
   in k end;
 
-fun init k = modify_thy (map_proof (Inttab.update (k, ())));
+fun init k = modify_thy (map_proof_data (Inttab.update (k, ())));
 
 fun get k dest prf =
   (case Inttab.lookup (data_of_proof prf) k of
@@ -576,11 +579,14 @@
 fun cases f _ (Theory thy) = f thy
   | cases _ g (Proof prf) = g prf;
 
-val the_theory = cases I (fn _ => raise Fail "Bad generic context: theory expected");
-val the_proof = cases (fn _ => raise Fail "Bad generic context: proof context expected") I;
+val the_theory = cases I (fn _ => raise Fail "Ill-typed context: theory expected");
+val the_proof = cases (fn _ => raise Fail "Ill-typed context: proof expected") I;
 
-fun map_theory f = the_theory o f o Theory;
-fun map_proof f = the_proof o f o Proof;
+fun map_theory f = Theory o f o the_theory;
+fun map_proof f = Proof o f o the_proof;
+
+fun theory_map f = the_theory o f o Theory;
+fun proof_map f = the_proof o f o Proof;
 
 val theory_of = cases I theory_of_proof;
 val proof_of = cases init_proof I;