src/Pure/General/markup.ML
author wenzelm
Sun, 20 Mar 2011 21:28:11 +0100
changeset 42883 2c3fe3cbebae
parent 41732 51310e1ccd6f
child 43008 da200fa2768c
permissions -rw-r--r--
structure Timing: covers former start_timing/end_timing and Output.timeit etc;
explicit Timing.message function;
eliminated Output.timing flag, cf. Toplevel.timing;
tuned;
     1 (*  Title:      Pure/General/markup.ML
     2     Author:     Makarius
     3 
     4 Common markup elements.
     5 *)
     6 
     7 signature MARKUP =
     8 sig
     9   val parse_int: string -> int
    10   val print_int: int -> string
    11   type T = string * Properties.T
    12   val empty: T
    13   val is_empty: T -> bool
    14   val properties: Properties.T -> T -> T
    15   val nameN: string
    16   val name: string -> T -> T
    17   val kindN: string
    18   val bindingN: string val binding: string -> T
    19   val entityN: string val entity: string -> T
    20   val defN: string
    21   val refN: string
    22   val lineN: string
    23   val columnN: string
    24   val offsetN: string
    25   val end_offsetN: string
    26   val fileN: string
    27   val idN: string
    28   val position_properties': string list
    29   val position_properties: string list
    30   val positionN: string val position: T
    31   val indentN: string
    32   val blockN: string val block: int -> T
    33   val widthN: string
    34   val breakN: string val break: int -> T
    35   val fbreakN: string val fbreak: T
    36   val hiddenN: string val hidden: T
    37   val tclassN: string val tclass: string -> T
    38   val tyconN: string val tycon: string -> T
    39   val fixed_declN: string val fixed_decl: string -> T
    40   val fixedN: string val fixed: string -> T
    41   val const_declN: string val const_decl: string -> T
    42   val constN: string val const: string -> T
    43   val fact_declN: string val fact_decl: string -> T
    44   val factN: string val fact: string -> T
    45   val dynamic_factN: string val dynamic_fact: string -> T
    46   val local_fact_declN: string val local_fact_decl: string -> T
    47   val local_factN: string val local_fact: string -> T
    48   val tfreeN: string val tfree: T
    49   val tvarN: string val tvar: T
    50   val freeN: string val free: T
    51   val skolemN: string val skolem: T
    52   val boundN: string val bound: T
    53   val varN: string val var: T
    54   val numeralN: string val numeral: T
    55   val literalN: string val literal: T
    56   val inner_stringN: string val inner_string: T
    57   val inner_commentN: string val inner_comment: T
    58   val token_rangeN: string val token_range: T
    59   val sortN: string val sort: T
    60   val typN: string val typ: T
    61   val termN: string val term: T
    62   val propN: string val prop: T
    63   val attributeN: string val attribute: string -> T
    64   val methodN: string val method: string -> T
    65   val ML_keywordN: string val ML_keyword: T
    66   val ML_delimiterN: string val ML_delimiter: T
    67   val ML_identN: string val ML_ident: T
    68   val ML_tvarN: string val ML_tvar: T
    69   val ML_numeralN: string val ML_numeral: T
    70   val ML_charN: string val ML_char: T
    71   val ML_stringN: string val ML_string: T
    72   val ML_commentN: string val ML_comment: T
    73   val ML_malformedN: string val ML_malformed: T
    74   val ML_defN: string val ML_def: T
    75   val ML_openN: string val ML_open: T
    76   val ML_structN: string val ML_struct: T
    77   val ML_refN: string val ML_ref: T
    78   val ML_typingN: string val ML_typing: T
    79   val ML_sourceN: string val ML_source: T
    80   val doc_sourceN: string val doc_source: T
    81   val antiqN: string val antiq: T
    82   val ML_antiqN: string val ML_antiq: string -> T
    83   val doc_antiqN: string val doc_antiq: string -> T
    84   val keyword_declN: string val keyword_decl: string -> T
    85   val command_declN: string val command_decl: string -> string -> T
    86   val keywordN: string val keyword: T
    87   val operatorN: string val operator: T
    88   val commandN: string val command: T
    89   val identN: string val ident: T
    90   val stringN: string val string: T
    91   val altstringN: string val altstring: T
    92   val verbatimN: string val verbatim: T
    93   val commentN: string val comment: T
    94   val controlN: string val control: T
    95   val malformedN: string val malformed: T
    96   val tokenN: string val token: Properties.T -> T
    97   val command_spanN: string val command_span: string -> T
    98   val ignored_spanN: string val ignored_span: T
    99   val malformed_spanN: string val malformed_span: T
   100   val elapsedN: string
   101   val cpuN: string
   102   val gcN: string
   103   val timingN: string val timing: Timing.timing -> T
   104   val subgoalsN: string
   105   val proof_stateN: string val proof_state: int -> T
   106   val stateN: string val state: T
   107   val subgoalN: string val subgoal: T
   108   val sendbackN: string val sendback: T
   109   val hiliteN: string val hilite: T
   110   val taskN: string
   111   val forkedN: string val forked: T
   112   val joinedN: string val joined: T
   113   val failedN: string val failed: T
   114   val finishedN: string val finished: T
   115   val versionN: string
   116   val execN: string
   117   val assignN: string val assign: int -> T
   118   val editN: string val edit: int -> int -> T
   119   val serialN: string
   120   val promptN: string val prompt: T
   121   val readyN: string val ready: T
   122   val reportN: string val report: T
   123   val no_reportN: string val no_report: T
   124   val badN: string val bad: T
   125   val no_output: Output.output * Output.output
   126   val default_output: T -> Output.output * Output.output
   127   val add_mode: string -> (T -> Output.output * Output.output) -> unit
   128   val output: T -> Output.output * Output.output
   129   val enclose: T -> Output.output -> Output.output
   130   val markup: T -> string -> string
   131 end;
   132 
   133 structure Markup: MARKUP =
   134 struct
   135 
   136 (** markup elements **)
   137 
   138 (* integers *)
   139 
   140 fun parse_int s =
   141   (case Int.fromString s of
   142     SOME i => i
   143   | NONE => raise Fail ("Bad integer: " ^ quote s));
   144 
   145 val print_int = signed_string_of_int;
   146 
   147 
   148 (* basic markup *)
   149 
   150 type T = string * Properties.T;
   151 
   152 val empty = ("", []);
   153 
   154 fun is_empty ("", _) = true
   155   | is_empty _ = false;
   156 
   157 
   158 fun properties more_props ((elem, props): T) =
   159   (elem, fold_rev Properties.put more_props props);
   160 
   161 fun markup_elem elem = (elem, (elem, []): T);
   162 fun markup_string elem prop = (elem, fn s => (elem, [(prop, s)]): T);
   163 fun markup_int elem prop = (elem, fn i => (elem, [(prop, print_int i)]): T);
   164 
   165 
   166 (* misc properties *)
   167 
   168 val nameN = "name";
   169 fun name a = properties [(nameN, a)];
   170 
   171 val kindN = "kind";
   172 
   173 
   174 (* formal entities *)
   175 
   176 val (bindingN, binding) = markup_string "binding" nameN;
   177 val (entityN, entity) = markup_string "entity" nameN;
   178 
   179 val defN = "def";
   180 val refN = "ref";
   181 
   182 
   183 (* position *)
   184 
   185 val lineN = "line";
   186 val columnN = "column";
   187 val offsetN = "offset";
   188 val end_offsetN = "end_offset";
   189 val fileN = "file";
   190 val idN = "id";
   191 
   192 val position_properties' = [fileN, idN];
   193 val position_properties = [lineN, columnN, offsetN, end_offsetN] @ position_properties';
   194 
   195 val (positionN, position) = markup_elem "position";
   196 
   197 
   198 (* pretty printing *)
   199 
   200 val indentN = "indent";
   201 val (blockN, block) = markup_int "block" indentN;
   202 
   203 val widthN = "width";
   204 val (breakN, break) = markup_int "break" widthN;
   205 
   206 val (fbreakN, fbreak) = markup_elem "fbreak";
   207 
   208 
   209 (* hidden text *)
   210 
   211 val (hiddenN, hidden) = markup_elem "hidden";
   212 
   213 
   214 (* logical entities *)
   215 
   216 val (tclassN, tclass) = markup_string "tclass" nameN;
   217 val (tyconN, tycon) = markup_string "tycon" nameN;
   218 val (fixed_declN, fixed_decl) = markup_string "fixed_decl" nameN;
   219 val (fixedN, fixed) = markup_string "fixed" nameN;
   220 val (const_declN, const_decl) = markup_string "const_decl" nameN;
   221 val (constN, const) = markup_string "const" nameN;
   222 val (fact_declN, fact_decl) = markup_string "fact_decl" nameN;
   223 val (factN, fact) = markup_string "fact" nameN;
   224 val (dynamic_factN, dynamic_fact) = markup_string "dynamic_fact" nameN;
   225 val (local_fact_declN, local_fact_decl) = markup_string "local_fact_decl" nameN;
   226 val (local_factN, local_fact) = markup_string "local_fact" nameN;
   227 
   228 
   229 (* inner syntax *)
   230 
   231 val (tfreeN, tfree) = markup_elem "tfree";
   232 val (tvarN, tvar) = markup_elem "tvar";
   233 val (freeN, free) = markup_elem "free";
   234 val (skolemN, skolem) = markup_elem "skolem";
   235 val (boundN, bound) = markup_elem "bound";
   236 val (varN, var) = markup_elem "var";
   237 val (numeralN, numeral) = markup_elem "numeral";
   238 val (literalN, literal) = markup_elem "literal";
   239 val (inner_stringN, inner_string) = markup_elem "inner_string";
   240 val (inner_commentN, inner_comment) = markup_elem "inner_comment";
   241 
   242 val (token_rangeN, token_range) = markup_elem "token_range";
   243 
   244 val (sortN, sort) = markup_elem "sort";
   245 val (typN, typ) = markup_elem "typ";
   246 val (termN, term) = markup_elem "term";
   247 val (propN, prop) = markup_elem "prop";
   248 
   249 val (attributeN, attribute) = markup_string "attribute" nameN;
   250 val (methodN, method) = markup_string "method" nameN;
   251 
   252 
   253 (* ML syntax *)
   254 
   255 val (ML_keywordN, ML_keyword) = markup_elem "ML_keyword";
   256 val (ML_delimiterN, ML_delimiter) = markup_elem "ML_delimiter";
   257 val (ML_identN, ML_ident) = markup_elem "ML_ident";
   258 val (ML_tvarN, ML_tvar) = markup_elem "ML_tvar";
   259 val (ML_numeralN, ML_numeral) = markup_elem "ML_numeral";
   260 val (ML_charN, ML_char) = markup_elem "ML_char";
   261 val (ML_stringN, ML_string) = markup_elem "ML_string";
   262 val (ML_commentN, ML_comment) = markup_elem "ML_comment";
   263 val (ML_malformedN, ML_malformed) = markup_elem "ML_malformed";
   264 
   265 val (ML_defN, ML_def) = markup_elem "ML_def";
   266 val (ML_openN, ML_open) = markup_elem "ML_open";
   267 val (ML_structN, ML_struct) = markup_elem "ML_struct";
   268 val (ML_refN, ML_ref) = markup_elem "ML_ref";
   269 val (ML_typingN, ML_typing) = markup_elem "ML_typing";
   270 
   271 
   272 (* embedded source text *)
   273 
   274 val (ML_sourceN, ML_source) = markup_elem "ML_source";
   275 val (doc_sourceN, doc_source) = markup_elem "doc_source";
   276 
   277 val (antiqN, antiq) = markup_elem "antiq";
   278 val (ML_antiqN, ML_antiq) = markup_string "ML_antiq" nameN;
   279 val (doc_antiqN, doc_antiq) = markup_string "doc_antiq" nameN;
   280 
   281 
   282 (* outer syntax *)
   283 
   284 val (keyword_declN, keyword_decl) = markup_string "keyword_decl" nameN;
   285 
   286 val command_declN = "command_decl";
   287 fun command_decl name kind : T = (command_declN, [(nameN, name), (kindN, kind)]);
   288 
   289 val (keywordN, keyword) = markup_elem "keyword";
   290 val (operatorN, operator) = markup_elem "operator";
   291 val (commandN, command) = markup_elem "command";
   292 val (identN, ident) = markup_elem "ident";
   293 val (stringN, string) = markup_elem "string";
   294 val (altstringN, altstring) = markup_elem "altstring";
   295 val (verbatimN, verbatim) = markup_elem "verbatim";
   296 val (commentN, comment) = markup_elem "comment";
   297 val (controlN, control) = markup_elem "control";
   298 val (malformedN, malformed) = markup_elem "malformed";
   299 
   300 val tokenN = "token";
   301 fun token props = (tokenN, props);
   302 
   303 val (command_spanN, command_span) = markup_string "command_span" nameN;
   304 val (ignored_spanN, ignored_span) = markup_elem "ignored_span";
   305 val (malformed_spanN, malformed_span) = markup_elem "malformed_span";
   306 
   307 
   308 (* timing *)
   309 
   310 val timingN = "timing";
   311 val elapsedN = "elapsed";
   312 val cpuN = "cpu";
   313 val gcN = "gc";
   314 
   315 fun timing {elapsed, cpu, gc} =
   316   (timingN,
   317    [(elapsedN, Time.toString elapsed),
   318     (cpuN, Time.toString cpu),
   319     (gcN, Time.toString gc)]);
   320 
   321 
   322 (* toplevel *)
   323 
   324 val subgoalsN = "subgoals";
   325 val (proof_stateN, proof_state) = markup_int "proof_state" subgoalsN;
   326 
   327 val (stateN, state) = markup_elem "state";
   328 val (subgoalN, subgoal) = markup_elem "subgoal";
   329 val (sendbackN, sendback) = markup_elem "sendback";
   330 val (hiliteN, hilite) = markup_elem "hilite";
   331 
   332 
   333 (* command status *)
   334 
   335 val taskN = "task";
   336 
   337 val (forkedN, forked) = markup_elem "forked";
   338 val (joinedN, joined) = markup_elem "joined";
   339 
   340 val (failedN, failed) = markup_elem "failed";
   341 val (finishedN, finished) = markup_elem "finished";
   342 
   343 
   344 (* interactive documents *)
   345 
   346 val versionN = "version";
   347 val execN = "exec";
   348 val (assignN, assign) = markup_int "assign" versionN;
   349 
   350 val editN = "edit";
   351 fun edit cmd_id exec_id : T = (editN, [(idN, print_int cmd_id), (execN, print_int exec_id)]);
   352 
   353 
   354 (* messages *)
   355 
   356 val serialN = "serial";
   357 
   358 val (promptN, prompt) = markup_elem "prompt";
   359 val (readyN, ready) = markup_elem "ready";
   360 
   361 val (reportN, report) = markup_elem "report";
   362 val (no_reportN, no_report) = markup_elem "no_report";
   363 
   364 val (badN, bad) = markup_elem "bad";
   365 
   366 
   367 
   368 (** print mode operations **)
   369 
   370 val no_output = ("", "");
   371 fun default_output (_: T) = no_output;
   372 
   373 local
   374   val default = {output = default_output};
   375   val modes = Unsynchronized.ref (Symtab.make [("", default)]);
   376 in
   377   fun add_mode name output = CRITICAL (fn () =>
   378     Unsynchronized.change modes (Symtab.update_new (name, {output = output})));
   379   fun get_mode () =
   380     the_default default (Library.get_first (Symtab.lookup (! modes)) (print_mode_value ()));
   381 end;
   382 
   383 fun output m = if is_empty m then no_output else #output (get_mode ()) m;
   384 
   385 val enclose = output #-> Library.enclose;
   386 
   387 fun markup m =
   388   let val (bg, en) = output m
   389   in Library.enclose (Output.escape bg) (Output.escape en) end;
   390 
   391 end;