src/Pure/Isar/outer_lex.ML
author wenzelm
Sun May 22 16:51:17 2005 +0200 (2005-05-22 ago)
changeset 16029 070ed43b86f8
parent 15531 08c8dad8e399
child 17069 ee08b2466a09
permissions -rw-r--r--
added ident_with;
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@7477
    11
    Command | Keyword | Ident | LongIdent | SymIdent | Var | TypeIdent | TypeVar |
wenzelm@10748
    12
    Nat | String | Verbatim | Space | Comment | Sync | Malformed | 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@5825
    18
  val position_of: token -> Position.T
wenzelm@5825
    19
  val pos_of: token -> string
wenzelm@5825
    20
  val is_kind: token_kind -> token -> bool
wenzelm@7026
    21
  val keyword_with: (string -> bool) -> token -> bool
wenzelm@16029
    22
  val ident_with: (string -> bool) -> token -> bool
wenzelm@5825
    23
  val name_of: token -> string
wenzelm@5825
    24
  val is_proper: token -> bool
wenzelm@9130
    25
  val is_semicolon: token -> bool
wenzelm@8580
    26
  val is_begin_ignore: token -> bool
wenzelm@8580
    27
  val is_end_ignore: token -> bool
wenzelm@8651
    28
  val is_newline: token -> bool
wenzelm@7902
    29
  val is_indent: token -> bool
wenzelm@14991
    30
  val unparse: token -> string
wenzelm@5825
    31
  val val_of: token -> string
wenzelm@5876
    32
  val is_sid: string -> bool
wenzelm@9130
    33
  val !!! : string -> (Position.T * 'a -> 'b) -> Position.T * 'a -> 'b
wenzelm@9130
    34
  val incr_line: ('a -> 'b * 'c) -> Position.T * 'a -> 'b * (Position.T * 'c)
wenzelm@9130
    35
  val keep_line: ('a -> 'b * 'c) -> Position.T * 'a -> 'b * (Position.T * 'c)
wenzelm@9130
    36
  val scan_blank: Position.T * Symbol.symbol list
wenzelm@9130
    37
    -> Symbol.symbol * (Position.T * Symbol.symbol list)
wenzelm@9130
    38
  val scan_string: Position.T * Symbol.symbol list -> string * (Position.T * Symbol.symbol list)
wenzelm@7026
    39
  val scan: (Scan.lexicon * Scan.lexicon) ->
wenzelm@5825
    40
    Position.T * Symbol.symbol list -> token * (Position.T * Symbol.symbol list)
wenzelm@7026
    41
  val source: bool -> (unit -> (Scan.lexicon * Scan.lexicon)) ->
