1 (* Title: Pure/Isar/token.ML
2 Author: Markus Wenzel, TU Muenchen
4 Outer token syntax for Isabelle/Isar.
10 Command | Keyword | Ident | LongIdent | SymIdent | Var | TypeIdent | TypeVar |
11 Nat | Float | String | AltString | Verbatim | Cartouche | Space | Comment | InternalValue |
12 Error of string | Sync | EOF
13 type file = {src_path: Path.T, text: string, pos: Position.T}
15 Text of string | Typ of typ | Term of term | Fact of thm list |
16 Attribute of morphism -> attribute | Files of file Exn.result list
18 val str_of_kind: kind -> string
19 val position_of: T -> Position.T
20 val end_position_of: T -> Position.T
21 val position_range_of: T list -> Position.range
22 val pos_of: T -> string
25 val not_eof: T -> bool
26 val not_sync: T -> bool
27 val stopper: T Scan.stopper
28 val kind_of: T -> kind
29 val is_kind: kind -> T -> bool
30 val keyword_with: (string -> bool) -> T -> bool
31 val ident_with: (string -> bool) -> T -> bool
32 val is_command: T -> bool
33 val is_name: T -> bool
34 val is_proper: T -> bool
35 val is_improper: T -> bool
36 val is_semicolon: T -> bool
37 val is_comment: T -> bool
38 val is_begin_ignore: T -> bool
39 val is_end_ignore: T -> bool
40 val is_error: T -> bool
41 val is_space: T -> bool
42 val is_blank: T -> bool
43 val is_newline: T -> bool
44 val source_of: T -> string
45 val source_position_of: T -> Symbol_Pos.text * Position.T
46 val content_of: T -> string
47 val unparse: T -> string
48 val text_of: T -> string * string
49 val get_files: T -> file Exn.result list
50 val put_files: file Exn.result list -> T -> T
51 val get_value: T -> value option
52 val map_value: (value -> value) -> T -> T
53 val mk_text: string -> T
55 val mk_term: term -> T
56 val mk_fact: thm list -> T
57 val mk_attribute: (morphism -> attribute) -> T
58 val assignable: T -> T
59 val assign: value option -> T -> unit
61 val ident_or_symbolic: string -> bool
62 val source_proper: (T, 'a) Source.source -> (T, (T, 'a) Source.source) Source.source
63 val source': {do_recover: bool option} -> (unit -> Scan.lexicon * Scan.lexicon) ->
64 (Symbol_Pos.T, 'a) Source.source -> (T, (Symbol_Pos.T, 'a) Source.source) Source.source
65 val source: {do_recover: bool option} -> (unit -> Scan.lexicon * Scan.lexicon) ->
66 Position.T -> (Symbol.symbol, 'a) Source.source -> (T,
67 (Symbol_Pos.T, Position.T * (Symbol.symbol, 'a) Source.source) Source.source) Source.source
68 val read_antiq: Scan.lexicon -> (T list -> 'a * T list) -> Symbol_Pos.T list * Position.T -> 'a
71 structure Token: TOKEN =
78 (*The value slot assigns an (optional) internal value to a token,
79 usually as a side-effect of special scanner setup (see also
80 args.ML). Note that an assignable ref designates an intermediate
81 state of internalization -- it is NOT meant to persist.*)
83 type file = {src_path: Path.T, text: string, pos: Position.T};
90 Attribute of morphism -> attribute |
91 Files of file Exn.result list;
95 Value of value option |
96 Assignable of value option Unsynchronized.ref;
102 Command | Keyword | Ident | LongIdent | SymIdent | Var | TypeIdent | TypeVar |
103 Nat | Float | String | AltString | Verbatim | Cartouche | Space | Comment | InternalValue |
104 Error of string | Sync | EOF;
106 datatype T = Token of (Symbol_Pos.text * Position.range) * (kind * string) * slot;
109 fn Command => "command"
110 | Keyword => "keyword"
111 | Ident => "identifier"
112 | LongIdent => "long identifier"
113 | SymIdent => "symbolic identifier"
114 | Var => "schematic variable"
115 | TypeIdent => "type variable"
116 | TypeVar => "schematic type variable"
117 | Nat => "natural number"
118 | Float => "floating-point number"
119 | String => "quoted string"
120 | AltString => "back-quoted string"
121 | Verbatim => "verbatim text"
122 | Cartouche => "text cartouche"
123 | Space => "white space"
124 | Comment => "comment text"
125 | InternalValue => "internal value"
126 | Error _ => "bad input"
127 | Sync => "sync marker"
128 | EOF => "end-of-input";
133 fun position_of (Token ((_, (pos, _)), _, _)) = pos;
134 fun end_position_of (Token ((_, (_, pos)), _, _)) = pos;
136 fun position_range_of [] = Position.no_range
137 | position_range_of toks = (position_of (hd toks), end_position_of (List.last toks));
139 val pos_of = Position.here o position_of;
144 fun mk_eof pos = Token (("", (pos, Position.none)), (EOF, ""), Slot);
145 val eof = mk_eof Position.none;
147 fun is_eof (Token (_, (EOF, _), _)) = true
150 val not_eof = not o is_eof;
152 fun not_sync (Token (_, (Sync, _), _)) = false
156 Scan.stopper (fn [] => eof | toks => mk_eof (end_position_of (List.last toks))) is_eof;
161 fun kind_of (Token (_, (k, _), _)) = k;
162 fun is_kind k (Token (_, (k', _), _)) = k = k';
164 val is_command = is_kind Command;
165 val is_name = is_kind Ident orf is_kind SymIdent orf is_kind String orf is_kind Nat;
167 fun keyword_with pred (Token (_, (Keyword, x), _)) = pred x
168 | keyword_with _ _ = false;
170 fun ident_with pred (Token (_, (Ident, x), _)) = pred x
171 | ident_with _ _ = false;
173 fun is_proper (Token (_, (Space, _), _)) = false
174 | is_proper (Token (_, (Comment, _), _)) = false
175 | is_proper _ = true;
177 val is_improper = not o is_proper;
179 fun is_semicolon (Token (_, (Keyword, ";"), _)) = true
180 | is_semicolon _ = false;
182 fun is_comment (Token (_, (Comment, _), _)) = true
183 | is_comment _ = false;
185 fun is_begin_ignore (Token (_, (Comment, "<"), _)) = true
186 | is_begin_ignore _ = false;
188 fun is_end_ignore (Token (_, (Comment, ">"), _)) = true
189 | is_end_ignore _ = false;
191 fun is_error (Token (_, (Error _, _), _)) = true
192 | is_error _ = false;
195 (* blanks and newlines -- space tokens obey lines *)
197 fun is_space (Token (_, (Space, _), _)) = true
198 | is_space _ = false;
200 fun is_blank (Token (_, (Space, x), _)) = not (String.isSuffix "\n" x)
201 | is_blank _ = false;
203 fun is_newline (Token (_, (Space, x), _)) = String.isSuffix "\n" x
204 | is_newline _ = false;
209 fun source_of (Token ((source, (pos, _)), (_, x), _)) =
210 if YXML.detect x then x
211 else YXML.string_of (XML.Elem (Markup.token (Position.properties_of pos), [XML.Text source]));
213 fun source_position_of (Token ((source, (pos, _)), _, _)) = (source, pos);
215 fun content_of (Token (_, (_, x), _)) = x;
220 fun unparse (Token (_, (kind, x), _)) =
222 String => Symbol_Pos.quote_string_qq x
223 | AltString => Symbol_Pos.quote_string_bq x
224 | Verbatim => enclose "{*" "*}" x
225 | Cartouche => cartouche x
226 | Comment => enclose "(*" "*)" x
232 if is_semicolon tok then ("terminator", "")
235 val k = str_of_kind (kind_of tok);
238 if s = "" then (k, "")
239 else if size s < 40 andalso not (exists_string (fn c => c = "\n") s) then (k ^ " " ^ s, "")
245 (** associated values **)
247 (* inlined file content *)
249 fun get_files (Token (_, _, Value (SOME (Files files)))) = files
252 fun put_files [] tok = tok
253 | put_files files (Token (x, y, Slot)) = Token (x, y, Value (SOME (Files files)))
255 raise Fail ("Cannot put inlined files here" ^ Position.here (position_of tok));
260 fun get_value (Token (_, _, Value v)) = v
261 | get_value _ = NONE;
263 fun map_value f (Token (x, y, Value (SOME v))) = Token (x, y, Value (SOME (f v)))
264 | map_value _ tok = tok;
269 fun mk_value k v = Token ((k, Position.no_range), (InternalValue, k), Value (SOME v));
271 val mk_text = mk_value "<text>" o Text;
272 val mk_typ = mk_value "<typ>" o Typ;
273 val mk_term = mk_value "<term>" o Term;
274 val mk_fact = mk_value "<fact>" o Fact;
275 val mk_attribute = mk_value "<attribute>" o Attribute;
280 (*1st stage: make empty slots assignable*)
281 fun assignable (Token (x, y, Slot)) = Token (x, y, Assignable (Unsynchronized.ref NONE))
282 | assignable tok = tok;
284 (*2nd stage: assign values as side-effect of scanning*)
285 fun assign v (Token (_, _, Assignable r)) = r := v
288 (*3rd stage: static closure of final values*)
289 fun closure (Token (x, y, Assignable (Unsynchronized.ref v))) = Token (x, y, Value v)
296 open Basic_Symbol_Pos;
298 val err_prefix = "Outer lexical error: ";
300 fun !!! msg = Symbol_Pos.!!! (fn () => err_prefix ^ msg);
303 (* scan symbolic idents *)
306 Scan.many1 (Symbol.is_symbolic_char o Symbol_Pos.symbol) ||
307 Scan.one (Symbol.is_symbolic o Symbol_Pos.symbol) >> single;
310 (case try Symbol.explode str of
311 SOME [s] => Symbol.is_symbolic s orelse Symbol.is_symbolic_char s
312 | SOME ss => forall Symbol.is_symbolic_char ss
315 fun ident_or_symbolic "begin" = false
316 | ident_or_symbolic ":" = true
317 | ident_or_symbolic "::" = true
318 | ident_or_symbolic s = Symbol_Pos.is_identifier s orelse is_symid s;
321 (* scan verbatim text *)
324 $$$ "*" --| Scan.ahead (~$$$ "}") ||
325 Scan.one (fn (s, _) => s <> "*" andalso Symbol.is_regular s) >> single;
328 (Symbol_Pos.scan_pos --| $$$ "{" --| $$$ "*") -- !!! "missing end of verbatim text"
329 (Symbol_Pos.change_prompt
330 ((Scan.repeat scan_verb >> flat) -- ($$$ "*" |-- $$$ "}" |-- Symbol_Pos.scan_pos)));
332 val recover_verbatim =
333 $$$ "{" @@@ $$$ "*" @@@ (Scan.repeat scan_verb >> flat);
339 Symbol_Pos.scan_pos --
340 ((Symbol_Pos.scan_cartouche !!! >> Symbol_Pos.cartouche_content) -- Symbol_Pos.scan_pos);
345 fun space_symbol (s, _) = Symbol.is_blank s andalso s <> "\n";
348 Scan.many1 space_symbol @@@ Scan.optional ($$$ "\n") [] ||
349 Scan.many space_symbol @@@ $$$ "\n";
355 Symbol_Pos.scan_pos -- (Symbol_Pos.scan_comment_body !!! -- Symbol_Pos.scan_pos);
359 (** token sources **)
361 fun source_proper src = src |> Source.filter is_proper;
365 fun token_leq ((_, syms1), (_, syms2)) = length syms1 <= length syms2;
368 Token ((Symbol_Pos.implode ss, Symbol_Pos.range ss), (k, Symbol_Pos.content ss), Slot);
370 fun token_range k (pos1, (ss, pos2)) =
371 Token (Symbol_Pos.implode_range pos1 pos2 ss, (k, Symbol_Pos.content ss), Slot);
373 fun scan (lex1, lex2) = !!! "bad input"
374 (Symbol_Pos.scan_string_qq err_prefix >> token_range String ||
375 Symbol_Pos.scan_string_bq err_prefix >> token_range AltString ||
376 scan_verbatim >> token_range Verbatim ||
377 scan_cartouche >> token_range Cartouche ||
378 scan_comment >> token_range Comment ||
379 scan_space >> token Space ||
380 Scan.one (Symbol.is_sync o Symbol_Pos.symbol) >> (token Sync o single) ||
383 (Scan.literal lex2 >> pair Command)
384 (Scan.literal lex1 >> pair Keyword))
385 (Lexicon.scan_longid >> pair LongIdent ||
386 Lexicon.scan_id >> pair Ident ||
387 Lexicon.scan_var >> pair Var ||
388 Lexicon.scan_tid >> pair TypeIdent ||
389 Lexicon.scan_tvar >> pair TypeVar ||
390 Lexicon.scan_float >> pair Float ||
391 Lexicon.scan_nat >> pair Nat ||
392 scan_symid >> pair SymIdent) >> uncurry token));
395 (Symbol_Pos.recover_string_qq ||
396 Symbol_Pos.recover_string_bq ||
398 Symbol_Pos.recover_cartouche ||
399 Symbol_Pos.recover_comment ||
400 Scan.one (Symbol.is_regular o Symbol_Pos.symbol) >> single)
401 >> (single o token (Error msg));
405 fun source' {do_recover} get_lex =
406 Source.source Symbol_Pos.stopper (Scan.bulk (fn xs => scan (get_lex ()) xs))
407 (Option.map (rpair recover) do_recover);
409 fun source do_recover get_lex pos src =
410 Symbol_Pos.source pos src
411 |> source' do_recover get_lex;
418 fun read_antiq lex scan (syms, pos) =
420 fun err msg = cat_error msg ("Malformed antiquotation" ^ Position.here pos ^ ":\n" ^
421 "@{" ^ Symbol_Pos.content syms ^ "}");
425 |> source' {do_recover = NONE} (K (lex, Scan.empty_lexicon))
427 |> Source.source stopper (Scan.error (Scan.bulk scan)) NONE
429 in (case res of [x] => x | _ => err "") handle ERROR msg => err msg end;