wenzelm@5829
|
1 |
(* Title: Pure/Isar/outer_syntax.ML
|
wenzelm@5829
|
2 |
Author: Markus Wenzel, TU Muenchen
|
wenzelm@5829
|
3 |
|
wenzelm@27353
|
4 |
The global Isabelle/Isar outer syntax.
|
wenzelm@27353
|
5 |
|
wenzelm@27353
|
6 |
Note: the syntax for files is statically determined at the very
|
wenzelm@27353
|
7 |
beginning; for interactive processing it may change dynamically.
|
wenzelm@5829
|
8 |
*)
|
wenzelm@5829
|
9 |
|
wenzelm@5829
|
10 |
signature OUTER_SYNTAX =
|
wenzelm@5829
|
11 |
sig
|
wenzelm@44582
|
12 |
type outer_syntax
|
wenzelm@44583
|
13 |
val is_markup: outer_syntax -> Thy_Output.markup -> string -> bool
|
wenzelm@44582
|
14 |
val get_syntax: unit -> (Scan.lexicon * Scan.lexicon) * outer_syntax
|
wenzelm@47841
|
15 |
val check_syntax: unit -> unit
|
wenzelm@49661
|
16 |
type command_spec = (string * Keyword.T) * Position.T
|
wenzelm@47836
|
17 |
val command: command_spec -> string ->
|
wenzelm@29311
|
18 |
(Toplevel.transition -> Toplevel.transition) parser -> unit
|
wenzelm@47836
|
19 |
val markup_command: Thy_Output.markup -> command_spec -> string ->
|
wenzelm@29311
|
20 |
(Toplevel.transition -> Toplevel.transition) parser -> unit
|
wenzelm@47836
|
21 |
val improper_command: command_spec -> string ->
|
wenzelm@29311
|
22 |
(Toplevel.transition -> Toplevel.transition) parser -> unit
|
wenzelm@47836
|
23 |
val local_theory': command_spec -> string ->
|
wenzelm@29380
|
24 |
(bool -> local_theory -> local_theory) parser -> unit
|
wenzelm@47836
|
25 |
val local_theory: command_spec -> string ->
|
wenzelm@29311
|
26 |
(local_theory -> local_theory) parser -> unit
|
wenzelm@47836
|
27 |
val local_theory_to_proof': command_spec -> string ->
|
wenzelm@29311
|
28 |
(bool -> local_theory -> Proof.state) parser -> unit
|
wenzelm@47836
|
29 |
val local_theory_to_proof: command_spec -> string ->
|
wenzelm@29311
|
30 |
(local_theory -> Proof.state) parser -> unit
|
wenzelm@5883
|
31 |
val print_outer_syntax: unit -> unit
|
wenzelm@36969
|
32 |
val scan: Position.T -> string -> Token.T list
|
wenzelm@25580
|
33 |
val parse: Position.T -> string -> Toplevel.transition list
|
wenzelm@26600
|
34 |
type isar
|
wenzelm@38551
|
35 |
val isar: TextIO.instream -> bool -> isar
|
wenzelm@47747
|
36 |
val read_span: outer_syntax -> Token.T list -> Toplevel.transition * bool
|
wenzelm@45399
|
37 |
val read_element: outer_syntax -> (unit -> theory) -> Thy_Syntax.element ->
|
wenzelm@44583
|
38 |
(Toplevel.transition * Toplevel.transition list) list
|
wenzelm@5829
|
39 |
end;
|
wenzelm@5829
|
40 |
|
wenzelm@36953
|
41 |
structure Outer_Syntax: OUTER_SYNTAX =
|
wenzelm@5829
|
42 |
struct
|
wenzelm@5829
|
43 |
|
wenzelm@5829
|
44 |
(** outer syntax **)
|
wenzelm@5829
|
45 |
|
wenzelm@29311
|
46 |
(* command parsers *)
|
wenzelm@5829
|
47 |
|
wenzelm@29311
|
48 |
datatype command = Command of
|
wenzelm@24868
|
49 |
{comment: string,
|
wenzelm@37216
|
50 |
markup: Thy_Output.markup option,
|
wenzelm@24868
|
51 |
int_only: bool,
|
wenzelm@49662
|
52 |
parse: (Toplevel.transition -> Toplevel.transition) parser,
|
wenzelm@49662
|
53 |
pos: Position.T,
|
wenzelm@49662
|
54 |
id: serial};
|
wenzelm@5829
|
55 |
|
wenzelm@49662
|
56 |
fun new_command comment markup int_only parse pos =
|
wenzelm@49662
|
57 |
Command {comment = comment, markup = markup, int_only = int_only, parse = parse,
|
wenzelm@49662
|
58 |
pos = pos, id = serial ()};
|
wenzelm@49662
|
59 |
|
wenzelm@49662
|
60 |
fun command_markup def (name, Command {pos, id, ...}) =
|
wenzelm@49662
|
61 |
Markup.properties (Position.entity_properties_of def id pos)
|
wenzelm@49662
|
62 |
(Isabelle_Markup.entity Isabelle_Markup.commandN name);
|
wenzelm@5829
|
63 |
|
wenzelm@5829
|
64 |
|
wenzelm@5829
|
65 |
(* parse command *)
|
wenzelm@5829
|
66 |
|
wenzelm@6860
|
67 |
local
|
wenzelm@6199
|
68 |
|
wenzelm@14925
|
69 |
fun terminate false = Scan.succeed ()
|
wenzelm@45231
|
70 |
| terminate true =
|
wenzelm@45231
|
71 |
Parse.group (fn () => "end of input")
|
wenzelm@45231
|
72 |
(Scan.option Parse.sync -- Parse.semicolon >> K ());
|
wenzelm@14925
|
73 |
|
wenzelm@26620
|
74 |
fun body cmd (name, _) =
|
wenzelm@7026
|
75 |
(case cmd name of
|
wenzelm@29311
|
76 |
SOME (Command {int_only, parse, ...}) =>
|
wenzelm@36950
|
77 |
Parse.!!! (Scan.prompt (name ^ "# ") (Parse.tags |-- parse >> pair int_only))
|
wenzelm@49206
|
78 |
| NONE =>
|
wenzelm@49206
|
79 |
Scan.succeed (false, Toplevel.imperative (fn () =>
|
wenzelm@49206
|
80 |
error ("Bad parser for outer syntax command " ^ quote name))));
|
wenzelm@5829
|
81 |
|
wenzelm@6860
|
82 |
in
|
wenzelm@6860
|
83 |
|
wenzelm@26620
|
84 |
fun parse_command do_terminate cmd =
|
wenzelm@36950
|
85 |
Parse.semicolon >> K NONE ||
|
wenzelm@36950
|
86 |
Parse.sync >> K NONE ||
|
wenzelm@36950
|
87 |
(Parse.position Parse.command :-- body cmd) --| terminate do_terminate
|
wenzelm@6860
|
88 |
>> (fn ((name, pos), (int_only, f)) =>
|
skalberg@15531
|
89 |
SOME (Toplevel.empty |> Toplevel.name name |> Toplevel.position pos |>
|
wenzelm@6860
|
90 |
Toplevel.interactive int_only |> f));
|
wenzelm@5829
|
91 |
|
wenzelm@6199
|
92 |
end;
|
wenzelm@6199
|
93 |
|
wenzelm@5829
|
94 |
|
wenzelm@44582
|
95 |
(* type outer_syntax *)
|
wenzelm@44582
|
96 |
|
wenzelm@44582
|
97 |
datatype outer_syntax = Outer_Syntax of
|
wenzelm@44582
|
98 |
{commands: command Symtab.table,
|
wenzelm@44582
|
99 |
markups: (string * Thy_Output.markup) list};
|
wenzelm@44582
|
100 |
|
wenzelm@44582
|
101 |
fun make_outer_syntax commands markups =
|
wenzelm@44582
|
102 |
Outer_Syntax {commands = commands, markups = markups};
|
wenzelm@44582
|
103 |
|
wenzelm@44582
|
104 |
val empty_outer_syntax = make_outer_syntax Symtab.empty [];
|
wenzelm@44582
|
105 |
|
wenzelm@44582
|
106 |
|
wenzelm@44582
|
107 |
fun map_commands f (Outer_Syntax {commands, ...}) =
|
wenzelm@44582
|
108 |
let
|
wenzelm@44582
|
109 |
val commands' = f commands;
|
wenzelm@44582
|
110 |
val markups' =
|
wenzelm@44582
|
111 |
Symtab.fold (fn (name, Command {markup = SOME m, ...}) => cons (name, m) | _ => I)
|
wenzelm@44582
|
112 |
commands' [];
|
wenzelm@44582
|
113 |
in make_outer_syntax commands' markups' end;
|
wenzelm@44582
|
114 |
|
wenzelm@44582
|
115 |
fun dest_commands (Outer_Syntax {commands, ...}) =
|
wenzelm@44582
|
116 |
commands |> Symtab.dest |> sort_wrt #1
|
wenzelm@44582
|
117 |
|> map (fn (name, Command {comment, int_only, ...}) => (name, comment, int_only));
|
wenzelm@44582
|
118 |
|
wenzelm@44582
|
119 |
fun lookup_commands (Outer_Syntax {commands, ...}) = Symtab.lookup commands;
|
wenzelm@44582
|
120 |
|
wenzelm@44582
|
121 |
fun is_markup (Outer_Syntax {markups, ...}) kind name =
|
wenzelm@44582
|
122 |
AList.lookup (op =) markups name = SOME kind;
|
wenzelm@44582
|
123 |
|
wenzelm@44582
|
124 |
|
wenzelm@5829
|
125 |
|
wenzelm@9132
|
126 |
(** global outer syntax **)
|
wenzelm@5829
|
127 |
|
wenzelm@49661
|
128 |
type command_spec = (string * Keyword.T) * Position.T;
|
wenzelm@47836
|
129 |
|
wenzelm@7026
|
130 |
local
|
wenzelm@7026
|
131 |
|
wenzelm@44582
|
132 |
(*synchronized wrt. Keywords*)
|
wenzelm@44582
|
133 |
val global_outer_syntax = Unsynchronized.ref empty_outer_syntax;
|
wenzelm@5952
|
134 |
|
wenzelm@49662
|
135 |
fun add_command (name, kind) cmd = CRITICAL (fn () =>
|
wenzelm@47824
|
136 |
let
|
wenzelm@47824
|
137 |
val thy = ML_Context.the_global_context ();
|
wenzelm@49662
|
138 |
val Command {pos, ...} = cmd;
|
wenzelm@47824
|
139 |
val _ =
|
wenzelm@47824
|
140 |
(case try (Thy_Header.the_keyword thy) name of
|
wenzelm@47836
|
141 |
SOME spec =>
|
wenzelm@49879
|
142 |
if Option.map #1 spec = SOME (Keyword.kind_files_of kind) then ()
|
wenzelm@49661
|
143 |
else error ("Inconsistent outer syntax keyword declaration " ^
|
wenzelm@49661
|
144 |
quote name ^ Position.str_of pos)
|
wenzelm@47824
|
145 |
| NONE =>
|
wenzelm@47836
|
146 |
if Context.theory_name thy = Context.PureN
|
wenzelm@47836
|
147 |
then Keyword.define (name, SOME kind)
|
wenzelm@49661
|
148 |
else error ("Undeclared outer syntax command " ^ quote name ^ Position.str_of pos));
|
wenzelm@49662
|
149 |
val _ = Position.report pos (command_markup true (name, cmd));
|
wenzelm@47824
|
150 |
in
|
wenzelm@47824
|
151 |
Unsynchronized.change global_outer_syntax (map_commands (fn commands =>
|
wenzelm@47824
|
152 |
(if not (Symtab.defined commands name) then ()
|
wenzelm@47824
|
153 |
else warning ("Redefining outer syntax command " ^ quote name);
|
wenzelm@47824
|
154 |
Symtab.update (name, cmd) commands)))
|
wenzelm@47824
|
155 |
end);
|
wenzelm@5829
|
156 |
|
wenzelm@7026
|
157 |
in
|
wenzelm@6722
|
158 |
|
wenzelm@44582
|
159 |
fun get_syntax () = CRITICAL (fn () => (Keyword.get_lexicons (), ! global_outer_syntax));
|
wenzelm@7026
|
160 |
|
wenzelm@47841
|
161 |
fun check_syntax () =
|
wenzelm@47841
|
162 |
let
|
wenzelm@47841
|
163 |
val ((_, major), syntax) = CRITICAL (fn () => (Keyword.dest (), ! global_outer_syntax));
|
wenzelm@47841
|
164 |
in
|
wenzelm@47841
|
165 |
(case subtract (op =) (map #1 (dest_commands syntax)) major of
|
wenzelm@47841
|
166 |
[] => ()
|
wenzelm@47841
|
167 |
| missing => error ("Missing outer syntax command(s) " ^ commas_quote missing))
|
wenzelm@47841
|
168 |
end;
|
wenzelm@47841
|
169 |
|
wenzelm@44582
|
170 |
fun lookup_commands_dynamic () = lookup_commands (! global_outer_syntax);
|
wenzelm@24868
|
171 |
|
wenzelm@49662
|
172 |
fun command (spec, pos) comment parse =
|
wenzelm@49662
|
173 |
add_command spec (new_command comment NONE false parse pos);
|
wenzelm@24868
|
174 |
|
wenzelm@49662
|
175 |
fun markup_command markup (spec, pos) comment parse =
|
wenzelm@49662
|
176 |
add_command spec (new_command comment (SOME markup) false parse pos);
|
wenzelm@24868
|
177 |
|
wenzelm@49662
|
178 |
fun improper_command (spec, pos) comment parse =
|
wenzelm@49662
|
179 |
add_command spec (new_command comment NONE true parse pos);
|
wenzelm@29311
|
180 |
|
wenzelm@44582
|
181 |
end;
|
wenzelm@44582
|
182 |
|
wenzelm@5829
|
183 |
|
wenzelm@26990
|
184 |
(* local_theory commands *)
|
wenzelm@26990
|
185 |
|
wenzelm@47836
|
186 |
fun local_theory_command do_print trans command_spec comment parse =
|
wenzelm@47836
|
187 |
command command_spec comment (Parse.opt_target -- parse
|
wenzelm@26990
|
188 |
>> (fn (loc, f) => (if do_print then Toplevel.print else I) o trans loc f));
|
wenzelm@26990
|
189 |
|
wenzelm@29380
|
190 |
val local_theory' = local_theory_command false Toplevel.local_theory';
|
wenzelm@29311
|
191 |
val local_theory = local_theory_command false Toplevel.local_theory;
|
wenzelm@26990
|
192 |
val local_theory_to_proof' = local_theory_command true Toplevel.local_theory_to_proof';
|
wenzelm@29311
|
193 |
val local_theory_to_proof = local_theory_command true Toplevel.local_theory_to_proof;
|
wenzelm@26990
|
194 |
|
wenzelm@26990
|
195 |
|
wenzelm@24872
|
196 |
(* inspect syntax *)
|
wenzelm@5829
|
197 |
|
wenzelm@9223
|
198 |
fun print_outer_syntax () =
|
wenzelm@7026
|
199 |
let
|
wenzelm@47828
|
200 |
val ((keywords, _), outer_syntax) =
|
wenzelm@47828
|
201 |
CRITICAL (fn () => (Keyword.dest (), #2 (get_syntax ())));
|
wenzelm@27353
|
202 |
fun pretty_cmd (name, comment, _) =
|
wenzelm@7026
|
203 |
Pretty.block [Pretty.str (name ^ ":"), Pretty.brk 2, Pretty.str comment];
|
wenzelm@44582
|
204 |
val (int_cmds, cmds) = List.partition #3 (dest_commands outer_syntax);
|
wenzelm@7026
|
205 |
in
|
wenzelm@44582
|
206 |
[Pretty.strs ("syntax keywords:" :: map quote keywords),
|
wenzelm@18326
|
207 |
Pretty.big_list "commands:" (map pretty_cmd cmds),
|
wenzelm@18326
|
208 |
Pretty.big_list "interactive-only commands:" (map pretty_cmd int_cmds)]
|
wenzelm@9223
|
209 |
|> Pretty.chunks |> Pretty.writeln
|
wenzelm@7026
|
210 |
end;
|
wenzelm@5829
|
211 |
|
wenzelm@5829
|
212 |
|
wenzelm@5829
|
213 |
|
wenzelm@9132
|
214 |
(** toplevel parsing **)
|
wenzelm@5829
|
215 |
|
wenzelm@9132
|
216 |
(* basic sources *)
|
wenzelm@6860
|
217 |
|
wenzelm@26620
|
218 |
fun toplevel_source term do_recover cmd src =
|
wenzelm@9132
|
219 |
let
|
wenzelm@9132
|
220 |
val no_terminator =
|
wenzelm@36969
|
221 |
Scan.unless Parse.semicolon (Scan.one (Token.not_sync andf Token.not_eof));
|
wenzelm@23682
|
222 |
fun recover int =
|
wenzelm@23682
|
223 |
(int, fn _ => Scan.prompt "recover# " (Scan.repeat no_terminator) >> K [NONE]);
|
wenzelm@9132
|
224 |
in
|
wenzelm@9132
|
225 |
src
|
wenzelm@36969
|
226 |
|> Token.source_proper
|
wenzelm@36969
|
227 |
|> Source.source Token.stopper
|
wenzelm@36950
|
228 |
(Scan.bulk (Parse.$$$ "--" -- Parse.!!! Parse.doc_source >> K NONE || Parse.not_eof >> SOME))
|
wenzelm@23682
|
229 |
(Option.map recover do_recover)
|
wenzelm@19482
|
230 |
|> Source.map_filter I
|
wenzelm@36969
|
231 |
|> Source.source Token.stopper
|
wenzelm@36950
|
232 |
(Scan.bulk (fn xs => Parse.!!! (parse_command term (cmd ())) xs))
|
wenzelm@23682
|
233 |
(Option.map recover do_recover)
|
wenzelm@19482
|
234 |
|> Source.map_filter I
|
wenzelm@9132
|
235 |
end;
|
wenzelm@7683
|
236 |
|
wenzelm@5829
|
237 |
|
wenzelm@25580
|
238 |
(* off-line scanning/parsing *)
|
nipkow@14091
|
239 |
|
wenzelm@27839
|
240 |
fun scan pos str =
|
wenzelm@16195
|
241 |
Source.of_string str
|
wenzelm@40769
|
242 |
|> Symbol.source
|
wenzelm@36969
|
243 |
|> Token.source {do_recover = SOME false} Keyword.get_lexicons pos
|
wenzelm@16195
|
244 |
|> Source.exhaust;
|
wenzelm@16195
|
245 |
|
wenzelm@25580
|
246 |
fun parse pos str =
|
wenzelm@25580
|
247 |
Source.of_string str
|
wenzelm@40769
|
248 |
|> Symbol.source
|
wenzelm@36969
|
249 |
|> Token.source {do_recover = SOME false} Keyword.get_lexicons pos
|
wenzelm@44582
|
250 |
|> toplevel_source false NONE lookup_commands_dynamic
|
wenzelm@25580
|
251 |
|> Source.exhaust;
|
wenzelm@25580
|
252 |
|
nipkow@14091
|
253 |
|
wenzelm@24868
|
254 |
(* interactive source of toplevel transformers *)
|
wenzelm@24868
|
255 |
|
wenzelm@26600
|
256 |
type isar =
|
wenzelm@26600
|
257 |
(Toplevel.transition, (Toplevel.transition option,
|
wenzelm@36969
|
258 |
(Token.T, (Token.T option, (Token.T, (Token.T,
|
wenzelm@30576
|
259 |
(Symbol_Pos.T, Position.T * (Symbol.symbol, (string, unit) Source.source)
|
wenzelm@27770
|
260 |
Source.source) Source.source) Source.source) Source.source)
|
wenzelm@27770
|
261 |
Source.source) Source.source) Source.source) Source.source;
|
wenzelm@26600
|
262 |
|
wenzelm@38551
|
263 |
fun isar in_stream term : isar =
|
wenzelm@38551
|
264 |
Source.tty in_stream
|
wenzelm@40769
|
265 |
|> Symbol.source
|
wenzelm@36969
|
266 |
|> Token.source {do_recover = SOME true} Keyword.get_lexicons Position.none
|
wenzelm@44582
|
267 |
|> toplevel_source term (SOME true) lookup_commands_dynamic;
|
wenzelm@24868
|
268 |
|
wenzelm@24868
|
269 |
|
wenzelm@45399
|
270 |
(* read toplevel commands -- fail-safe *)
|
wenzelm@27839
|
271 |
|
wenzelm@45531
|
272 |
fun read_span outer_syntax toks =
|
wenzelm@27839
|
273 |
let
|
wenzelm@44582
|
274 |
val commands = lookup_commands outer_syntax;
|
wenzelm@49764
|
275 |
|
wenzelm@49786
|
276 |
val proper_range = Position.set_range (Command.proper_range toks);
|
wenzelm@49764
|
277 |
val pos =
|
wenzelm@49764
|
278 |
(case find_first Token.is_command toks of
|
wenzelm@49764
|
279 |
SOME tok => Token.position_of tok
|
wenzelm@49786
|
280 |
| NONE => proper_range);
|
wenzelm@49662
|
281 |
|
wenzelm@49662
|
282 |
fun command_reports tok =
|
wenzelm@49764
|
283 |
if Token.is_command tok then
|
wenzelm@49662
|
284 |
let val name = Token.content_of tok in
|
wenzelm@49662
|
285 |
(case commands name of
|
wenzelm@49662
|
286 |
NONE => []
|
wenzelm@49783
|
287 |
| SOME cmd => [((Token.position_of tok, command_markup false (name, cmd)), "")])
|
wenzelm@49662
|
288 |
end
|
wenzelm@49662
|
289 |
else [];
|
wenzelm@49764
|
290 |
|
wenzelm@49764
|
291 |
val (is_malformed, token_reports) = Thy_Syntax.reports_of_tokens toks;
|
wenzelm@49783
|
292 |
val _ = Position.reports_text (token_reports @ maps command_reports toks);
|
wenzelm@27839
|
293 |
in
|
wenzelm@49764
|
294 |
if is_malformed then (Toplevel.malformed pos "Malformed command syntax", true)
|
wenzelm@49764
|
295 |
else
|
wenzelm@49764
|
296 |
(case Source.exhaust (toplevel_source false NONE (K commands) (Source.of_list toks)) of
|
wenzelm@49764
|
297 |
[tr] =>
|
wenzelm@49764
|
298 |
if Keyword.is_control (Toplevel.name_of tr) then
|
wenzelm@49764
|
299 |
(Toplevel.malformed pos "Illegal control command", true)
|
wenzelm@49764
|
300 |
else (tr, true)
|
wenzelm@49786
|
301 |
| [] => (Toplevel.ignored (Position.set_range (Command.range toks)), false)
|
wenzelm@49786
|
302 |
| _ => (Toplevel.malformed proper_range "Exactly one command expected", true))
|
wenzelm@49786
|
303 |
handle ERROR msg => (Toplevel.malformed proper_range msg, true)
|
wenzelm@27839
|
304 |
end;
|
wenzelm@27839
|
305 |
|
wenzelm@45399
|
306 |
fun read_element outer_syntax init {head, proof, proper_proof} =
|
wenzelm@28436
|
307 |
let
|
wenzelm@45531
|
308 |
val read = read_span outer_syntax o Thy_Syntax.span_content;
|
wenzelm@45531
|
309 |
val (tr, proper_head) = read head |>> Toplevel.modify_init init;
|
wenzelm@45531
|
310 |
val proof_trs = map read proof |> filter #2 |> map #1;
|
wenzelm@28436
|
311 |
in
|
wenzelm@48288
|
312 |
if proper_head andalso proper_proof andalso
|
wenzelm@48288
|
313 |
not (Keyword.is_schematic_goal (Toplevel.name_of tr)) then [(tr, proof_trs)]
|
wenzelm@44502
|
314 |
else map (rpair []) (if proper_head then tr :: proof_trs else proof_trs)
|
wenzelm@28436
|
315 |
end;
|
wenzelm@28432
|
316 |
|
wenzelm@5829
|
317 |
end;
|
wenzelm@36953
|
318 |
|