wenzelm@7026
    42
    Position.T -> (Symbol.symbol, 'a) Source.source ->
wenzelm@7682
    43
    (token, Position.T * (Symbol.symbol, 'a) Source.source) Source.source
wenzelm@9130
    44
  val source_proper: (token, 'a) Source.source -> (token, (token, 'a) Source.source) Source.source
wenzelm@9130
    45
  val make_lexicon: string list -> Scan.lexicon
wenzelm@5825
    46
end;
wenzelm@5825
    47
wenzelm@5825
    48
structure OuterLex: OUTER_LEX =
wenzelm@5825
    49
struct
wenzelm@5825
    50
wenzelm@5825
    51
wenzelm@5825
    52
(** tokens **)
wenzelm@5825
    53
wenzelm@5825
    54
(* datatype token *)
wenzelm@5825
    55
wenzelm@5825
    56
datatype token_kind =
wenzelm@7477
    57
  Command | Keyword | Ident | LongIdent | SymIdent | Var | TypeIdent | TypeVar |
wenzelm@10748
    58
  Nat | String | Verbatim | Space | Comment | Sync | Malformed | EOF;
wenzelm@5825
    59
wenzelm@5825
    60
datatype token = Token of Position.T * (token_kind * string);
wenzelm@5825
    61
wenzelm@5825
    62
val str_of_kind =
wenzelm@7026
    63
 fn Command => "command"
wenzelm@7026
    64
  | Keyword => "keyword"
wenzelm@5825
    65
  | Ident => "identifier"
wenzelm@5825
    66
  | LongIdent => "long identifier"
wenzelm@5825
    67
  | SymIdent => "symbolic identifier"
wenzelm@5825
    68
  | Var => "schematic variable"
wenzelm@5825
    69
  | TypeIdent => "type variable"
wenzelm@5825
    70
  | TypeVar => "schematic type variable"
wenzelm@5825
    71
  | Nat => "number"
wenzelm@5825
    72
  | String => "string"
wenzelm@5825
    73
  | Verbatim => "verbatim text"
wenzelm@7682
    74
  | Space => "white space"
wenzelm@7682
    75
  | Comment => "comment text"
wenzelm@6859
    76
  | Sync => "sync marker"
wenzelm@10748
    77
  | Malformed => "bad input"
wenzelm@5825
    78
  | EOF => "end-of-file";
wenzelm@5825
    79
wenzelm@5825
    80
wenzelm@10748
    81
(* control tokens *)
wenzelm@6859
    82
wenzelm@6859
    83
fun not_sync (Token (_, (Sync, _))) = false
wenzelm@6859
    84
  | not_sync _ = true;
wenzelm@6859
    85
wenzelm@10748
    86
val malformed = Token (Position.none, (Malformed, ""));
aspinall@15224
    87
fun malformed_of xs = Token (Position.none, (Malformed, implode xs));
wenzelm@10748
    88
wenzelm@6859
    89
wenzelm@5825
    90
(* eof token *)
wenzelm@5825
    91
wenzelm@5825
    92
val eof = Token (Position.none, (EOF, ""));
wenzelm@5825
    93
wenzelm@5825
    94
fun is_eof (Token (_, (EOF, _))) = true
wenzelm@5825
    95
  | is_eof _ = false;
wenzelm@5825
    96
wenzelm@5825
    97
val stopper = (eof, is_eof);
wenzelm@5825
    98
val not_eof = not o is_eof;
wenzelm@5825
    99
wenzelm@5825
   100
wenzelm@5825
   101
(* get position *)
wenzelm@5825
   102
wenzelm@5825
   103
fun position_of (Token (pos, _)) = pos;
wenzelm@5825
   104
val pos_of = Position.str_of o position_of;
wenzelm@5825
   105
wenzelm@5825
   106
wenzelm@5825
   107
(* kind of token *)
wenzelm@5825
   108
wenzelm@5825
   109
fun is_kind k (Token (_, (k', _))) = k = k';
wenzelm@5825
   110
wenzelm@7026
   111
fun keyword_with pred (Token (_, (Keyword, x))) = pred x
wenzelm@7026
   112
  | keyword_with _ _ = false;
wenzelm@5825
   113
wenzelm@16029
   114
fun ident_with pred (Token (_, (Ident, x))) = pred x
wenzelm@16029
   115
  | ident_with _ _ = false;
wenzelm@16029
   116
wenzelm@7682
   117
fun is_proper (Token (_, (Space, _))) = false
wenzelm@7682
   118
  | is_proper (Token (_, (Comment, _))) = false
wenzelm@5825
   119
  | is_proper _ = true;
wenzelm@5825
   120
wenzelm@9195
   121
fun is_semicolon (Token (_, (Keyword, ";"))) = true
wenzelm@9130
   122
  | is_semicolon _ = false;
wenzelm@9130
   123
wenzelm@8580
   124
fun is_begin_ignore (Token (_, (Comment, "<"))) = true
wenzelm@8580
   125
  | is_begin_ignore _ = false;
wenzelm@8580
   126
wenzelm@8580
   127
fun is_end_ignore (Token (_, (Comment, ">"))) = true
wenzelm@8580
   128
  | is_end_ignore _ = false;
wenzelm@8580
   129
wenzelm@8651
   130
wenzelm@8651
   131
(* newline and indentations (note that space tokens obey lines) *)
wenzelm@8651
   132
wenzelm@8651
   133
fun is_newline (Token (_, (Space, "\n"))) = true
wenzelm@8651
   134
  | is_newline _ = false;
wenzelm@8651
   135
wenzelm@7902
   136
fun is_indent (Token (_, (Space, s))) =
wenzelm@7902
   137
      let val n = size s in n > 0 andalso String.substring (s, n - 1, 1) <> "\n" end
wenzelm@7902
   138
  | is_indent _ = false;
wenzelm@7902
   139
wenzelm@5825
   140
wenzelm@14991
   141
(* token content *)
wenzelm@9155
   142
wenzelm@9155
   143
fun name_of (tok as Token (_, (k, x))) =
wenzelm@10748
   144
  if is_semicolon tok then "terminator"
wenzelm@10748
   145
  else if x = "" then str_of_kind k
wenzelm@10748
   146
  else str_of_kind k ^ " " ^ quote x;
wenzelm@5825
   147
wenzelm@14991
   148
fun unparse (Token (_, (kind, x))) =
wenzelm@14991
   149
  (case kind of
aspinall@15209
   150
    String => x |> quote
wenzelm@14991
   151
  | Verbatim => x |> enclose "{*" "*}"
wenzelm@14991
   152
  | Comment => x |> enclose "(*" "*)"
wenzelm@14991
   153
  | _ => x);
wenzelm@14991
   154
wenzelm@5825
   155
fun val_of (Token (_, (_, x))) = x;
wenzelm@5825
   156
wenzelm@5825
   157
fun token_leq (Token (_, (_, x)), Token (_, (_, x'))) = x <= x';
wenzelm@5825
   158
wenzelm@5825
   159
wenzelm@5825
   160
wenzelm@5825
   161
(** scanners **)
wenzelm@5825
   162
wenzelm@5825
   163
fun change_prompt scan = Scan.prompt "# " scan;
wenzelm@5825
   164
wenzelm@5825
   165
wenzelm@5825
   166
(* diagnostics *)
wenzelm@5825
   167
wenzelm@5825
   168
fun lex_err msg ((pos, cs), _) = "Outer lexical error" ^ Position.str_of pos ^ ": " ^ msg cs;
wenzelm@9130
   169
fun !!! msg scan = Scan.!! (lex_err (K msg)) scan;
wenzelm@5825
   170
wenzelm@5825
   171
wenzelm@5825
   172
(* line numbering *)
wenzelm@5825
   173
wenzelm@5825
   174
fun incr_line scan = Scan.depend (fn pos => scan >> pair (Position.inc pos));
wenzelm@5825
   175
val keep_line = Scan.lift;
wenzelm@5825
   176
wenzelm@5825
   177
val scan_blank =
wenzelm@5825
   178
  incr_line ($$ "\n") ||
wenzelm@5825
   179
  keep_line (Scan.one Symbol.is_blank);
wenzelm@5825
   180
wenzelm@5825
   181
wenzelm@5825
   182
(* scan symbolic idents *)
wenzelm@5825
   183
wenzelm@5825
   184
val sym_chars = explode "!#$%&*+-/:<=>?@^_`|~";
wenzelm@5825
   185
fun is_sym_char s = s mem sym_chars;
wenzelm@5825
   186
wenzelm@8231
   187
val scan_symid =
wenzelm@8231
   188
  Scan.any1 is_sym_char >> implode ||
wenzelm@8231
   189
  Scan.one Symbol.is_symbolic;
wenzelm@5825
   190
wenzelm@8231
   191
fun is_symid str =
wenzelm@8231
   192
  (case try Symbol.explode str of
skalberg@15531
   193
    SOME [s] => Symbol.is_symbolic s orelse is_sym_char s
skalberg@15531
   194
  | SOME ss => forall is_sym_char ss
wenzelm@8231
   195
  | _ => false);
wenzelm@8231
   196
wenzelm@5876
   197
val is_sid = is_symid orf Syntax.is_identifier;
wenzelm@5825
   198
wenzelm@5825
   199
wenzelm@5825
   200
(* scan strings *)
wenzelm@5825
   201
wenzelm@5825
   202
val scan_str =
wenzelm@7682
   203
  scan_blank ||
wenzelm@9130
   204
  keep_line ($$ "\\") |-- !!! "bad escape character in string"
wenzelm@9051
   205
      (scan_blank || keep_line ($$ "\"" || $$ "\\")) ||
wenzelm@6859
   206
  keep_line (Scan.one (not_equal "\\" andf not_equal "\"" andf
wenzelm@6859
   207
    Symbol.not_sync andf Symbol.not_eof));
wenzelm@5825
   208
wenzelm@5825
   209
val scan_string =
wenzelm@5825
   210
  keep_line ($$ "\"") |--
wenzelm@9130
   211
    !!! "missing quote at end of string"
wenzelm@5825
   212
      (change_prompt ((Scan.repeat scan_str >> implode) --| keep_line ($$ "\"")));
wenzelm@5825
   213
wenzelm@5825
   214
wenzelm@5825
   215
(* scan verbatim text *)
wenzelm@5825
   216
wenzelm@5825
   217
val scan_verb =
wenzelm@5825
   218
  scan_blank ||
wenzelm@6743
   219
  keep_line ($$ "*" --| Scan.ahead (Scan.one (not_equal "}"))) ||
wenzelm@6859
   220
  keep_line (Scan.one (not_equal "*" andf Symbol.not_sync andf Symbol.not_eof));
wenzelm@5825
   221
wenzelm@5825
   222
val scan_verbatim =
wenzelm@6743
   223
  keep_line ($$ "{" -- $$ "*") |--
wenzelm@9130
   224
    !!! "missing end of verbatim text"
wenzelm@6743
   225
      (change_prompt ((Scan.repeat scan_verb >> implode) --| keep_line ($$ "*" -- $$ "}")));
wenzelm@5825
   226
wenzelm@5825
   227
wenzelm@5825
   228
(* scan space *)
wenzelm@5825
   229
wenzelm@5825
   230
val is_space = Symbol.is_blank andf not_equal "\n";
wenzelm@5825
   231
wenzelm@5825
   232
val scan_space =
wenzelm@7682
   233
  (keep_line (Scan.any1 is_space) -- Scan.optional (incr_line ($$ "\n")) "" ||
wenzelm@7682
   234
    keep_line (Scan.any is_space) -- incr_line ($$ "\n")) >> (fn (cs, c) => implode cs ^ c);
wenzelm@5825
   235
wenzelm@5825
   236
wenzelm@5825
   237
(* scan nested comments *)
wenzelm@5825
   238
wenzelm@5825
   239
val scan_cmt =
wenzelm@5825
   240
  Scan.lift scan_blank ||
wenzelm@5825
   241
  Scan.depend (fn d => keep_line ($$ "(" ^^ $$ "*") >> pair (d + 1)) ||
wenzelm@5825
   242
  Scan.depend (fn 0 => Scan.fail | d => keep_line ($$ "*" ^^ $$ ")") >> pair (d - 1)) ||
wenzelm@5825
   243
  Scan.lift (keep_line ($$ "*" --| Scan.ahead (Scan.one (not_equal ")")))) ||
wenzelm@6859
   244
  Scan.lift (keep_line (Scan.one (not_equal "*" andf Symbol.not_sync andf Symbol.not_eof)));
wenzelm@5825
   245
wenzelm@5825
   246
val scan_comment =
wenzelm@5825
   247
  keep_line ($$ "(" -- $$ "*") |--
wenzelm@9130
   248
    !!! "missing end of comment"
wenzelm@5825
   249
      (change_prompt
wenzelm@7682
   250
        (Scan.pass 0 (Scan.repeat scan_cmt >> implode) --| keep_line ($$ "*" -- $$ ")")));
wenzelm@5825
   251
wenzelm@5825
   252
wenzelm@5825
   253
(* scan token *)
wenzelm@5825
   254
wenzelm@9130
   255
fun scan (lex1, lex2) =
wenzelm@5825
   256
  let
wenzelm@9130
   257
    val scanner = Scan.state :-- (fn pos =>
wenzelm@9130
   258
      let
wenzelm@9130
   259
        fun token k x = Token (pos, (k, x));
wenzelm@9130
   260
        fun sync _ = token Sync Symbol.sync;
wenzelm@9130
   261
      in
wenzelm@9130
   262
        scan_string >> token String ||
wenzelm@9130
   263
        scan_verbatim >> token Verbatim ||
wenzelm@9130
   264
        scan_space >> token Space ||
wenzelm@9130
   265
        scan_comment >> token Comment ||
wenzelm@9130
   266
        keep_line (Scan.one Symbol.is_sync >> sync) ||
wenzelm@9130
   267
        keep_line (Scan.max token_leq
wenzelm@9130
   268
          (Scan.max token_leq
wenzelm@9130
   269
            (Scan.literal lex1 >> (token Keyword o implode))
wenzelm@9130
   270
            (Scan.literal lex2 >> (token Command o implode)))
wenzelm@9130
   271
          (Syntax.scan_longid >> token LongIdent ||
wenzelm@9130
   272
            Syntax.scan_id >> token Ident ||
wenzelm@9130
   273
            Syntax.scan_var >> token Var ||
wenzelm@9130
   274
            Syntax.scan_tid >> token TypeIdent ||
wenzelm@9130
   275
            Syntax.scan_tvar >> token TypeVar ||
wenzelm@9130
   276
            Syntax.scan_nat >> token Nat ||
wenzelm@9130
   277
            scan_symid >> token SymIdent))
wenzelm@9130
   278
      end) >> #2;
wenzelm@14729
   279
  in !! (lex_err (fn cs => "bad input " ^ quote (Symbol.beginning 10 cs))) scanner end;
wenzelm@5825
   280
wenzelm@5825
   281
wenzelm@9130
   282
(* token sources *)
wenzelm@5825
   283
wenzelm@6859
   284
val is_junk = (not o Symbol.is_blank) andf Symbol.not_sync andf Symbol.not_eof;
aspinall@15224
   285
fun recover xs = (keep_line (Scan.any is_junk) >> (fn ts => [malformed_of ts])) xs;
wenzelm@5825
   286
wenzelm@5825
   287
fun source do_recover get_lex pos src =
wenzelm@5825
   288
  Source.source' pos Symbol.stopper (Scan.bulk (fn xs => scan (get_lex ()) xs))
skalberg@15531
   289
    (if do_recover then SOME recover else NONE) src;
wenzelm@5825
   290
wenzelm@9130
   291
fun source_proper src = src |> Source.filter is_proper;
wenzelm@9130
   292
wenzelm@9130
   293
wenzelm@9130
   294
(* lexicons *)
wenzelm@9130
   295
wenzelm@9130
   296
val make_lexicon = Scan.make_lexicon o map Symbol.explode;
wenzelm@5825
   297
wenzelm@5825
   298
end;