printed "_ofsort" is subject to show_markup as well;
authorwenzelm
Wed, 03 Oct 2012 16:01:07 +0200
changeset 49686 678aa92e921c
parent 49685 4341e4d86872
child 49687 4b9034f089eb
printed "_ofsort" is subject to show_markup as well;
src/Pure/Syntax/syntax_phases.ML
--- a/src/Pure/Syntax/syntax_phases.ML	Wed Oct 03 14:58:56 2012 +0200
+++ b/src/Pure/Syntax/syntax_phases.ML	Wed Oct 03 16:01:07 2012 +0200
@@ -451,17 +451,20 @@
 fun term_of_typ ctxt ty =
   let
     val show_sorts = Config.get ctxt show_sorts;
+    val show_markup = Config.get ctxt show_markup;
 
-    fun of_sort t S =
-      if show_sorts then Syntax.const "_ofsort" $ t $ term_of_sort S
+    fun ofsort t raw_S =
+      if show_sorts orelse show_markup then
+        let val S = #2 (Term_Position.decode_positionS raw_S)
+        in if S = dummyS then t else Syntax.const "_ofsort" $ t $ term_of_sort S end
       else t;
 
     fun term_of (Type (a, Ts)) =
           Term.list_comb (Syntax.const (Lexicon.mark_type a), map term_of Ts)
       | term_of (TFree (x, S)) =
           if is_some (Term_Position.decode x) then Syntax.free x
-          else of_sort (Syntax.const "_tfree" $ Syntax.free x) S
-      | term_of (TVar (xi, S)) = of_sort (Syntax.const "_tvar" $ Syntax.var xi) S;
+          else ofsort (Syntax.const "_tfree" $ Syntax.free x) S
+      | term_of (TVar (xi, S)) = ofsort (Syntax.const "_tvar" $ Syntax.var xi) S;
   in term_of ty end;
 
 
@@ -620,13 +623,15 @@
   | NONE => (Isabelle_Markup.var, s));
 
 val typing_elem = YXML.output_markup_elem Isabelle_Markup.typing;
+val sorting_elem = YXML.output_markup_elem Isabelle_Markup.sorting;
 
 fun unparse_t t_to_ast prt_t markup ctxt t =
   let
+    val show_markup = Config.get ctxt show_markup;
+    val show_sorts = Config.get ctxt show_sorts;
     val show_types =
-      Config.get ctxt show_types orelse Config.get ctxt show_sorts orelse
+      Config.get ctxt show_types orelse show_sorts orelse
       Config.get ctxt show_all_types;
-    val show_markup = Config.get ctxt show_markup;
 
     val syn = Proof_Context.syn_of ctxt;
     val prtabs = Syntax.prtabs syn;
@@ -656,16 +661,25 @@
     fun markup_trans a [Ast.Variable x] = token_trans a x
       | markup_trans "_constrain" [t, ty] = constrain_trans t ty
       | markup_trans "_idtyp" [t, ty] = constrain_trans t ty
+      | markup_trans "_ofsort" [ty, s] = ofsort_trans ty s
       | markup_trans _ _ = NONE
 
     and constrain_trans t ty =
-      if not show_types andalso show_markup then
+      if show_markup andalso not show_types then
         let
           val ((bg1, bg2), en) = typing_elem;
           val bg = bg1 ^ Pretty.symbolic_output (pretty_typ_ast Markup.empty ty) ^ bg2;
         in SOME (Pretty.raw_markup (bg, en) (0, [pretty_ast Markup.empty t])) end
       else NONE
 
+    and ofsort_trans ty s =
+      if show_markup andalso not show_sorts then
+        let
+          val ((bg1, bg2), en) = sorting_elem;
+          val bg = bg1 ^ Pretty.symbolic_output (pretty_typ_ast Markup.empty s) ^ bg2;
+        in SOME (Pretty.raw_markup (bg, en) (0, [pretty_typ_ast Markup.empty ty])) end
+      else NONE
+
     and pretty_typ_ast m ast = ast
       |> Printer.pretty_typ_ast ctxt prtabs trf markup_trans markup_extern
       |> Pretty.markup m