report commands as formal entities, with def/ref positions;
authorwenzelm
Thu, 02 Aug 2012 13:37:58 +0200
changeset 49662a5144c4c26a2
parent 49661 91281e9472d8
child 49663 f13eeeea1a69
report commands as formal entities, with def/ref positions;
src/Pure/Isar/outer_syntax.ML
     1.1 --- a/src/Pure/Isar/outer_syntax.ML	Thu Aug 02 12:36:54 2012 +0200
     1.2 +++ b/src/Pure/Isar/outer_syntax.ML	Thu Aug 02 13:37:58 2012 +0200
     1.3 @@ -49,10 +49,17 @@
     1.4   {comment: string,
     1.5    markup: Thy_Output.markup option,
     1.6    int_only: bool,
     1.7 -  parse: (Toplevel.transition -> Toplevel.transition) parser};
     1.8 +  parse: (Toplevel.transition -> Toplevel.transition) parser,
     1.9 +  pos: Position.T,
    1.10 +  id: serial};
    1.11  
    1.12 -fun make_command comment markup int_only parse =
    1.13 -  Command {comment = comment, markup = markup, int_only = int_only, parse = parse};
    1.14 +fun new_command comment markup int_only parse pos =
    1.15 +  Command {comment = comment, markup = markup, int_only = int_only, parse = parse,
    1.16 +    pos = pos, id = serial ()};
    1.17 +
    1.18 +fun command_markup def (name, Command {pos, id, ...}) =
    1.19 +  Markup.properties (Position.entity_properties_of def id pos)
    1.20 +    (Isabelle_Markup.entity Isabelle_Markup.commandN name);
    1.21  
    1.22  
    1.23  (* parse command *)
    1.24 @@ -125,9 +132,10 @@
    1.25  (*synchronized wrt. Keywords*)
    1.26  val global_outer_syntax = Unsynchronized.ref empty_outer_syntax;
    1.27  
    1.28 -fun add_command ((name, kind), pos) cmd = CRITICAL (fn () =>
    1.29 +fun add_command (name, kind) cmd = CRITICAL (fn () =>
    1.30    let
    1.31      val thy = ML_Context.the_global_context ();
    1.32 +    val Command {pos, ...} = cmd;
    1.33      val _ =
    1.34        (case try (Thy_Header.the_keyword thy) name of
    1.35          SOME spec =>
    1.36 @@ -138,6 +146,7 @@
    1.37            if Context.theory_name thy = Context.PureN
    1.38            then Keyword.define (name, SOME kind)
    1.39            else error ("Undeclared outer syntax command " ^ quote name ^ Position.str_of pos));
    1.40 +    val _ = Position.report pos (command_markup true (name, cmd));
    1.41    in
    1.42      Unsynchronized.change global_outer_syntax (map_commands (fn commands =>
    1.43       (if not (Symtab.defined commands name) then ()
    1.44 @@ -160,14 +169,14 @@
    1.45  
    1.46  fun lookup_commands_dynamic () = lookup_commands (! global_outer_syntax);
    1.47  
    1.48 -fun command command_spec comment parse =
    1.49 -  add_command command_spec (make_command comment NONE false parse);
    1.50 +fun command (spec, pos) comment parse =
    1.51 +  add_command spec (new_command comment NONE false parse pos);
    1.52  
    1.53 -fun markup_command markup command_spec comment parse =
    1.54 -  add_command command_spec (make_command comment (SOME markup) false parse);
    1.55 +fun markup_command markup (spec, pos) comment parse =
    1.56 +  add_command spec (new_command comment (SOME markup) false parse pos);
    1.57  
    1.58 -fun improper_command command_spec comment parse =
    1.59 -  add_command command_spec (make_command comment NONE true parse);
    1.60 +fun improper_command (spec, pos) comment parse =
    1.61 +  add_command spec (new_command comment NONE true parse pos);
    1.62  
    1.63  end;
    1.64  
    1.65 @@ -266,7 +275,16 @@
    1.66    let
    1.67      val commands = lookup_commands outer_syntax;
    1.68      val range_pos = Position.set_range (Token.range toks);
    1.69 -    val _ = Position.reports (maps Thy_Syntax.reports_of_token toks);
    1.70 +
    1.71 +    fun command_reports tok =
    1.72 +      if Token.kind_of tok = Token.Command then
    1.73 +        let val name = Token.content_of tok in
    1.74 +          (case commands name of
    1.75 +            NONE => []
    1.76 +          | SOME cmd => [(Token.position_of tok, command_markup false (name, cmd))])
    1.77 +        end
    1.78 +      else [];
    1.79 +    val _ = Position.reports (maps Thy_Syntax.reports_of_token toks @ maps command_reports toks);
    1.80    in
    1.81      (case Source.exhaust (toplevel_source false NONE (K commands) (Source.of_list toks)) of
    1.82        [tr] =>