advanced translation functions: Proof.context;
authorwenzelm
Mon, 11 Dec 2006 21:39:26 +0100
changeset 21772 7c7ade4f537b
parent 21771 148c8aba89dd
child 21773 0038f5fc2065
advanced translation functions: Proof.context;
src/HOL/Tools/datatype_package.ML
src/HOL/Tools/record_package.ML
src/Pure/Isar/proof_context.ML
src/Pure/Syntax/printer.ML
src/Pure/Syntax/syn_ext.ML
src/Pure/Syntax/syntax.ML
src/Pure/sign.ML
src/Pure/theory.ML
--- a/src/HOL/Tools/datatype_package.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/HOL/Tools/datatype_package.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -392,9 +392,9 @@
 
 (**** translation rules for case ****)
 
-fun case_tr context [t, u] =
+fun case_tr ctxt [t, u] =
     let
-      val thy = Context.theory_of context;
+      val thy = ProofContext.theory_of ctxt;
       fun case_error s name ts = raise TERM ("Error in case expression" ^
         getOpt (Option.map (curry op ^ " for datatype ") name, "") ^ ":\n" ^ s, ts);
       fun dest_case1 (Const ("_case1", _) $ t $ u) =
@@ -457,10 +457,10 @@
     end
   | case_tr _ ts = raise TERM ("case_tr", ts);
 
-fun case_tr' constrs context ts =
+fun case_tr' constrs ctxt ts =
   if length ts <> length constrs + 1 then raise Match else
   let
-    val consts = Context.cases Sign.consts_of ProofContext.consts_of context;
+    val consts = ProofContext.consts_of ctxt;
 
     val (fs, x) = split_last ts;
     fun strip_abs 0 t = ([], t)
--- a/src/HOL/Tools/record_package.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/HOL/Tools/record_package.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -538,9 +538,9 @@
      else [dest_ext_field mark trm]
   | dest_ext_fields _ mark t = [dest_ext_field mark t]
 
-fun gen_ext_fields_tr sep mark sfx more context t =
+fun gen_ext_fields_tr sep mark sfx more ctxt t =
   let
-    val thy = Context.theory_of context;
+    val thy = ProofContext.theory_of ctxt;
     val msg = "error in record input: ";
     val fieldargs = dest_ext_fields sep mark t;
     fun splitargs (field::fields) ((name,arg)::fargs) =
@@ -568,9 +568,9 @@
 
   in mk_ext fieldargs end;
 
-fun gen_ext_type_tr sep mark sfx more context t =
+fun gen_ext_type_tr sep mark sfx more ctxt t =
   let
-    val thy = Context.theory_of context;
+    val thy = ProofContext.theory_of ctxt;
     val msg = "error in record-type input: ";
     val fieldargs = dest_ext_fields sep mark t;
     fun splitargs (field::fields) ((name,arg)::fargs) =
@@ -619,20 +619,20 @@
 
   in mk_ext fieldargs end;
 
-fun gen_adv_record_tr sep mark sfx unit context [t] =
-      gen_ext_fields_tr sep mark sfx unit context t
+fun gen_adv_record_tr sep mark sfx unit ctxt [t] =
+      gen_ext_fields_tr sep mark sfx unit ctxt t
   | gen_adv_record_tr _ _ _ _ _ ts = raise TERM ("gen_record_tr", ts);
 
-fun gen_adv_record_scheme_tr sep mark sfx context [t, more] =
-      gen_ext_fields_tr sep mark sfx more context t
+fun gen_adv_record_scheme_tr sep mark sfx ctxt [t, more] =
+      gen_ext_fields_tr sep mark sfx more ctxt t
   | gen_adv_record_scheme_tr _ _ _ _ ts = raise TERM ("gen_record_scheme_tr", ts);
 
-fun gen_adv_record_type_tr sep mark sfx unit context [t] =
-      gen_ext_type_tr sep mark sfx unit context t
+fun gen_adv_record_type_tr sep mark sfx unit ctxt [t] =
+      gen_ext_type_tr sep mark sfx unit ctxt t
   | gen_adv_record_type_tr _ _ _ _ _ ts = raise TERM ("gen_record_tr", ts);
 
-fun gen_adv_record_type_scheme_tr sep mark sfx context [t, more] =
-      gen_ext_type_tr sep mark sfx more context t
+fun gen_adv_record_type_scheme_tr sep mark sfx ctxt [t, more] =
+      gen_ext_type_tr sep mark sfx more ctxt t
   | gen_adv_record_type_scheme_tr _ _ _ _ ts = raise TERM ("gen_record_scheme_tr", ts);
 
 val adv_record_tr = gen_adv_record_tr "_fields" "_field" extN HOLogic.unit;
