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@36950
|
12 |
val command: string -> string -> Keyword.T ->
|
wenzelm@29311
|
13 |
(Toplevel.transition -> Toplevel.transition) parser -> unit
|
wenzelm@36950
|
14 |
val markup_command: ThyOutput.markup -> string -> string -> Keyword.T ->
|
wenzelm@29311
|
15 |
(Toplevel.transition -> Toplevel.transition) parser -> unit
|
wenzelm@36950
|
16 |
val improper_command: string -> string -> Keyword.T ->
|
wenzelm@29311
|
17 |
(Toplevel.transition -> Toplevel.transition) parser -> unit
|
wenzelm@29311
|
18 |
val internal_command: string -> (Toplevel.transition -> Toplevel.transition) parser -> unit
|
wenzelm@36950
|
19 |
val local_theory': string -> string -> Keyword.T ->
|
wenzelm@29380
|
20 |
(bool -> local_theory -> local_theory) parser -> unit
|
wenzelm@36950
|
21 |
val local_theory: string -> string -> Keyword.T ->
|
wenzelm@29311
|
22 |
(local_theory -> local_theory) parser -> unit
|
wenzelm@36950
|
23 |
val local_theory_to_proof': string -> string -> Keyword.T ->
|
wenzelm@29311
|
24 |
(bool -> local_theory -> Proof.state) parser -> unit
|
wenzelm@36950
|
25 |
val local_theory_to_proof: string -> string -> Keyword.T ->
|
wenzelm@29311
|
26 |
(local_theory -> Proof.state) parser -> unit
|
wenzelm@5883
|
27 |
val print_outer_syntax: unit -> unit
|
wenzelm@27839
|
28 |
val scan: Position.T -> string -> OuterLex.token list
|
wenzelm@25580
|
29 |
val parse: Position.T -> string -> Toplevel.transition list
|
wenzelm@26431
|
30 |
val process_file: Path.T -> theory -> theory
|
wenzelm@26600
|
31 |
type isar
|
wenzelm@26600
|
32 |
val isar: bool -> isar
|
wenzelm@27839
|
33 |
val prepare_command: Position.T -> string -> Toplevel.transition
|
wenzelm@29428
|
34 |
val load_thy: string -> Position.T -> string list -> bool -> unit -> unit
|
wenzelm@5829
|
35 |
end;
|
wenzelm@5829
|
36 |
|
wenzelm@36953
|
37 |
structure Outer_Syntax: OUTER_SYNTAX =
|
wenzelm@5829
|
38 |
struct
|
wenzelm@5829
|
39 |
|
wenzelm@7750
|
40 |
structure T = OuterLex;
|
wenzelm@36950
|
41 |
type 'a parser = 'a Parse.parser;
|
wenzelm@29311
|
42 |
|
wenzelm@6860
|
43 |
|
wenzelm@5829
|
44 |
|
wenzelm@5829
|
45 |
(** outer syntax **)
|
wenzelm@5829
|
46 |
|
wenzelm@29311
|
47 |
(* command parsers *)
|
wenzelm@5829
|
48 |
|
wenzelm@29311
|
49 |
datatype command = Command of
|
wenzelm@24868
|
50 |
{comment: string,
|
wenzelm@24868
|
51 |
markup: ThyOutput.markup option,
|
wenzelm@24868
|
52 |
int_only: bool,
|
wenzelm@29311
|
53 |
parse: (Toplevel.transition -> Toplevel.transition) parser};
|
wenzelm@5829
|
54 |
|
wenzelm@29311
|
55 |
fun make_command comment markup int_only parse =
|
wenzelm@29311
|
56 |
Command {comment = comment, markup = markup, int_only = int_only, parse = parse};
|
wenzelm@5829
|
57 |
|
wenzelm@5829
|
58 |
|
wenzelm@5829
|
59 |
(* parse command *)
|
wenzelm@5829
|
60 |
|
wenzelm@6860
|
61 |
local
|
wenzelm@6199
|
62 |
|
wenzelm@14925
|
63 |
fun terminate false = Scan.succeed ()
|
wenzelm@36950
|
64 |
| terminate true = Parse.group "end of input" (Scan.option Parse.sync -- Parse.semicolon >> K ());
|
wenzelm@14925
|
65 |
|
wenzelm@26620
|
66 |
fun body cmd (name, _) =
|
wenzelm@7026
|
67 |
(case cmd name of
|
wenzelm@29311
|
68 |
SOME (Command {int_only, parse, ...}) =>
|
wenzelm@36950
|
69 |
Parse.!!! (Scan.prompt (name ^ "# ") (Parse.tags |-- parse >> pair int_only))
|
skalberg@15531
|
70 |
| NONE => sys_error ("no parser for outer syntax command " ^ quote name));
|
wenzelm@5829
|
71 |
|
wenzelm@6860
|
72 |
in
|
wenzelm@6860
|
73 |
|
wenzelm@26620
|
74 |
fun parse_command do_terminate cmd =
|
wenzelm@36950
|
75 |
Parse.semicolon >> K NONE ||
|
wenzelm@36950
|
76 |
Parse.sync >> K NONE ||
|
wenzelm@36950
|
77 |
(Parse.position Parse.command :-- body cmd) --| terminate do_terminate
|
wenzelm@6860
|
78 |
>> (fn ((name, pos), (int_only, f)) =>
|
skalberg@15531
|
79 |
SOME (Toplevel.empty |> Toplevel.name name |> Toplevel.position pos |>
|
wenzelm@6860
|
80 |
Toplevel.interactive int_only |> f));
|
wenzelm@5829
|
81 |
|
wenzelm@6199
|
82 |
end;
|
wenzelm@6199
|
83 |
|
wenzelm@5829
|
84 |
|
wenzelm@5829
|
85 |
|
wenzelm@9132
|
86 |
(** global outer syntax **)
|
wenzelm@5829
|
87 |
|
wenzelm@7026
|
88 |
local
|
wenzelm@7026
|
89 |
|
wenzelm@32738
|
90 |
val global_commands = Unsynchronized.ref (Symtab.empty: command Symtab.table);
|
wenzelm@32738
|
91 |
val global_markups = Unsynchronized.ref ([]: (string * ThyOutput.markup) list);
|
wenzelm@5952
|
92 |
|
wenzelm@29311
|
93 |
fun change_commands f = CRITICAL (fn () =>
|
wenzelm@32738
|
94 |
(Unsynchronized.change global_commands f;
|
wenzelm@23939
|
95 |
global_markups :=
|
wenzelm@29311
|
96 |
Symtab.fold (fn (name, Command {markup = SOME m, ...}) => cons (name, m) | _ => I)
|
wenzelm@29311
|
97 |
(! global_commands) []));
|
wenzelm@5829
|
98 |
|
wenzelm@7026
|
99 |
in
|
wenzelm@6722
|
100 |
|
wenzelm@9132
|
101 |
(* access current syntax *)
|
wenzelm@7026
|
102 |
|
wenzelm@33234
|
103 |
fun get_commands () = ! global_commands;
|
wenzelm@33234
|
104 |
fun get_markups () = ! global_markups;
|
wenzelm@7026
|
105 |
|
wenzelm@29311
|
106 |
fun get_command () = Symtab.lookup (get_commands ());
|
wenzelm@36950
|
107 |
fun get_syntax () = CRITICAL (fn () => (Keyword.get_lexicons (), get_command ()));
|
wenzelm@7789
|
108 |
|
wenzelm@24868
|
109 |
fun is_markup kind name = AList.lookup (op =) (get_markups ()) name = SOME kind;
|
wenzelm@5829
|
110 |
|
wenzelm@5829
|
111 |
|
wenzelm@5829
|
112 |
(* augment syntax *)
|
wenzelm@5829
|
113 |
|
wenzelm@29311
|
114 |
fun add_command name kind cmd = CRITICAL (fn () =>
|
wenzelm@36950
|
115 |
(Keyword.command name kind;
|
wenzelm@29311
|
116 |
if not (Symtab.defined (get_commands ()) name) then ()
|
wenzelm@24868
|
117 |
else warning ("Redefining outer syntax command " ^ quote name);
|
wenzelm@29311
|
118 |
change_commands (Symtab.update (name, cmd))));
|
wenzelm@24868
|
119 |
|
wenzelm@24868
|
120 |
fun command name comment kind parse =
|
wenzelm@29311
|
121 |
add_command name kind (make_command comment NONE false parse);
|
wenzelm@24868
|
122 |
|
wenzelm@24868
|
123 |
fun markup_command markup name comment kind parse =
|
wenzelm@29311
|
124 |
add_command name kind (make_command comment (SOME markup) false parse);
|
wenzelm@24868
|
125 |
|
wenzelm@24868
|
126 |
fun improper_command name comment kind parse =
|
wenzelm@29311
|
127 |
add_command name kind (make_command comment NONE true parse);
|
wenzelm@5829
|
128 |
|
wenzelm@7026
|
129 |
end;
|
wenzelm@5829
|
130 |
|
wenzelm@29311
|
131 |
fun internal_command name parse =
|
wenzelm@36950
|
132 |
command name "(internal)" Keyword.control (parse >> (fn tr => Toplevel.no_timing o tr));
|
wenzelm@29311
|
133 |
|
wenzelm@5829
|
134 |
|
wenzelm@26990
|
135 |
(* local_theory commands *)
|
wenzelm@26990
|
136 |
|
wenzelm@26990
|
137 |
fun local_theory_command do_print trans name comment kind parse =
|
wenzelm@36950
|
138 |
command name comment kind (Parse.opt_target -- parse
|
wenzelm@26990
|
139 |
>> (fn (loc, f) => (if do_print then Toplevel.print else I) o trans loc f));
|
wenzelm@26990
|
140 |
|
wenzelm@29380
|
141 |
val local_theory' = local_theory_command false Toplevel.local_theory';
|
wenzelm@29311
|
142 |
val local_theory = local_theory_command false Toplevel.local_theory;
|
wenzelm@26990
|
143 |
val local_theory_to_proof' = local_theory_command true Toplevel.local_theory_to_proof';
|
wenzelm@29311
|
144 |
val local_theory_to_proof = local_theory_command true Toplevel.local_theory_to_proof;
|
wenzelm@26990
|
145 |
|
wenzelm@26990
|
146 |
|
wenzelm@24872
|
147 |
(* inspect syntax *)
|
wenzelm@5829
|
148 |
|
wenzelm@29311
|
149 |
fun dest_commands () =
|
wenzelm@29311
|
150 |
get_commands () |> Symtab.dest |> sort_wrt #1
|
wenzelm@29311
|
151 |
|> map (fn (name, Command {comment, int_only, ...}) => (name, comment, int_only));
|
wenzelm@7026
|
152 |
|
wenzelm@9223
|
153 |
fun print_outer_syntax () =
|
wenzelm@7026
|
154 |
let
|
wenzelm@27353
|
155 |
fun pretty_cmd (name, comment, _) =
|
wenzelm@7026
|
156 |
Pretty.block [Pretty.str (name ^ ":"), Pretty.brk 2, Pretty.str comment];
|
wenzelm@29311
|
157 |
val (int_cmds, cmds) = List.partition #3 (dest_commands ());
|
wenzelm@7026
|
158 |
in
|
wenzelm@36950
|
159 |
[Pretty.strs ("syntax keywords:" :: map quote (Keyword.dest_keywords ())),
|
wenzelm@18326
|
160 |
Pretty.big_list "commands:" (map pretty_cmd cmds),
|
wenzelm@18326
|
161 |
Pretty.big_list "interactive-only commands:" (map pretty_cmd int_cmds)]
|
wenzelm@9223
|
162 |
|> Pretty.chunks |> Pretty.writeln
|
wenzelm@7026
|
163 |
end;
|
wenzelm@5829
|
164 |
|
wenzelm@5829
|
165 |
|
wenzelm@5829
|
166 |
|
wenzelm@9132
|
167 |
(** toplevel parsing **)
|
wenzelm@5829
|
168 |
|
wenzelm@9132
|
169 |
(* basic sources *)
|
wenzelm@6860
|
170 |
|
wenzelm@26620
|
171 |
fun toplevel_source term do_recover cmd src =
|
wenzelm@9132
|
172 |
let
|
wenzelm@9132
|
173 |
val no_terminator =
|
wenzelm@36950
|
174 |
Scan.unless Parse.semicolon (Scan.one (T.not_sync andf T.not_eof));
|
wenzelm@23682
|
175 |
fun recover int =
|
wenzelm@23682
|
176 |
(int, fn _ => Scan.prompt "recover# " (Scan.repeat no_terminator) >> K [NONE]);
|
wenzelm@9132
|
177 |
in
|
wenzelm@9132
|
178 |
src
|
wenzelm@12876
|
179 |
|> T.source_proper
|
wenzelm@9132
|
180 |
|> Source.source T.stopper
|
wenzelm@36950
|
181 |
(Scan.bulk (Parse.$$$ "--" -- Parse.!!! Parse.doc_source >> K NONE || Parse.not_eof >> SOME))
|
wenzelm@23682
|
182 |
(Option.map recover do_recover)
|
wenzelm@19482
|
183 |
|> Source.map_filter I
|
wenzelm@24868
|
184 |
|> Source.source T.stopper
|
wenzelm@36950
|
185 |
(Scan.bulk (fn xs => Parse.!!! (parse_command term (cmd ())) xs))
|
wenzelm@23682
|
186 |
(Option.map recover do_recover)
|
wenzelm@19482
|
187 |
|> Source.map_filter I
|
wenzelm@9132
|
188 |
end;
|
wenzelm@7683
|
189 |
|
wenzelm@5829
|
190 |
|
wenzelm@25580
|
191 |
(* off-line scanning/parsing *)
|
nipkow@14091
|
192 |
|
wenzelm@27839
|
193 |
fun scan pos str =
|
wenzelm@16195
|
194 |
Source.of_string str
|
wenzelm@27839
|
195 |
|> Symbol.source {do_recover = false}
|
wenzelm@36950
|
196 |
|> T.source {do_recover = SOME false} Keyword.get_lexicons pos
|
wenzelm@16195
|
197 |
|> Source.exhaust;
|
wenzelm@16195
|
198 |
|
wenzelm@25580
|
199 |
fun parse pos str =
|
wenzelm@25580
|
200 |
Source.of_string str
|
wenzelm@27839
|
201 |
|> Symbol.source {do_recover = false}
|
wenzelm@36950
|
202 |
|> T.source {do_recover = SOME false} Keyword.get_lexicons pos
|
wenzelm@29311
|
203 |
|> toplevel_source false NONE get_command
|
wenzelm@25580
|
204 |
|> Source.exhaust;
|
wenzelm@25580
|
205 |
|
nipkow@14091
|
206 |
|
wenzelm@26431
|
207 |
(* process file *)
|
wenzelm@26431
|
208 |
|
wenzelm@26431
|
209 |
fun process_file path thy =
|
wenzelm@26431
|
210 |
let
|
wenzelm@26881
|
211 |
val trs = parse (Path.position path) (File.read path);
|
wenzelm@28424
|
212 |
val init = Toplevel.init_theory "" (K thy) (K ()) Toplevel.empty;
|
wenzelm@28424
|
213 |
val result = fold Toplevel.command (init :: trs) Toplevel.toplevel;
|
wenzelm@28424
|
214 |
in
|
wenzelm@28424
|
215 |
(case (Toplevel.is_theory result, Toplevel.generic_theory_of result) of
|
wenzelm@28424
|
216 |
(true, Context.Theory thy') => thy'
|
wenzelm@28424
|
217 |
| _ => error "Bad result state: global theory expected")
|
wenzelm@28424
|
218 |
end;
|
wenzelm@26431
|
219 |
|
wenzelm@26431
|
220 |
|
wenzelm@24868
|
221 |
(* interactive source of toplevel transformers *)
|
wenzelm@24868
|
222 |
|
wenzelm@26600
|
223 |
type isar =
|
wenzelm@26600
|
224 |
(Toplevel.transition, (Toplevel.transition option,
|
wenzelm@26600
|
225 |
(OuterLex.token, (OuterLex.token option, (OuterLex.token, (OuterLex.token,
|
wenzelm@30576
|
226 |
(Symbol_Pos.T, Position.T * (Symbol.symbol, (string, unit) Source.source)
|
wenzelm@27770
|
227 |
Source.source) Source.source) Source.source) Source.source)
|
wenzelm@27770
|
228 |
Source.source) Source.source) Source.source) Source.source;
|
wenzelm@26600
|
229 |
|
wenzelm@26600
|
230 |
fun isar term : isar =
|
wenzelm@24868
|
231 |
Source.tty
|
wenzelm@27839
|
232 |
|> Symbol.source {do_recover = true}
|
wenzelm@36950
|
233 |
|> T.source {do_recover = SOME true} Keyword.get_lexicons Position.none
|
wenzelm@29311
|
234 |
|> toplevel_source term (SOME true) get_command;
|
wenzelm@24868
|
235 |
|
wenzelm@24868
|
236 |
|
wenzelm@27839
|
237 |
(* prepare toplevel commands -- fail-safe *)
|
wenzelm@27839
|
238 |
|
wenzelm@27839
|
239 |
val not_singleton = "Exactly one command expected";
|
wenzelm@27839
|
240 |
|
wenzelm@29311
|
241 |
fun prepare_span commands span =
|
wenzelm@27839
|
242 |
let
|
wenzelm@29315
|
243 |
val range_pos = Position.encode_range (ThySyntax.span_range span);
|
wenzelm@29315
|
244 |
val toks = ThySyntax.span_content span;
|
wenzelm@29315
|
245 |
val _ = List.app ThySyntax.report_token toks;
|
wenzelm@27839
|
246 |
in
|
wenzelm@29311
|
247 |
(case Source.exhaust (toplevel_source false NONE (K commands) (Source.of_list toks)) of
|
wenzelm@27839
|
248 |
[tr] => (tr, true)
|
wenzelm@27839
|
249 |
| [] => (Toplevel.ignored range_pos, false)
|
wenzelm@27839
|
250 |
| _ => (Toplevel.malformed range_pos not_singleton, true))
|
wenzelm@27839
|
251 |
handle ERROR msg => (Toplevel.malformed range_pos msg, true)
|
wenzelm@27839
|
252 |
end;
|
wenzelm@27839
|
253 |
|
wenzelm@29311
|
254 |
fun prepare_unit commands (cmd, proof, proper_proof) =
|
wenzelm@28436
|
255 |
let
|
wenzelm@29311
|
256 |
val (tr, proper_cmd) = prepare_span commands cmd;
|
wenzelm@29311
|
257 |
val proof_trs = map (prepare_span commands) proof |> filter #2 |> map #1;
|
wenzelm@28436
|
258 |
in
|
wenzelm@28436
|
259 |
if proper_cmd andalso proper_proof then [(tr, proof_trs)]
|
wenzelm@28436
|
260 |
else map (rpair []) (if proper_cmd then tr :: proof_trs else proof_trs)
|
wenzelm@28436
|
261 |
end;
|
wenzelm@28432
|
262 |
|
wenzelm@27839
|
263 |
fun prepare_command pos str =
|
wenzelm@29311
|
264 |
let val (lexs, commands) = get_syntax () in
|
wenzelm@29315
|
265 |
(case ThySyntax.parse_spans lexs pos str of
|
wenzelm@29311
|
266 |
[span] => #1 (prepare_span commands span)
|
wenzelm@27839
|
267 |
| _ => Toplevel.malformed pos not_singleton)
|
wenzelm@27839
|
268 |
end;
|
wenzelm@27839
|
269 |
|
wenzelm@27839
|
270 |
|
wenzelm@26611
|
271 |
(* load_thy *)
|
wenzelm@7746
|
272 |
|
wenzelm@27839
|
273 |
fun load_thy name pos text time =
|
wenzelm@7683
|
274 |
let
|
wenzelm@29311
|
275 |
val (lexs, commands) = get_syntax ();
|
wenzelm@23866
|
276 |
|
wenzelm@17932
|
277 |
val _ = Present.init_theory name;
|
wenzelm@27855
|
278 |
|
wenzelm@29315
|
279 |
val toks = Source.exhausted (ThySyntax.token_source lexs pos (Source.of_list text));
|
wenzelm@29315
|
280 |
val spans = Source.exhaust (ThySyntax.span_source toks);
|
wenzelm@29315
|
281 |
val _ = List.app ThySyntax.report_span spans;
|
wenzelm@29315
|
282 |
val units = Source.exhaust (ThySyntax.unit_source (Source.of_list spans))
|
wenzelm@29311
|
283 |
|> maps (prepare_unit commands);
|
wenzelm@23866
|
284 |
|
wenzelm@27855
|
285 |
val _ = Present.theory_source name
|
wenzelm@29315
|
286 |
(fn () => HTML.html_mode (implode o map ThySyntax.present_span) spans);
|
wenzelm@27855
|
287 |
|
wenzelm@23866
|
288 |
val _ = if time then writeln ("\n**** Starting theory " ^ quote name ^ " ****") else ();
|
wenzelm@29428
|
289 |
val results = cond_timeit time "" (fn () => Toplevel.excursion units);
|
wenzelm@23866
|
290 |
val _ = if time then writeln ("**** Finished theory " ^ quote name ^ " ****\n") else ();
|
wenzelm@29428
|
291 |
|
wenzelm@29428
|
292 |
fun after_load () =
|
wenzelm@36950
|
293 |
ThyOutput.present_thy (#1 lexs) Keyword.command_tags is_markup (Lazy.force results) toks
|
wenzelm@29428
|
294 |
|> Buffer.content
|
wenzelm@29428
|
295 |
|> Present.theory_output name;
|
wenzelm@29428
|
296 |
in after_load end;
|
wenzelm@23866
|
297 |
|
wenzelm@5829
|
298 |
end;
|
wenzelm@36953
|
299 |
|
wenzelm@36953
|
300 |
(*legacy alias*)
|
wenzelm@36953
|
301 |
structure OuterSyntax = Outer_Syntax;
|
wenzelm@36953
|
302 |
|