adapted tsig/sg interface;
authorwenzelm
Fri, 21 May 2004 21:28:14 +0200
changeset 14794 751d5af6d91e
parent 14793 32d94d1e4842
child 14795 b702848de41f
adapted tsig/sg interface;
src/Pure/display.ML
--- a/src/Pure/display.ML	Fri May 21 21:28:01 2004 +0200
+++ b/src/Pure/display.ML	Fri May 21 21:28:14 2004 +0200
@@ -186,26 +186,24 @@
     fun prt_typ_no_tvars ty = Pretty.quote (Sign.pretty_typ sg (#1 (Type.freeze_thaw_type ty)));
     fun prt_term t = Pretty.quote (Sign.pretty_term sg t);
 
-    fun pretty_classes cs = Pretty.block
-      (Pretty.breaks (Pretty.str "classes:" :: map prt_cls cs));
-
-    fun pretty_classrel (c, cs) = Pretty.block
-      (prt_cls c :: Pretty.str " <" :: Pretty.brk 1 ::
-        Pretty.commas (map prt_cls cs));
+    fun pretty_classrel (c, []) = prt_cls c
+      | pretty_classrel (c, cs) = Pretty.block
+          (prt_cls c :: Pretty.str " <" :: Pretty.brk 1 ::
+            Pretty.commas (map prt_cls cs));
 
     fun pretty_default S = Pretty.block
-      [Pretty.str "default:", Pretty.brk 1, prt_sort S];
+      [Pretty.str "default sort:", Pretty.brk 1, prt_sort S];
 
     fun pretty_ty (t, n) = Pretty.block
       [Pretty.str t, Pretty.brk 1, Pretty.str (string_of_int n)];
 
-    fun pretty_log_types ts = Pretty.block
-      (Pretty.breaks (Pretty.str "logical types:" :: map Pretty.str ts));
-
     fun pretty_witness None = Pretty.str "universal non-emptiness witness: --"
       | pretty_witness (Some (T, S)) = Pretty.block
-          [Pretty.str "universal non-emptiness witness:", Pretty.brk 1, prt_typ_no_tvars T,
-            Pretty.brk 1, prt_sort S];
+          [Pretty.str "universal non-emptiness witness:", Pretty.brk 1,
+            prt_typ_no_tvars T, Pretty.str " ::", Pretty.brk 1, prt_sort S];
+
+    fun pretty_nonterminals ts = Pretty.block
+      (Pretty.breaks (Pretty.str "syntactic types:" :: map Pretty.str ts));
 
     fun pretty_abbr (t, (vs, rhs)) = Pretty.block
       [prt_typ_no_tvars (Type (t, map (fn v => TVar ((v, 0), [])) vs)),
@@ -218,20 +216,23 @@
          (if null tys then [Pretty.str "<all instances>"]
 	  else Pretty.commas (map prt_typ_no_tvars tys)));
 
-    fun pretty_const (c, ty) = Pretty.block
+    fun pretty_const (c, (ty, _)) = Pretty.block
       [Pretty.str c, Pretty.str " ::", Pretty.brk 1, prt_typ_no_tvars ty];
 
     fun prt_axm (a, t) = Pretty.block [Pretty.str (a ^ ":"), Pretty.brk 1, prt_term t];
 
 
-    val {self = _, tsig, const_tab, path, spaces, data} = Sign.rep_sg sg;
+    val {self = _, tsig, consts, path, spaces, data} = Sign.rep_sg sg;
     val {axioms, oracles, ...} = Theory.rep_theory thy;
     val spaces' = Library.sort_wrt fst spaces;
-    val {classes, classrel, default, tycons = type_tab, log_types, univ_witness, abbrs, arities} =
-      Type.rep_tsig tsig;
-    val finals = Symtab.dest (#final_consts (rep_theory thy));
-    val tycons = Sign.cond_extern_table sg Sign.typeK type_tab;
-    val consts = Sign.cond_extern_table sg Sign.constK const_tab;
+    val {classes, default, types, arities, log_types = _, witness} = Type.rep_tsig tsig;
+    val tdecls = Symtab.dest types |>
+      map (fn (t, (decl, _)) => (Sign.cond_extern sg Sign.typeK t, decl));
+    val tycons = mapfilter (fn (t, Type.LogicalType n) => Some (t, n) | _ => None) tdecls;
+    val abbrs = mapfilter (fn (t, Type.Abbreviation u) => Some (t, u) | _ => None) tdecls;
+    val nonterminals = mapfilter (fn (t, Type.Nonterminal) => Some t | _ => None) tdecls;
+    val finals = Symtab.dest (#final_consts (Theory.rep_theory thy));
+    val cnsts = Sign.cond_extern_table sg Sign.constK consts;
     val axms = Sign.cond_extern_table sg Theory.axiomK axioms;
     val oras = Sign.cond_extern_table sg Theory.oracleK oracles;
   in
@@ -239,15 +240,14 @@
       Pretty.strs ("data:" :: Sign.data_kinds data),
       Pretty.strs ["name prefix:", NameSpace.pack (if_none path ["-"])],
       Pretty.big_list "name spaces:" (map pretty_name_space spaces'),
-      pretty_classes classes,
-      Pretty.big_list "class relation:" (map pretty_classrel (Symtab.dest classrel)),
+      Pretty.big_list "classes:" (map pretty_classrel (Graph.dest classes)),
       pretty_default default,
-      pretty_log_types log_types,
-      pretty_witness univ_witness,
-      Pretty.big_list "type constructors:" (map pretty_ty tycons),
-      Pretty.big_list "type abbreviations:" (map pretty_abbr (Symtab.dest abbrs)),
+      pretty_witness witness,
+      Pretty.big_list "logical type constructors:" (map pretty_ty tycons),
+      Pretty.big_list "type abbreviations:" (map pretty_abbr abbrs),
+      pretty_nonterminals nonterminals,
       Pretty.big_list "type arities:" (flat (map pretty_arities (Symtab.dest arities))),
-      Pretty.big_list "consts:" (map pretty_const consts),
+      Pretty.big_list "consts:" (map pretty_const cnsts),
       Pretty.big_list "finals:" (map pretty_final finals),
       Pretty.big_list "axioms:" (map prt_axm axms),
       Pretty.strs ("oracles:" :: (map #1 oras))]