@@ -680,9 +680,9 @@
   let val name_sfx = suffix sfx name
   in (name_sfx, fn [t, u] => tr' (Syntax.const name_sfx $ t $ u) | _ => raise Match) end;
 
-fun record_tr' sep mark record record_scheme unit context t =
+fun record_tr' sep mark record record_scheme unit ctxt t =
   let
-    val thy = Context.theory_of context;
+    val thy = ProofContext.theory_of ctxt;
     fun field_lst t =
       (case strip_comb t of
         (Const (ext,_),args as (_::_))
@@ -713,7 +713,7 @@
 fun gen_record_tr' name =
   let val name_sfx = suffix extN name;
       val unit = (fn Const ("Unity",_) => true | _ => false);
-      fun tr' context ts = record_tr' "_fields" "_field" "_record" "_record_scheme" unit context
+      fun tr' ctxt ts = record_tr' "_fields" "_field" "_record" "_record_scheme" unit ctxt
                        (list_comb (Syntax.const name_sfx,ts))
   in (name_sfx,tr')
   end
@@ -724,9 +724,9 @@
 
 (* record_type_abbr_tr' tries to reconstruct the record name type abbreviation from *)
 (* the (nested) extension types.                                                    *)
-fun record_type_abbr_tr' default_tr' abbr alphas zeta lastExt schemeT context tm =
+fun record_type_abbr_tr' default_tr' abbr alphas zeta lastExt schemeT ctxt tm =
   let
-      val thy = Context.theory_of context;
+      val thy = ProofContext.theory_of ctxt;
       (* tm is term representation of a (nested) field type. We first reconstruct the      *)
       (* type from tm so that we can continue on the type level rather then the term level.*)
 
@@ -770,15 +770,15 @@
                     if HOLogic.is_unitT (Envir.norm_type subst (varifyT (TFree(zeta,Sign.defaultS thy))))
                     then mk_type_abbr subst abbr alphas
                     else mk_type_abbr subst (suffix schemeN abbr) (alphas@[zeta])
-                   end handle TYPE_MATCH => default_tr' context tm)
+                   end handle TYPE_MATCH => default_tr' ctxt tm)
                  else raise Match (* give print translation of specialised record a chance *)
             | _ => raise Match)
-       else default_tr' context tm
+       else default_tr' ctxt tm
   end
 
-fun record_type_tr' sep mark record record_scheme context t =
+fun record_type_tr' sep mark record record_scheme ctxt t =
   let
-    val thy = Context.theory_of context;
+    val thy = ProofContext.theory_of ctxt;
     fun get_sort xs n = AList.lookup (op =) xs n |> the_default (Sign.defaultS thy);
 
     val T = Sign.intern_typ thy (Syntax.typ_of_term (get_sort (Syntax.raw_term_sorts t)) I t)
@@ -826,8 +826,8 @@
 
 fun gen_record_type_tr' name =
   let val name_sfx = suffix ext_typeN name;
-      fun tr' context ts = record_type_tr' "_field_types" "_field_type"
-                       "_record_type" "_record_type_scheme" context
+      fun tr' ctxt ts = record_type_tr' "_field_types" "_field_type"
+                       "_record_type" "_record_type_scheme" ctxt
                        (list_comb (Syntax.const name_sfx,ts))
   in (name_sfx,tr')
   end
@@ -837,8 +837,8 @@
   let val name_sfx = suffix ext_typeN name;
       val default_tr' = record_type_tr' "_field_types" "_field_type"
                                "_record_type" "_record_type_scheme"
-      fun tr' context ts =
-          record_type_abbr_tr' default_tr' abbr alphas zeta lastExt schemeT context
+      fun tr' ctxt ts =
+          record_type_abbr_tr' default_tr' abbr alphas zeta lastExt schemeT ctxt
                                (list_comb (Syntax.const name_sfx,ts))
   in (name_sfx, tr') end;
 
--- a/src/Pure/Isar/proof_context.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/Pure/Isar/proof_context.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -293,9 +293,7 @@
       |> do_abbrevs ? rewrite_term false thy (Consts.abbrevs_of consts [#1 Syntax.internal_mode])
       |> Sign.extern_term (Consts.extern_early consts) thy
       |> LocalSyntax.extern_term syntax;
-  in
-    Sign.pretty_term' (Context.Proof ctxt) (LocalSyntax.syn_of syntax) (Consts.extern consts) t'
-  end;
+  in Sign.pretty_term' ctxt (LocalSyntax.syn_of syntax) (Consts.extern consts) t' end;
 
 in
 
@@ -355,7 +353,7 @@
 local
 
 fun read_typ_aux read ctxt s =
-  read (syn_of ctxt) (Context.Proof ctxt) (Variable.def_sort ctxt) s;
+  read (syn_of ctxt) ctxt (Variable.def_sort ctxt) s;
 
 fun cert_typ_aux cert ctxt raw_T =
   cert (theory_of ctxt) raw_T handle TYPE (msg, _, _) => error msg;
@@ -435,7 +433,7 @@
 
 fun read_def_termTs freeze pp syn ctxt (types, sorts, used) sTs =
   Sign.read_def_terms' pp (Sign.is_logtype (theory_of ctxt)) syn (consts_of ctxt)
-    (Context.Proof ctxt) (types, sorts) used freeze sTs;
+    ctxt (types, sorts) used freeze sTs;
 
 fun read_def_termT freeze pp syn ctxt defaults sT =
   apfst hd (read_def_termTs freeze pp syn ctxt defaults [sT]);
@@ -865,9 +863,9 @@
       Option.map (pair false) (try (Consts.syntax (consts_of ctxt)) (c, mx))
   | const_syntax _ _ = NONE;
 
-fun context_const_ast_tr context [Syntax.Variable c] =
+fun context_const_ast_tr ctxt [Syntax.Variable c] =
       let
-        val consts = Context.cases Sign.consts_of consts_of context;
+        val consts = consts_of ctxt;
         val c' = Consts.intern consts c;
         val _ = Consts.the_constraint consts c' handle TYPE (msg, _, _) => error msg;
       in Syntax.Constant (Syntax.constN ^ c') end
--- a/src/Pure/Syntax/printer.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/Pure/Syntax/printer.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -18,22 +18,22 @@
 signature PRINTER =
 sig
   include PRINTER0
-  val term_to_ast: Context.generic ->
-    (string -> (Context.generic -> bool -> typ -> term list -> term) list) -> term -> Ast.ast
-  val typ_to_ast: Context.generic ->
-    (string -> (Context.generic -> bool -> typ -> term list -> term) list) -> typ -> Ast.ast
-  val sort_to_ast: Context.generic ->
-    (string -> (Context.generic -> bool -> typ -> term list -> term) list) -> sort -> Ast.ast
+  val term_to_ast: Proof.context ->
+    (string -> (Proof.context -> bool -> typ -> term list -> term) list) -> term -> Ast.ast
+  val typ_to_ast: Proof.context ->
+    (string -> (Proof.context -> bool -> typ -> term list -> term) list) -> typ -> Ast.ast
+  val sort_to_ast: Proof.context ->
+    (string -> (Proof.context -> bool -> typ -> term list -> term) list) -> sort -> Ast.ast
   type prtabs
   val empty_prtabs: prtabs
   val extend_prtabs: string -> SynExt.xprod list -> prtabs -> prtabs
   val remove_prtabs: string -> SynExt.xprod list -> prtabs -> prtabs
   val merge_prtabs: prtabs -> prtabs -> prtabs
-  val pretty_term_ast: (string -> xstring) -> Context.generic -> bool -> prtabs
-    -> (string -> (Context.generic -> Ast.ast list -> Ast.ast) list)
+  val pretty_term_ast: (string -> xstring) -> Proof.context -> bool -> prtabs
+    -> (string -> (Proof.context -> Ast.ast list -> Ast.ast) list)
     -> (string -> (string -> string * real) option) -> Ast.ast -> Pretty.T
-  val pretty_typ_ast: Context.generic -> bool -> prtabs
-    -> (string -> (Context.generic -> Ast.ast list -> Ast.ast) list)
+  val pretty_typ_ast: Proof.context -> bool -> prtabs
+    -> (string -> (Proof.context -> Ast.ast list -> Ast.ast) list)
     -> (string -> (string -> string * real) option) -> Ast.ast -> Pretty.T
 end;
 
@@ -58,17 +58,17 @@
 
 (* apply print (ast) translation function *)
 
-fun apply_trans context name a fns args =
+fun apply_trans ctxt name a fns args =
   let
     fun app_first [] = raise Match
-      | app_first (f :: fs) = f context args handle Match => app_first fs;
+      | app_first (f :: fs) = f ctxt args handle Match => app_first fs;
   in
     transform_failure (fn Match => Match
       | exn => EXCEPTION (exn, "Error in " ^ name ^ " for " ^ quote a))
       app_first fns
   end;
 
-fun apply_typed x y fs = map (fn f => fn context => f context x y) fs;
+fun apply_typed x y fs = map (fn f => fn ctxt => f ctxt x y) fs;
 
 
 (* simple_ast_of *)
@@ -87,7 +87,7 @@
 
 (** sort_to_ast, typ_to_ast **)
 
-fun ast_of_termT context trf tm =
+fun ast_of_termT ctxt trf tm =
   let
     fun ast_of (t as Const ("_class", _) $ Free _) = simple_ast_of t
       | ast_of (t as Const ("_tfree", _) $ Free _) = simple_ast_of t
@@ -99,12 +99,12 @@
           | (f, args) => Ast.Appl (map ast_of (f :: args)))
       | ast_of t = simple_ast_of t
     and trans a args =
-      ast_of (apply_trans context "print translation" a (apply_typed false dummyT (trf a)) args)
+      ast_of (apply_trans ctxt "print translation" a (apply_typed false dummyT (trf a)) args)
         handle Match => Ast.mk_appl (Ast.Constant a) (map ast_of args);
   in ast_of tm end;
 
-fun sort_to_ast context trf S = ast_of_termT context trf (TypeExt.term_of_sort S);
-fun typ_to_ast context trf T = ast_of_termT context trf (TypeExt.term_of_typ (! show_sorts) T);
+fun sort_to_ast ctxt trf S = ast_of_termT ctxt trf (TypeExt.term_of_sort S);
+fun typ_to_ast ctxt trf T = ast_of_termT ctxt trf (TypeExt.term_of_typ (! show_sorts) T);
 
 
 
@@ -121,7 +121,7 @@
       else Lexicon.const "_var" $ t
   | mark_freevars a = a;
 
-fun ast_of_term context trf show_all_types no_freeTs show_types show_sorts tm =
+fun ast_of_term ctxt trf show_all_types no_freeTs show_types show_sorts tm =
   let
     fun prune_typs (t_seen as (Const _, _)) = t_seen
       | prune_typs (t as Free (x, ty), seen) =
@@ -160,13 +160,13 @@
       | (t, ts) => Ast.mk_appl (simple_ast_of t) (map ast_of ts))
 
     and trans a T args =
-      ast_of (apply_trans context "print translation" a (apply_typed show_sorts T (trf a)) args)
+      ast_of (apply_trans ctxt "print translation" a (apply_typed show_sorts T (trf a)) args)
         handle Match => Ast.mk_appl (Ast.Constant a) (map ast_of args)
 
     and constrain t T =
       if show_types andalso T <> dummyT then
         Ast.Appl [Ast.Constant SynExt.constrainC, simple_ast_of t,
-          ast_of_termT context trf (TypeExt.term_of_typ show_sorts T)]
+          ast_of_termT ctxt trf (TypeExt.term_of_typ show_sorts T)]
       else simple_ast_of t
   in
     tm
@@ -176,8 +176,8 @@
     |> ast_of
   end;
 
-fun term_to_ast context trf tm =
-  ast_of_term context trf (! show_all_types) (! show_no_free_types)
+fun term_to_ast ctxt trf tm =
+  ast_of_term ctxt trf (! show_all_types) (! show_no_free_types)
     (! show_types orelse ! show_sorts orelse ! show_all_types) (! show_sorts) tm;
 
 
@@ -267,9 +267,9 @@
   | is_chain [Arg _] = true
   | is_chain _  = false;
 
-fun pretty extern_const context tabs trf tokentrf type_mode curried ast0 p0 =
+fun pretty extern_const ctxt tabs trf tokentrf type_mode curried ast0 p0 =
   let
-    val trans = apply_trans context "print ast translation";
+    val trans = apply_trans ctxt "print ast translation";
 
     fun token_trans c [Ast.Variable x] =
           (case tokentrf c of
@@ -292,7 +292,7 @@
             val (Ts, args') = synT (symbs, args);
           in
             if type_mode then (astT (t, p) @ Ts, args')
-            else (pretty I context tabs trf tokentrf true curried t p @ Ts, args')
+            else (pretty I ctxt tabs trf tokentrf true curried t p @ Ts, args')
           end
       | synT (String s :: symbs, args) =
           let val (Ts, args') = synT (symbs, args);
@@ -366,15 +366,15 @@
 
 (* pretty_term_ast *)
 
-fun pretty_term_ast extern_const context curried prtabs trf tokentrf ast =
-  Pretty.blk (0, pretty extern_const context (mode_tabs prtabs (! print_mode))
+fun pretty_term_ast extern_const ctxt curried prtabs trf tokentrf ast =
+  Pretty.blk (0, pretty extern_const ctxt (mode_tabs prtabs (! print_mode))
     trf tokentrf false curried ast 0);
 
 
 (* pretty_typ_ast *)
 
-fun pretty_typ_ast context _ prtabs trf tokentrf ast =
-  Pretty.blk (0, pretty I context (mode_tabs prtabs (! print_mode))
+fun pretty_typ_ast ctxt _ prtabs trf tokentrf ast =
+  Pretty.blk (0, pretty I ctxt (mode_tabs prtabs (! print_mode))
     trf tokentrf true false ast 0);
 
 end;
--- a/src/Pure/Syntax/syn_ext.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/Pure/Syntax/syn_ext.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -42,33 +42,30 @@
       xprods: xprod list,
       consts: string list,
       prmodes: string list,
-      parse_ast_translation:
-        (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list,
+      parse_ast_translation: (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list,
       parse_rules: (Ast.ast * Ast.ast) list,
-      parse_translation:
-        (string * ((Context.generic -> term list -> term) * stamp)) list,
+      parse_translation: (string * ((Proof.context -> term list -> term) * stamp)) list,
       print_translation:
-        (string * ((Context.generic -> bool -> typ -> term list -> term) * stamp)) list,
+        (string * ((Proof.context -> bool -> typ -> term list -> term) * stamp)) list,
       print_rules: (Ast.ast * Ast.ast) list,
-      print_ast_translation:
-        (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list,
+      print_ast_translation: (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list,
       token_translation: (string * string * (string -> string * real)) list}
   val mfix_delims: string -> string list
   val mfix_args: string -> int
   val escape_mfix: string -> string
   val unlocalize_mfix: string -> string
   val syn_ext': bool -> (string -> bool) -> mfix list ->
-    string list -> (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list *
-    (string * ((Context.generic -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> bool -> typ -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list
+    string list -> (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list *
+    (string * ((Proof.context -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> bool -> typ -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list
     -> (string * string * (string -> string * real)) list
     -> (Ast.ast * Ast.ast) list * (Ast.ast * Ast.ast) list -> syn_ext
   val syn_ext: mfix list -> string list ->
-    (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list *
-    (string * ((Context.generic -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> bool -> typ -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list
+    (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list *
+    (string * ((Proof.context -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> bool -> typ -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list
     -> (string * string * (string -> string * real)) list
     -> (Ast.ast * Ast.ast) list * (Ast.ast * Ast.ast) list -> syn_ext
   val syn_ext_const_names: string list -> syn_ext
@@ -79,10 +76,10 @@
     (string * ((bool -> typ -> term list -> term) * stamp)) list *
     (string * ((Ast.ast list -> Ast.ast) * stamp)) list -> syn_ext
   val syn_ext_advanced_trfuns:
-    (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list *
-    (string * ((Context.generic -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> bool -> typ -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list -> syn_ext
+    (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list *
+    (string * ((Proof.context -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> bool -> typ -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list -> syn_ext
   val syn_ext_tokentrfuns: (string * string * (string -> string * real)) list -> syn_ext
   val standard_token_markers: string list
   val pure_ext: syn_ext
@@ -339,16 +336,13 @@
     xprods: xprod list,
     consts: string list,
     prmodes: string list,
-    parse_ast_translation:
-      (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list,
+    parse_ast_translation: (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list,
     parse_rules: (Ast.ast * Ast.ast) list,
-    parse_translation:
-      (string * ((Context.generic -> term list -> term) * stamp)) list,
+    parse_translation: (string * ((Proof.context -> term list -> term) * stamp)) list,
     print_translation:
-      (string * ((Context.generic -> bool -> typ -> term list -> term) * stamp)) list,
+      (string * ((Proof.context -> bool -> typ -> term list -> term) * stamp)) list,
     print_rules: (Ast.ast * Ast.ast) list,
-    print_ast_translation:
-      (string * ((Context.generic -> Ast.ast list -> Ast.ast) * stamp)) list,
+    print_ast_translation: (string * ((Proof.context -> Ast.ast list -> Ast.ast) * stamp)) list,
     token_translation: (string * string * (string -> string * real)) list};
 
 
--- a/src/Pure/Syntax/syntax.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/Pure/Syntax/syntax.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -51,16 +51,16 @@
     (string * ((bool -> typ -> term list -> term) * stamp)) list *
     (string * ((ast list -> ast) * stamp)) list -> syntax -> syntax
   val extend_advanced_trfuns:
-    (string * ((Context.generic -> ast list -> ast) * stamp)) list *
-    (string * ((Context.generic -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> bool -> typ -> term list -> term) * stamp)) list *
-    (string * ((Context.generic -> ast list -> ast) * stamp)) list -> syntax -> syntax
+    (string * ((Proof.context -> ast list -> ast) * stamp)) list *
+    (string * ((Proof.context -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> bool -> typ -> term list -> term) * stamp)) list *
+    (string * ((Proof.context -> ast list -> ast) * stamp)) list -> syntax -> syntax
   val extend_tokentrfuns: (string * string * (string -> string * real)) list -> syntax -> syntax
   val remove_const_gram: (string -> bool) ->
     mode -> (string * typ * mixfix) list -> syntax -> syntax
-  val extend_trrules: Context.generic -> (string -> bool) -> syntax ->
+  val extend_trrules: Proof.context -> (string -> bool) -> syntax ->
     (string * string) trrule list -> syntax -> syntax
-  val remove_trrules: Context.generic -> (string -> bool) -> syntax ->
+  val remove_trrules: Proof.context -> (string -> bool) -> syntax ->
     (string * string) trrule list -> syntax -> syntax
   val extend_trrules_i: ast trrule list -> syntax -> syntax
   val remove_trrules_i: ast trrule list -> syntax -> syntax
@@ -73,13 +73,13 @@
   val print_gram: syntax -> unit
   val print_trans: syntax -> unit
   val print_syntax: syntax -> unit
-  val read: Context.generic -> (string -> bool) -> syntax -> typ -> string -> term list
-  val read_typ: Context.generic -> syntax -> ((indexname * sort) list -> indexname -> sort) ->
+  val read: Proof.context -> (string -> bool) -> syntax -> typ -> string -> term list
+  val read_typ: Proof.context -> syntax -> ((indexname * sort) list -> indexname -> sort) ->
     (sort -> sort) -> string -> typ
-  val read_sort: Context.generic -> syntax -> string -> sort
-  val pretty_term: (string -> xstring) -> Context.generic -> syntax -> bool -> term -> Pretty.T
-  val pretty_typ: Context.generic -> syntax -> typ -> Pretty.T
-  val pretty_sort: Context.generic -> syntax -> sort -> Pretty.T
+  val read_sort: Proof.context -> syntax -> string -> sort
+  val pretty_term: (string -> xstring) -> Proof.context -> syntax -> bool -> term -> Pretty.T
+  val pretty_typ: Proof.context -> syntax -> typ -> Pretty.T
+  val pretty_sort: Proof.context -> syntax -> sort -> Pretty.T
   val ambiguity_level: int ref
   val ambiguity_is_error: bool ref
 end;
@@ -172,12 +172,12 @@
     gram: Parser.gram,
     consts: string list,
     prmodes: string list,
-    parse_ast_trtab: ((Context.generic -> Ast.ast list -> Ast.ast) * stamp) Symtab.table,
+    parse_ast_trtab: ((Proof.context -> Ast.ast list -> Ast.ast) * stamp) Symtab.table,
     parse_ruletab: ruletab,
-    parse_trtab: ((Context.generic -> term list -> term) * stamp) Symtab.table,
-    print_trtab: ((Context.generic -> bool -> typ -> term list -> term) * stamp) list Symtab.table,
+    parse_trtab: ((Proof.context -> term list -> term) * stamp) Symtab.table,
+    print_trtab: ((Proof.context -> bool -> typ -> term list -> term) * stamp) list Symtab.table,
     print_ruletab: ruletab,
-    print_ast_trtab: ((Context.generic -> Ast.ast list -> Ast.ast) * stamp) list Symtab.table,
+    print_ast_trtab: ((Proof.context -> Ast.ast list -> Ast.ast) * stamp) list Symtab.table,
     tokentrtab: (string * (string * ((string -> string * real) * stamp)) list) list,
     prtabs: Printer.prtabs} * stamp;
 
@@ -384,7 +384,7 @@
 val ambiguity_level = ref 1;
 val ambiguity_is_error = ref false
 
-fun read_asts context is_logtype (Syntax (tabs, _)) xids root str =
+fun read_asts ctxt is_logtype (Syntax (tabs, _)) xids root str =
   let
     val {lexicon, gram, parse_ast_trtab, ...} = tabs;
     val root' = if root <> "prop" andalso is_logtype root then SynExt.logic else root;
@@ -392,41 +392,41 @@
     val pts = Parser.parse gram root' (Lexicon.tokenize lexicon xids chars);
 
     fun show_pt pt =
-      Pretty.string_of (Ast.pretty_ast (hd (SynTrans.pts_to_asts context (K NONE) [pt])));
+      Pretty.string_of (Ast.pretty_ast (hd (SynTrans.pts_to_asts ctxt (K NONE) [pt])));
   in
     conditional (length pts > ! ambiguity_level) (fn () =>
       if ! ambiguity_is_error then error ("Ambiguous input " ^ quote str)
       else (warning ("Ambiguous input " ^ quote str ^ "\n" ^
           "produces " ^ string_of_int (length pts) ^ " parse trees.");
          List.app (warning o show_pt) pts));
-    SynTrans.pts_to_asts context (lookup_tr parse_ast_trtab) pts
+    SynTrans.pts_to_asts ctxt (lookup_tr parse_ast_trtab) pts
   end;
 
 
 (* read *)
 
-fun read context is_logtype (syn as Syntax (tabs, _)) ty str =
+fun read ctxt is_logtype (syn as Syntax (tabs, _)) ty str =
   let
     val {parse_ruletab, parse_trtab, ...} = tabs;
-    val asts = read_asts context is_logtype syn false (SynExt.typ_to_nonterm ty) str;
+    val asts = read_asts ctxt is_logtype syn false (SynExt.typ_to_nonterm ty) str;
   in
-    SynTrans.asts_to_terms context (lookup_tr parse_trtab)
+    SynTrans.asts_to_terms ctxt (lookup_tr parse_trtab)
       (map (Ast.normalize_ast (Symtab.lookup_list parse_ruletab)) asts)
   end;
 
 
 (* read types *)
 
-fun read_typ context syn get_sort map_sort str =
-  (case read context (K false) syn SynExt.typeT str of
+fun read_typ ctxt syn get_sort map_sort str =
+  (case read ctxt (K false) syn SynExt.typeT str of
     [t] => TypeExt.typ_of_term (get_sort (TypeExt.raw_term_sorts t)) map_sort t
   | _ => error "read_typ: ambiguous syntax");
 
 
 (* read sorts *)
 
-fun read_sort context syn str =
-  (case read context (K false) syn TypeExt.sortT str of
+fun read_sort ctxt syn str =
+  (case read ctxt (K false) syn TypeExt.sortT str of
     [t] => TypeExt.sort_of_term t
   | _ => error "read_sort: ambiguous syntax");
 
@@ -462,7 +462,7 @@
   | NONE => rule);
 
 
-fun read_pattern context is_logtype syn (root, str) =
+fun read_pattern ctxt is_logtype syn (root, str) =
   let
     val Syntax ({consts, ...}, _) = syn;
 
@@ -472,7 +472,7 @@
           else ast
       | constify (Ast.Appl asts) = Ast.Appl (map constify asts);
   in
-    (case read_asts context is_logtype syn true root str of
+    (case read_asts ctxt is_logtype syn true root str of
       [ast] => constify ast
     | _ => error ("Syntactically ambiguous input: " ^ quote str))
   end handle ERROR msg =>
@@ -489,8 +489,8 @@
 
 val cert_rules = prep_rules I;
 
-fun read_rules context is_logtype syn =
-  prep_rules (read_pattern context is_logtype syn);
+fun read_rules ctxt is_logtype syn =
+  prep_rules (read_pattern ctxt is_logtype syn);
 
 end;
 
@@ -498,19 +498,19 @@
 
 (** pretty terms, typs, sorts **)
 
-fun pretty_t t_to_ast prt_t context (syn as Syntax (tabs, _)) curried t =
+fun pretty_t t_to_ast prt_t ctxt (syn as Syntax (tabs, _)) curried t =
   let
     val {print_trtab, print_ruletab, print_ast_trtab, tokentrtab, prtabs, ...} = tabs;
-    val ast = t_to_ast context (lookup_tr' print_trtab) t;
+    val ast = t_to_ast ctxt (lookup_tr' print_trtab) t;
   in
-    prt_t context curried prtabs (lookup_tr' print_ast_trtab)
+    prt_t ctxt curried prtabs (lookup_tr' print_ast_trtab)
       (lookup_tokentr tokentrtab (! print_mode))
       (Ast.normalize_ast (Symtab.lookup_list print_ruletab) ast)
   end;
 
 val pretty_term = pretty_t Printer.term_to_ast o Printer.pretty_term_ast;
-fun pretty_typ context syn = pretty_t Printer.typ_to_ast Printer.pretty_typ_ast context syn false;
-fun pretty_sort context syn = pretty_t Printer.sort_to_ast Printer.pretty_typ_ast context syn false;
+fun pretty_typ ctxt syn = pretty_t Printer.typ_to_ast Printer.pretty_typ_ast ctxt syn false;
+fun pretty_sort ctxt syn = pretty_t Printer.sort_to_ast Printer.pretty_typ_ast ctxt syn false;
 
 
 
@@ -529,11 +529,11 @@
 fun remove_const_gram is_logtype prmode decls =
   remove_syntax prmode (Mixfix.syn_ext_consts is_logtype decls);
 
-fun extend_trrules context is_logtype syn =
-  ext_syntax SynExt.syn_ext_rules o read_rules context is_logtype syn;
+fun extend_trrules ctxt is_logtype syn =
+  ext_syntax SynExt.syn_ext_rules o read_rules ctxt is_logtype syn;
 
-fun remove_trrules context is_logtype syn =
-  remove_syntax default_mode o SynExt.syn_ext_rules o read_rules context is_logtype syn;
+fun remove_trrules ctxt is_logtype syn =
+  remove_syntax default_mode o SynExt.syn_ext_rules o read_rules ctxt is_logtype syn;
 
 val extend_trrules_i = ext_syntax SynExt.syn_ext_rules o cert_rules;
 val remove_trrules_i = remove_syntax default_mode o SynExt.syn_ext_rules o cert_rules;
--- a/src/Pure/sign.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/Pure/sign.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -36,12 +36,12 @@
   val add_trfunsT:
     (string * (bool -> typ -> term list -> term)) list -> theory -> theory
   val add_advanced_trfuns:
-    (string * (Context.generic -> ast list -> ast)) list *
-    (string * (Context.generic -> term list -> term)) list *
-    (string * (Context.generic -> term list -> term)) list *
-    (string * (Context.generic -> ast list -> ast)) list -> theory -> theory
+    (string * (Proof.context -> ast list -> ast)) list *
+    (string * (Proof.context -> term list -> term)) list *
+    (string * (Proof.context -> term list -> term)) list *
+    (string * (Proof.context -> ast list -> ast)) list -> theory -> theory
   val add_advanced_trfunsT:
-    (string * (Context.generic -> bool -> typ -> term list -> term)) list -> theory -> theory
+    (string * (Proof.context -> bool -> typ -> term list -> term)) list -> theory -> theory
   val add_tokentrfuns:
     (string * string * (string -> string * real)) list -> theory -> theory
   val add_mode_tokentrfuns: string -> (string * (string -> string * real)) list
@@ -133,7 +133,7 @@
   val intern_term: theory -> term -> term
   val extern_term: (string -> xstring) -> theory -> term -> term
   val intern_tycons: theory -> typ -> typ
-  val pretty_term': Context.generic -> Syntax.syntax -> (string -> xstring) -> term -> Pretty.T
+  val pretty_term': Proof.context -> Syntax.syntax -> (string -> xstring) -> term -> Pretty.T
   val pretty_term: theory -> term -> Pretty.T
   val pretty_typ: theory -> typ -> Pretty.T
   val pretty_sort: theory -> sort -> Pretty.T
@@ -161,15 +161,14 @@
   val no_vars: Pretty.pp -> term -> term
   val cert_def: Pretty.pp -> term -> (string * typ) * term
   val read_class: theory -> xstring -> class
-  val read_sort': Syntax.syntax -> Context.generic -> string -> sort
+  val read_sort': Syntax.syntax -> Proof.context -> string -> sort
   val read_sort: theory -> string -> sort
   val read_arity: theory -> xstring * string list * string -> arity
   val cert_arity: theory -> arity -> arity
-  val read_typ': Syntax.syntax -> Context.generic ->
+  val read_typ': Syntax.syntax -> Proof.context -> (indexname -> sort option) -> string -> typ
+  val read_typ_syntax': Syntax.syntax -> Proof.context ->
     (indexname -> sort option) -> string -> typ
-  val read_typ_syntax': Syntax.syntax -> Context.generic ->
-    (indexname -> sort option) -> string -> typ
-  val read_typ_abbrev': Syntax.syntax -> Context.generic ->
+  val read_typ_abbrev': Syntax.syntax -> Proof.context ->
     (indexname -> sort option) -> string -> typ
   val read_typ: theory * (indexname -> sort option) -> string -> typ
   val read_typ_syntax: theory * (indexname -> sort option) -> string -> typ
@@ -183,7 +182,7 @@
     (indexname -> sort option) -> Name.context -> bool
     -> term list * typ -> term * (indexname * typ) list
   val read_def_terms': Pretty.pp -> (string -> bool) -> Syntax.syntax -> Consts.T ->
-    Context.generic -> (indexname -> typ option) * (indexname -> sort option) ->
+    Proof.context -> (indexname -> typ option) * (indexname -> sort option) ->
     Name.context -> bool -> (string * typ) list -> term list * (indexname * typ) list
   val read_def_terms:
     theory * (indexname -> typ option) * (indexname -> sort option) ->
@@ -371,16 +370,19 @@
 
 (** pretty printing of terms, types etc. **)
 
-fun pretty_term' context syn ext t =
-  let val curried = Context.exists_name Context.CPureN (Context.theory_of context)
-  in Syntax.pretty_term ext context syn curried t end;
+fun pretty_term' ctxt syn ext t =
+  let val curried = Context.exists_name Context.CPureN (ProofContext.theory_of ctxt)
+  in Syntax.pretty_term ext ctxt syn curried t end;
 
 fun pretty_term thy t =
-  pretty_term' (Context.Theory thy) (syn_of thy) (Consts.extern (consts_of thy))
+  pretty_term' (ProofContext.init thy) (syn_of thy) (Consts.extern (consts_of thy))
     (extern_term (Consts.extern_early (consts_of thy)) thy t);
 
-fun pretty_typ thy T = Syntax.pretty_typ (Context.Theory thy) (syn_of thy) (extern_typ thy T);
-fun pretty_sort thy S = Syntax.pretty_sort (Context.Theory thy) (syn_of thy) (extern_sort thy S);
+fun pretty_typ thy T =
+  Syntax.pretty_typ (ProofContext.init thy) (syn_of thy) (extern_typ thy T);
+
+fun pretty_sort thy S =
+  Syntax.pretty_sort (ProofContext.init thy) (syn_of thy) (extern_sort thy S);
 
 fun pretty_classrel thy cs = Pretty.block (flat
   (separate [Pretty.str " <", Pretty.brk 1] (map (single o pretty_sort thy o single) cs)));
@@ -510,14 +512,14 @@
 fun read_class thy c = certify_class thy (intern_class thy c)
   handle TYPE (msg, _, _) => error msg;
 
-fun read_sort' syn context str =
+fun read_sort' syn ctxt str =
   let
-    val thy = Context.theory_of context;
+    val thy = ProofContext.theory_of ctxt;
     val _ = Context.check_thy thy;
-    val S = intern_sort thy (Syntax.read_sort context syn str);
+    val S = intern_sort thy (Syntax.read_sort ctxt syn str);
   in certify_sort thy S handle TYPE (msg, _, _) => error msg end;
 
-fun read_sort thy str = read_sort' (syn_of thy) (Context.Theory thy) str;
+fun read_sort thy str = read_sort' (syn_of thy) (ProofContext.init thy) str;
 
 
 (* type arities *)
@@ -534,17 +536,17 @@
 
 local
 
-fun gen_read_typ' cert syn context def_sort str =
+fun gen_read_typ' cert syn ctxt def_sort str =
   let
-    val thy = Context.theory_of context;
+    val thy = ProofContext.theory_of ctxt;
     val _ = Context.check_thy thy;
     val get_sort = TypeInfer.get_sort (tsig_of thy) def_sort (intern_sort thy);
-    val T = intern_tycons thy (Syntax.read_typ context syn get_sort (intern_sort thy) str);
+    val T = intern_tycons thy (Syntax.read_typ ctxt syn get_sort (intern_sort thy) str);
   in cert thy T handle TYPE (msg, _, _) => error msg end
   handle ERROR msg => cat_error msg ("The error(s) above occurred in type " ^ quote str);
 
 fun gen_read_typ cert (thy, def_sort) str =
-  gen_read_typ' cert (syn_of thy) (Context.Theory thy) def_sort str;
+  gen_read_typ' cert (syn_of thy) (ProofContext.init thy) def_sort str;
 
 in
 
@@ -620,12 +622,12 @@
 
 (* read_def_terms -- read terms and infer types *)    (*exception ERROR*)
 
-fun read_def_terms' pp is_logtype syn consts context (types, sorts) used freeze sTs =
+fun read_def_terms' pp is_logtype syn consts ctxt (types, sorts) used freeze sTs =
   let
-    val thy = Context.theory_of context;
+    val thy = ProofContext.theory_of ctxt;
     fun read (s, T) =
       let val T' = certify_typ thy T handle TYPE (msg, _, _) => error msg
-      in (Syntax.read context is_logtype syn T' s, T') end;
+      in (Syntax.read ctxt is_logtype syn T' s, T') end;
   in infer_types_simult pp thy consts types sorts used freeze (map read sTs) end;
 
 fun read_def_terms (thy, types, sorts) used freeze sTs =
@@ -635,7 +637,7 @@
     val cert_consts = Consts.certify pp (tsig_of thy) consts;
     val (ts, inst) =
       read_def_terms' pp (is_logtype thy) (syn_of thy) consts
-        (Context.Theory thy) (types, sorts) (Name.make_context used) freeze sTs;
+        (ProofContext.init thy) (types, sorts) (Name.make_context used) freeze sTs;
   in (map cert_consts ts, inst) end;
 
 fun simple_read_term thy T s =
@@ -827,7 +829,7 @@
 local
 
 fun advancedT false = ""
-  | advancedT true = "Context.generic -> ";
+  | advancedT true = "Proof.context -> ";
 
 fun advancedN false = ""
   | advancedN true = "advanced_";
@@ -870,7 +872,7 @@
 
 fun gen_trrules f args thy = thy |> map_syn (fn syn =>
   let val rules = map (Syntax.map_trrule (apfst (intern_type thy))) args
-  in f (Context.Theory thy) (is_logtype thy) syn rules syn end);
+  in f (ProofContext.init thy) (is_logtype thy) syn rules syn end);
 
 val add_trrules = gen_trrules Syntax.extend_trrules;
 val del_trrules = gen_trrules Syntax.remove_trrules;
--- a/src/Pure/theory.ML	Mon Dec 11 19:05:25 2006 +0100
+++ b/src/Pure/theory.ML	Mon Dec 11 21:39:26 2006 +0100
@@ -178,7 +178,7 @@
 
 fun read_def_axm (thy, types, sorts) used (name, str) =
   let
-    val ts = Syntax.read (Context.Theory thy) (Sign.is_logtype thy) (Sign.syn_of thy) propT str;
+    val ts = Syntax.read (ProofContext.init thy) (Sign.is_logtype thy) (Sign.syn_of thy) propT str;
     val (t, _) =
       Sign.infer_types (Sign.pp thy) thy (Sign.consts_of thy)
         types sorts (Name.make_context used) true (ts, propT);