src/Pure/Isar/outer_lex.ML
author wenzelm
Sun Jul 20 23:06:59 2008 +0200 (2008-07-20 ago)
changeset 27663 098798321622
parent 27358 d6679949a869
child 27733 d3d7038fb7b5
permissions -rw-r--r--
maintain token range;
wenzelm@5825
     1
(*  Title:      Pure/Isar/outer_lex.ML
wenzelm@5825
     2
    ID:         $Id$
wenzelm@5825
     3
    Author:     Markus Wenzel, TU Muenchen
wenzelm@5825
     4
wenzelm@5825
     5
Outer lexical syntax for Isabelle/Isar.
wenzelm@5825
     6
*)
wenzelm@5825
     7
wenzelm@5825
     8
signature OUTER_LEX =
wenzelm@5825
     9
sig
wenzelm@5825
    10
  datatype token_kind =
wenzelm@23729
    11
    Command | Keyword | Ident | LongIdent | SymIdent | Var | TypeIdent | TypeVar | Nat |
wenzelm@23788
    12
    String | AltString | Verbatim | Space | Comment | Malformed | Error of string | Sync | EOF
aspinall@15143
    13
  eqtype token
wenzelm@5825
    14
  val str_of_kind: token_kind -> string
wenzelm@5825
    15
  val stopper: token * (token -> bool)
wenzelm@6859
    16
  val not_sync: token -> bool
wenzelm@5825
    17
  val not_eof: token -> bool
wenzelm@27663
    18
  val range_of: token -> Position.range
wenzelm@5825
    19
  val position_of: token -> Position.T
wenzelm@5825
    20
  val pos_of: token -> string
wenzelm@23721
    21
  val kind_of: token -> token_kind
wenzelm@5825
    22
  val is_kind: token_kind -> token -> bool
wenzelm@7026
    23
  val keyword_with: (string -> bool) -> token -> bool
wenzelm@16029
    24
  val ident_with: (string -> bool) -> token -> bool
wenzelm@5825
    25
  val is_proper: token -> bool
wenzelm@9130
    26
  val is_semicolon: token -> bool
wenzelm@17069
    27
  val is_comment: token -> bool
wenzelm@8580
    28
  val is_begin_ignore: token -> bool
wenzelm@8580
    29
  val is_end_ignore: token -> bool
wenzelm@17069
    30
  val is_blank: token -> bool
wenzelm@8651
    31
  val is_newline: token -> bool
wenzelm@25642
    32
  val val_of: token -> string
wenzelm@14991
    33
  val unparse: token -> string
wenzelm@23788
    34
  val text_of: token -> string * string
wenzelm@5876
    35
  val is_sid: string -> bool
wenzelm@9130
    36
  val !!! : string -> (Position.T * 'a -> 'b) -> Position.T * 'a -> 'b
wenzelm@26004
    37
  val count: (Symbol.symbol list -> Symbol.symbol * Symbol.symbol list) ->
wenzelm@26004
    38
    Position.T * Symbol.symbol list -> Symbol.symbol * (Position.T * Symbol.symbol list)
wenzelm@26004
    39
  val counted: (Symbol.symbol list -> Symbol.symbol list * Symbol.symbol list) ->
wenzelm@26004
    40
    Position.T * Symbol.symbol list -> string * (Position.T * Symbol.symbol list)
wenzelm@9130
    41
  val scan_string: Position.T * Symbol.symbol list -> string * (Position.T * Symbol.symbol list)
wenzelm@7026
    42
  val scan: (Scan.lexicon * Scan.lexicon) ->
wenzelm@5825
    43
    Position.T * Symbol.symbol list -> token * (Position.T * Symbol.symbol list)
wenzelm@23721
    44
  val source: bool option -> (unit -> Scan.lexicon * Scan.lexicon) ->
