src/Pure/Isar/isar_output.ML
changeset 17185 5140808111d1
parent 17151 bc97adfeeaa7
child 17221 6cd180204582
equal deleted inserted replaced
17184:3d80209e9a53 17185:5140808111d1
   204 
   204 
   205 
   205 
   206 (* command spans *)
   206 (* command spans *)
   207 
   207 
   208 type command = string * Position.T * string list;   (*name, position, tags*)
   208 type command = string * Position.T * string list;   (*name, position, tags*)
   209 type tok = string * token * int;                    (*raw text, token, meta-comment depth*)
   209 type tok = token * string * int;                    (*token, markup flag, meta-comment depth*)
   210 type source = tok list;          
   210 type source = tok list;
   211 
   211 
   212 datatype span = Span of command * (source * source * source * source) * bool;
   212 datatype span = Span of command * (source * source * source * source) * bool;
   213 
   213 
   214 fun make_span cmd src =
   214 fun make_span cmd src =
   215   let
   215   let
   216     fun take_newline ((tok: tok) :: toks) =
   216     fun take_newline ((tok: tok) :: toks) =
   217           if newline_token (#2 tok) then ([tok], toks, true)
   217           if newline_token (#1 tok) then ([tok], toks, true)
   218           else ([], tok :: toks, false)
   218           else ([], tok :: toks, false)
   219       | take_newline [] = ([], [], false);
   219       | take_newline [] = ([], [], false);
   220     val (((src_prefix, src_main), src_suffix1), (src_suffix2, src_appendix, newline)) =
   220     val (((src_prefix, src_main), src_suffix1), (src_suffix2, src_appendix, newline)) =
   221       src
   221       src
   222       |> take_prefix (improper_token o #2)
   222       |> take_prefix (improper_token o #1)
   223       ||>> take_suffix (improper_token o #2)
   223       ||>> take_suffix (improper_token o #1)
   224       ||>> take_prefix (comment_token o #2)
   224       ||>> take_prefix (comment_token o #1)
   225       ||> take_newline;      
   225       ||> take_newline;
   226   in Span (cmd, (src_prefix, src_main, src_suffix1 @ src_suffix2, src_appendix), newline) end;
   226   in Span (cmd, (src_prefix, src_main, src_suffix1 @ src_suffix2, src_appendix), newline) end;
   227 
   227 
   228 
   228 
   229 (* present spans *)
   229 (* present spans *)
   230 
   230 
   244 in
   244 in
   245 
   245 
   246 fun present_span lex default_tags span state state'
   246 fun present_span lex default_tags span state state'
   247     (tag_stack, active_tag, newline, buffer, present_cont) =
   247     (tag_stack, active_tag, newline, buffer, present_cont) =
   248   let
   248   let
   249     val present = fold (fn (raw, tok, d) =>
   249     val present = fold (fn (tok, flag, 0) =>
   250       Buffer.add raw o (if d > 0 then I else Buffer.add (output_token lex state' tok)));
   250       Buffer.add (output_token lex state' tok) #> Buffer.add flag | _ => I);
   251 
   251 
   252     val Span ((cmd_name, cmd_pos, cmd_tags), srcs, span_newline) = span;
   252     val Span ((cmd_name, cmd_pos, cmd_tags), srcs, span_newline) = span;
   253 
   253 
   254     val (tag, tags) = tag_stack;
   254     val (tag, tags) = tag_stack;
   255     val tag' =
   255     val tag' =
   327 fun present_thy lex default_tags is_markup trs src =
   327 fun present_thy lex default_tags is_markup trs src =
   328   let
   328   let
   329     (* tokens *)
   329     (* tokens *)
   330 
   330 
   331     val ignored = Scan.state --| ignore
   331     val ignored = Scan.state --| ignore
   332       >> (fn d => (NONE, ("", NoToken, d)));
   332       >> (fn d => (NONE, (NoToken, "", d)));
   333 
   333 
   334     fun markup flag mark mk = Scan.peek (fn d =>
   334     fun markup mark mk flag = Scan.peek (fn d =>
   335       improper |--
   335       improper |--
   336       P.position (Scan.one (T.is_kind T.Command andf is_markup mark o T.val_of)) --
   336       P.position (Scan.one (T.is_kind T.Command andf is_markup mark o T.val_of)) --
   337       Scan.repeat tag --
   337       Scan.repeat tag --
   338       P.!!!! (improper |-- P.position P.text --| improper_end)
   338       P.!!!! (improper |-- P.position P.text --| improper_end)
   339       >> (fn (((tok, pos), tags), txt) =>
   339       >> (fn (((tok, pos), tags), txt) =>
   340         let val name = T.val_of tok
   340         let val name = T.val_of tok
   341         in (SOME (name, pos, tags), (flag, mk (name, txt), d)) end));
   341         in (SOME (name, pos, tags), (mk (name, txt), flag, d)) end));
   342 
   342 
   343     val command = Scan.peek (fn d =>
   343     val command = Scan.peek (fn d =>
   344       P.position (Scan.one (T.is_kind T.Command)) --
   344       P.position (Scan.one (T.is_kind T.Command)) --
   345       Scan.repeat tag
   345       Scan.repeat tag
   346       >> (fn ((tok, pos), tags) =>
   346       >> (fn ((tok, pos), tags) =>
   347         let val name = T.val_of tok
   347         let val name = T.val_of tok
   348         in (SOME (name, pos, tags), (Latex.markup_false, BasicToken tok, d)) end));
   348         in (SOME (name, pos, tags), (BasicToken tok, Latex.markup_false, d)) end));
   349 
   349 
   350     val cmt = Scan.peek (fn d =>
   350     val cmt = Scan.peek (fn d =>
   351       P.$$$ "--" |-- P.!!!! (improper |-- P.position P.text)
   351       P.$$$ "--" |-- P.!!!! (improper |-- P.position P.text)
   352       >> (fn txt => (NONE, ("", MarkupToken ("cmt", txt), d))));
   352       >> (fn txt => (NONE, (MarkupToken ("cmt", txt), "", d))));
   353 
   353 
   354     val other = Scan.peek (fn d =>
   354     val other = Scan.peek (fn d =>
   355        Scan.one T.not_eof >> (fn tok => (NONE, ("", BasicToken tok, d))));
   355        Scan.one T.not_eof >> (fn tok => (NONE, (BasicToken tok, "", d))));
   356 
   356 
   357     val token =
   357     val token =
   358       ignored ||
   358       ignored ||
   359       markup Latex.markup_true Markup MarkupToken ||
   359       markup Markup MarkupToken Latex.markup_true ||
   360       markup Latex.markup_true MarkupEnv MarkupEnvToken ||
   360       markup MarkupEnv MarkupEnvToken Latex.markup_true ||
   361       markup "" Verbatim (VerbatimToken o #2) ||
   361       markup Verbatim (VerbatimToken o #2) "" ||
   362       command || cmt || other;
   362       command || cmt || other;
   363 
   363 
   364 
   364 
   365     (* spans *)
   365     (* spans *)
   366 
   366 
   367     val stopper =
   367     val stopper =
   368       ((NONE, ("", BasicToken (#1 T.stopper), 0)),
   368       ((NONE, (BasicToken (#1 T.stopper), "", 0)),
   369         fn (_, (_, BasicToken x, _)) => #2 T.stopper x | _ => false);
   369         fn (_, (BasicToken x, _, _)) => #2 T.stopper x | _ => false);
   370 
   370 
   371     val cmd = Scan.one (is_some o #1);
   371     val cmd = Scan.one (is_some o #1);
   372     val non_cmd = Scan.one (is_none o #1 andf not o #2 stopper) >> #2;
   372     val non_cmd = Scan.one (is_none o #1 andf not o #2 stopper) >> #2;
   373 
   373 
   374     val comments = Scan.any (comment_token o #2 o #2);
   374     val comments = Scan.any (comment_token o #1 o #2);
   375     val blank = Scan.one (blank_token o #2 o #2);
   375     val blank = Scan.one (blank_token o #1 o #2);
   376     val newline = Scan.one (newline_token o #2 o #2); 
   376     val newline = Scan.one (newline_token o #1 o #2);
   377     val before_cmd =
   377     val before_cmd =
   378       Scan.option (newline -- comments) --
   378       Scan.option (newline -- comments) --
   379       Scan.option (newline -- comments) --
   379       Scan.option (newline -- comments) --
   380       Scan.option (blank -- comments) -- cmd;
   380       Scan.option (blank -- comments) -- cmd;
   381 
   381