wenzelm@7026
    45
    Position.T -> (Symbol.symbol, 'a) Source.source ->
wenzelm@7682
    46
    (token, Position.T * (Symbol.symbol, 'a) Source.source) Source.source
wenzelm@17164
    47
  val source_proper: (token, 'a) Source.source ->
wenzelm@17164
    48
    (token, (token, 'a) Source.source) Source.source
wenzelm@5825
    49
end;
wenzelm@5825
    50
wenzelm@5825
    51
structure OuterLex: OUTER_LEX =
wenzelm@5825
    52
struct
wenzelm@5825
    53
wenzelm@5825
    54
wenzelm@5825
    55
(** tokens **)
wenzelm@5825
    56
wenzelm@5825
    57
(* datatype token *)
wenzelm@5825
    58
wenzelm@5825
    59
datatype token_kind =
wenzelm@23729
    60
  Command | Keyword | Ident | LongIdent | SymIdent | Var | TypeIdent | TypeVar | Nat |
wenzelm@23788
    61
  String | AltString | Verbatim | Space | Comment | Malformed | Error of string | Sync | EOF;
wenzelm@5825
    62
wenzelm@27663
    63
datatype token = Token of Position.range * (token_kind * string);
wenzelm@5825
    64
wenzelm@5825
    65
val str_of_kind =
wenzelm@7026
    66
 fn Command => "command"
wenzelm@7026
    67
  | Keyword => "keyword"
wenzelm@5825
    68
  | Ident => "identifier"
wenzelm@5825
    69
  | LongIdent => "long identifier"
wenzelm@5825
    70
  | SymIdent => "symbolic identifier"
wenzelm@5825
    71
  | Var => "schematic variable"
wenzelm@5825
    72
  | TypeIdent => "type variable"
wenzelm@5825
    73
  | TypeVar => "schematic type variable"
wenzelm@5825
    74
  | Nat => "number"
wenzelm@5825
    75
  | String => "string"
wenzelm@17164
    76
  | AltString => "back-quoted string"
wenzelm@5825
    77
  | Verbatim => "verbatim text"
wenzelm@7682
    78
  | Space => "white space"
wenzelm@7682
    79
  | Comment => "comment text"
wenzelm@23729
    80
  | Malformed => "malformed symbolic character"
wenzelm@23729
    81
  | Error _ => "bad input"
wenzelm@23788
    82
  | Sync => "sync marker"
wenzelm@5825
    83
  | EOF => "end-of-file";
wenzelm@5825
    84
wenzelm@5825
    85
wenzelm@10748
    86
(* control tokens *)
wenzelm@6859
    87
wenzelm@27663
    88
val eof = Token ((Position.none, Position.none), (EOF, ""));
wenzelm@5825
    89
wenzelm@5825
    90
fun is_eof (Token (_, (EOF, _))) = true
wenzelm@5825
    91
  | is_eof _ = false;
wenzelm@5825
    92
wenzelm@5825
    93
val stopper = (eof, is_eof);
wenzelm@5825
    94
val not_eof = not o is_eof;
wenzelm@5825
    95
wenzelm@5825
    96
wenzelm@23678
    97
fun not_sync (Token (_, (Sync, _))) = false
wenzelm@23678
    98
  | not_sync _ = true;
wenzelm@23678
    99
wenzelm@23678
   100
wenzelm@5825
   101
(* get position *)
wenzelm@5825
   102
wenzelm@27663
   103
fun range_of (Token (range, _)) = range;
wenzelm@27663
   104
wenzelm@27663
   105
val position_of = #1 o range_of;
wenzelm@5825
   106
val pos_of = Position.str_of o position_of;
wenzelm@5825
   107
wenzelm@5825
   108
wenzelm@5825
   109
(* kind of token *)
wenzelm@5825
   110
wenzelm@23721
   111
fun kind_of (Token (_, (k, _))) = k;
wenzelm@23721
   112
wenzelm@5825
   113
fun is_kind k (Token (_, (k', _))) = k = k';
wenzelm@5825
   114
wenzelm@7026
   115
fun keyword_with pred (Token (_, (Keyword, x))) = pred x
wenzelm@7026
   116
  | keyword_with _ _ = false;
wenzelm@5825
   117
wenzelm@16029
   118
fun ident_with pred (Token (_, (Ident, x))) = pred x
wenzelm@16029
   119
  | ident_with _ _ = false;
wenzelm@16029
   120
wenzelm@7682
   121
fun is_proper (Token (_, (Space, _))) = false
wenzelm@7682
   122
  | is_proper (Token (_, (Comment, _))) = false
wenzelm@5825
   123
  | is_proper _ = true;
wenzelm@5825
   124
wenzelm@9195
   125
fun is_semicolon (Token (_, (Keyword, ";"))) = true
wenzelm@9130
   126
  | is_semicolon _ = false;
wenzelm@9130
   127
wenzelm@17069
   128
fun is_comment (Token (_, (Comment, _))) = true
wenzelm@17069
   129
  | is_comment _ = false;
wenzelm@17069
   130
wenzelm@8580
   131
fun is_begin_ignore (Token (_, (Comment, "<"))) = true
wenzelm@8580
   132
  | is_begin_ignore _ = false;
wenzelm@8580
   133
wenzelm@8580
   134
fun is_end_ignore (Token (_, (Comment, ">"))) = true
wenzelm@8580
   135
  | is_end_ignore _ = false;
wenzelm@8580
   136
wenzelm@8651
   137
wenzelm@17069
   138
(* blanks and newlines -- space tokens obey lines *)
wenzelm@8651
   139
wenzelm@23678
   140
fun is_blank (Token (_, (Space, x))) = not (String.isSuffix "\n" x)
wenzelm@17069
   141
  | is_blank _ = false;
wenzelm@17069
   142
wenzelm@23678
   143
fun is_newline (Token (_, (Space, x))) = String.isSuffix "\n" x
wenzelm@8651
   144
  | is_newline _ = false;
wenzelm@8651
   145
wenzelm@5825
   146
wenzelm@14991
   147
(* token content *)
wenzelm@9155
   148
wenzelm@25642
   149
fun val_of (Token (_, (_, x))) = x;
wenzelm@25642
   150
wenzelm@18547
   151
fun escape q =
wenzelm@18547
   152
  implode o map (fn s => if s = q orelse s = "\\" then "\\" ^ s else s) o Symbol.explode;
wenzelm@18547
   153
wenzelm@14991
   154
fun unparse (Token (_, (kind, x))) =
wenzelm@14991
   155
  (case kind of
wenzelm@18547
   156
    String => x |> quote o escape "\""
wenzelm@18547
   157
  | AltString => x |> enclose "`" "`" o escape "`"
wenzelm@14991
   158
  | Verbatim => x |> enclose "{*" "*}"
wenzelm@14991
   159
  | Comment => x |> enclose "(*" "*)"
wenzelm@25642
   160
  | Malformed => Output.escape (translate_string Output.output x)
wenzelm@23729
   161
  | Sync => ""
wenzelm@23729
   162
  | EOF => ""
wenzelm@14991
   163
  | _ => x);
wenzelm@14991
   164
wenzelm@23788
   165
fun text_of tok =
wenzelm@23788
   166
  if is_semicolon tok then ("terminator", "")
wenzelm@23729
   167
  else
wenzelm@23788
   168
    let
wenzelm@23788
   169
      val k = str_of_kind (kind_of tok);
wenzelm@25642
   170
      val s = unparse tok
wenzelm@25642
   171
        handle ERROR _ => Symbol.separate_chars (val_of tok);
wenzelm@23788
   172
    in
wenzelm@23788
   173
      if s = "" then (k, "")
wenzelm@23788
   174
      else if size s < 40 andalso not (exists_string (fn c => c = "\n") s) then (k ^ " " ^ s, "")
wenzelm@23788
   175
      else (k, s)
wenzelm@23788
   176
    end;
wenzelm@23729
   177
wenzelm@5825
   178
wenzelm@5825
   179
wenzelm@5825
   180
(** scanners **)
wenzelm@5825
   181
wenzelm@5825
   182
fun change_prompt scan = Scan.prompt "# " scan;
wenzelm@5825
   183
wenzelm@5825
   184
wenzelm@5825
   185
(* diagnostics *)
wenzelm@5825
   186
wenzelm@5825
   187
fun lex_err msg ((pos, cs), _) = "Outer lexical error" ^ Position.str_of pos ^ ": " ^ msg cs;
wenzelm@9130
   188
fun !!! msg scan = Scan.!! (lex_err (K msg)) scan;
wenzelm@5825
   189
wenzelm@5825
   190
wenzelm@26004
   191
(* position *)
wenzelm@26004
   192
wenzelm@26004
   193
local
wenzelm@26004
   194
wenzelm@26004
   195
fun map_position f (scan: Symbol.symbol list -> 'a * Symbol.symbol list)  =
wenzelm@26004
   196
  Scan.depend (fn (pos: Position.T) => scan >> (fn x => (f x pos, x)));
wenzelm@5825
   197
wenzelm@26004
   198
in
wenzelm@5825
   199
wenzelm@26004
   200
fun count scan = map_position Position.advance scan;
wenzelm@26004
   201
fun counted scan = map_position (fold Position.advance) scan >> implode;
wenzelm@26004
   202
wenzelm@26004
   203
end;
wenzelm@5825
   204
wenzelm@5825
   205
wenzelm@5825
   206
(* scan symbolic idents *)
wenzelm@5825
   207
wenzelm@20664
   208
val is_sym_char = member (op =) (explode "!#$%&*+-/<=>?@^_|~");
wenzelm@5825
   209
wenzelm@8231
   210
val scan_symid =
wenzelm@26004
   211
  Scan.many1 is_sym_char ||
wenzelm@26004
   212
  Scan.one Symbol.is_symbolic >> single;
wenzelm@5825
   213
wenzelm@8231
   214
fun is_symid str =
wenzelm@8231
   215
  (case try Symbol.explode str of
skalberg@15531
   216
    SOME [s] => Symbol.is_symbolic s orelse is_sym_char s
skalberg@15531
   217
  | SOME ss => forall is_sym_char ss
wenzelm@8231
   218
  | _ => false);
wenzelm@8231
   219
wenzelm@20982
   220
fun is_sid "begin" = false
wenzelm@20982
   221
  | is_sid ":" = true
wenzelm@22873
   222
  | is_sid "::" = true
wenzelm@20982
   223
  | is_sid s = is_symid s orelse Syntax.is_identifier s;
wenzelm@5825
   224
wenzelm@5825
   225
wenzelm@5825
   226
(* scan strings *)
wenzelm@5825
   227
wenzelm@17164
   228
local
wenzelm@17164
   229
wenzelm@25579
   230
val char_code =
wenzelm@26004
   231
  count (Scan.one Symbol.is_ascii_digit) --
wenzelm@26004
   232
  count (Scan.one Symbol.is_ascii_digit) --
wenzelm@26004
   233
  count (Scan.one Symbol.is_ascii_digit) :|--
wenzelm@26004
   234
  (fn ((a, b), c) =>
wenzelm@25579
   235
    let val (n, _) = Library.read_int [a, b, c]
wenzelm@25579
   236
    in if n <= 255 then Scan.succeed (chr n) else Scan.fail end);
wenzelm@25579
   237
wenzelm@17164
   238
fun scan_str q =
wenzelm@26004
   239
  count ($$ "\\") |-- !!! "bad escape character in string" (count ($$ q || $$ "\\") || char_code) ||
wenzelm@26004
   240
  count (Scan.one (fn s => s <> q andalso s <> "\\" andalso Symbol.is_regular s));
wenzelm@5825
   241
wenzelm@17164
   242
fun scan_strs q =
wenzelm@26004
   243
  count ($$ q) |--
wenzelm@9130
   244
    !!! "missing quote at end of string"
wenzelm@26004
   245
      (change_prompt ((Scan.repeat (scan_str q) >> implode) --| count ($$ q)));
wenzelm@17164
   246
wenzelm@17164
   247
in
wenzelm@17164
   248
wenzelm@17164
   249
val scan_string = scan_strs "\"";
wenzelm@17164
   250
val scan_alt_string = scan_strs "`";
wenzelm@17164
   251
wenzelm@17164
   252
end;
wenzelm@5825
   253
wenzelm@5825
   254
wenzelm@5825
   255
(* scan verbatim text *)
wenzelm@5825
   256
wenzelm@5825
   257
val scan_verb =
wenzelm@26004
   258
  count ($$ "*" --| Scan.ahead (~$$ "}")) ||
wenzelm@26004
   259
  count (Scan.one (fn s => s <> "*" andalso Symbol.is_regular s));
wenzelm@5825
   260
wenzelm@5825
   261
val scan_verbatim =
wenzelm@26004
   262
  count ($$ "{") |-- count ($$ "*") |--
wenzelm@9130
   263
    !!! "missing end of verbatim text"
wenzelm@26004
   264
      (change_prompt ((Scan.repeat scan_verb >> implode) --| count ($$ "*") --| count ($$ "}")));
wenzelm@5825
   265
wenzelm@5825
   266
wenzelm@5825
   267
(* scan space *)
wenzelm@5825
   268
wenzelm@19305
   269
fun is_space s = Symbol.is_blank s andalso s <> "\n";
wenzelm@5825
   270
wenzelm@5825
   271
val scan_space =
wenzelm@26004
   272
  (Scan.many1 is_space @@@ Scan.optional ($$ "\n" >> single) [] ||
wenzelm@26004
   273
    Scan.many is_space @@@ ($$ "\n" >> single));
wenzelm@5825
   274
wenzelm@5825
   275
wenzelm@5825
   276
(* scan nested comments *)
wenzelm@5825
   277
wenzelm@5825
   278
val scan_cmt =
wenzelm@26004
   279
  Scan.depend (fn d => count ($$ "(") ^^ count ($$ "*") >> pair (d + 1)) ||
wenzelm@26004
   280
  Scan.depend (fn 0 => Scan.fail | d => count ($$ "*") ^^ count ($$ ")") >> pair (d - 1)) ||
wenzelm@26004
   281
  Scan.lift (count ($$ "*" --| Scan.ahead (~$$ ")"))) ||
wenzelm@26004
   282
  Scan.lift (count (Scan.one (fn s => s <> "*" andalso Symbol.is_regular s)));
wenzelm@5825
   283
wenzelm@5825
   284
val scan_comment =
wenzelm@26004
   285
  count ($$ "(") |-- count ($$ "*") |--
wenzelm@9130
   286
    !!! "missing end of comment"
wenzelm@5825
   287
      (change_prompt
wenzelm@26004
   288
        (Scan.pass 0 (Scan.repeat scan_cmt >> implode) --| count ($$ "*") --| count ($$ ")")));
wenzelm@5825
   289
wenzelm@5825
   290
wenzelm@23678
   291
(* scan malformed symbols *)
wenzelm@23678
   292
wenzelm@23678
   293
val scan_malformed =
wenzelm@26004
   294
  $$ Symbol.malformed |--
wenzelm@26004
   295
    change_prompt (Scan.many Symbol.is_regular)
wenzelm@26004
   296
  --| Scan.option ($$ Symbol.end_malformed);
wenzelm@23678
   297
wenzelm@23678
   298
wenzelm@5825
   299
(* scan token *)
wenzelm@5825
   300
wenzelm@27663
   301
fun token_leq ((_, x1: string), (_, x2)) = x1 <= x2;
wenzelm@27663
   302
wenzelm@9130
   303
fun scan (lex1, lex2) =
wenzelm@5825
   304
  let
wenzelm@27663
   305
    val scanner = Scan.state --
wenzelm@27663
   306
      (scan_string >> pair String ||
wenzelm@27663
   307
        scan_alt_string >> pair AltString ||
wenzelm@27663
   308
        scan_verbatim >> pair Verbatim ||
wenzelm@27663
   309
        scan_comment >> pair Comment ||
wenzelm@27663
   310
        counted scan_space >> pair Space ||
wenzelm@27663
   311
        counted scan_malformed >> pair Malformed ||
wenzelm@27663
   312
        Scan.lift (Scan.one Symbol.is_sync >> K (Sync, Symbol.sync)) ||
wenzelm@26004
   313
        (Scan.max token_leq
wenzelm@9130
   314
          (Scan.max token_leq
wenzelm@27663
   315
            (counted (Scan.literal lex2) >> pair Command)
wenzelm@27663
   316
            (counted (Scan.literal lex1) >> pair Keyword))
wenzelm@27663
   317
          (counted Syntax.scan_longid >> pair LongIdent ||
wenzelm@27663
   318
            counted Syntax.scan_id >> pair Ident ||
wenzelm@27663
   319
            counted Syntax.scan_var >> pair Var ||
wenzelm@27663
   320
            counted Syntax.scan_tid >> pair TypeIdent ||
wenzelm@27663
   321
            counted Syntax.scan_tvar >> pair TypeVar ||
wenzelm@27663
   322
            counted Syntax.scan_nat >> pair Nat ||
wenzelm@27663
   323
            counted scan_symid >> pair SymIdent))) -- Scan.state
wenzelm@27663
   324
      >> (fn ((pos, (k, x)), pos') => Token ((pos, pos'), (k, x)));
wenzelm@27663
   325
wenzelm@14729
   326
  in !! (lex_err (fn cs => "bad input " ^ quote (Symbol.beginning 10 cs))) scanner end;
wenzelm@5825
   327
wenzelm@5825
   328
wenzelm@9130
   329
(* token sources *)
wenzelm@5825
   330
wenzelm@23678
   331
local
wenzelm@23678
   332
wenzelm@23788
   333
val is_junk = (not o Symbol.is_blank) andf Symbol.is_regular;
wenzelm@23678
   334
wenzelm@27663
   335
fun recover msg = Scan.state -- counted (Scan.many is_junk) -- Scan.state
wenzelm@27663
   336
  >> (fn ((pos, s), pos') => [Token ((pos, pos'), (Error msg, s))]);
wenzelm@23678
   337
wenzelm@23678
   338
in
wenzelm@5825
   339
wenzelm@5825
   340
fun source do_recover get_lex pos src =
wenzelm@5825
   341
  Source.source' pos Symbol.stopper (Scan.bulk (fn xs => scan (get_lex ()) xs))
wenzelm@23682
   342
    (Option.map (rpair recover) do_recover) src;
wenzelm@23678
   343
wenzelm@23678
   344
end;
wenzelm@5825
   345
wenzelm@9130
   346
fun source_proper src = src |> Source.filter is_proper;
wenzelm@9130
   347
wenzelm@9130
   348
wenzelm@5825
   349
end;