src/Pure/Isar/outer_lex.ML
author wenzelm
Sun Oct 03 15:51:38 1999 +0200 (1999-10-03 ago)
changeset 7682 46de8064c93c
parent 7477 c7caea1ce78c
child 7902 10fd5d922c97
permissions -rw-r--r--
added Space, Comment token kinds (keep actual text);
source: do not filter proper;
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@7682
    12
    Nat | String | Verbatim | Space | Comment | Sync | EOF
wenzelm@5825
    13
  type 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@5825
    22
  val name_of: token -> string
wenzelm@5825
    23
  val is_proper: token -> bool
wenzelm@5825
    24
  val val_of: token -> string
wenzelm@5876
    25
  val is_sid: string -> bool
wenzelm@7026
    26
  val scan: (Scan.lexicon * Scan.lexicon) ->
wenzelm@5825
    27
    Position.T * Symbol.symbol list -> token * (Position.T * Symbol.symbol list)
wenzelm@7026
    28
  val source: bool -> (unit -> (Scan.lexicon * Scan.lexicon)) ->
wenzelm@7026
    29
    Position.T -> (Symbol.symbol, 'a) Source.source ->
wenzelm@7682
    30
    (token, Position.T * (Symbol.symbol, 'a) Source.source) Source.source
wenzelm@5825
    31
end;
wenzelm@5825
    32
wenzelm@5825
    33
structure OuterLex: OUTER_LEX =
wenzelm@5825
    34
struct
wenzelm@5825
    35
wenzelm@5825
    36
wenzelm@5825
    37
(** tokens **)
wenzelm@5825
    38
wenzelm@5825
    39
(* datatype token *)
wenzelm@5825
    40
wenzelm@5825
    41
datatype token_kind =
wenzelm@7477
    42
  Command | Keyword | Ident | LongIdent | SymIdent | Var | TypeIdent | TypeVar |
wenzelm@7682
    43
  Nat | String | Verbatim | Space | Comment | Sync | EOF;
wenzelm@5825
    44
wenzelm@5825
    45
datatype token = Token of Position.T * (token_kind * string);
wenzelm@5825
    46
wenzelm@5825
    47
val str_of_kind =
wenzelm@7026
    48
 fn Command => "command"
wenzelm@7026
    49
  | Keyword => "keyword"
wenzelm@5825
    50
  | Ident => "identifier"
wenzelm@5825
    51
  | LongIdent => "long identifier"
wenzelm@5825
    52
  | SymIdent => "symbolic identifier"
wenzelm@5825
    53
  | Var => "schematic variable"
wenzelm@5825
    54
  | TypeIdent => "type variable"
wenzelm@5825
    55
  | TypeVar => "schematic type variable"
wenzelm@5825
    56
  | Nat => "number"
wenzelm@5825
    57
  | String => "string"
wenzelm@5825
    58
  | Verbatim => "verbatim text"
wenzelm@7682
    59
  | Space => "white space"
wenzelm@7682
    60
  | Comment => "comment text"
wenzelm@6859
    61
  | Sync => "sync marker"
wenzelm@5825
    62
  | EOF => "end-of-file";
wenzelm@5825
    63
wenzelm@5825
    64
wenzelm@6859
    65
(* sync token *)
wenzelm@6859
    66
wenzelm@6859
    67
fun not_sync (Token (_, (Sync, _))) = false
wenzelm@6859
    68
  | not_sync _ = true;
wenzelm@6859
    69
wenzelm@6859
    70
wenzelm@5825
    71
(* eof token *)
wenzelm@5825
    72
wenzelm@5825
    73
val eof = Token (Position.none, (EOF, ""));
wenzelm@5825
    74
wenzelm@5825
    75
fun is_eof (Token (_, (EOF, _))) = true
wenzelm@5825
    76
  | is_eof _ = false;
wenzelm@5825
    77
wenzelm@5825
    78
val stopper = (eof, is_eof);
wenzelm@5825
    79
val not_eof = not o is_eof;
wenzelm@5825
    80
wenzelm@5825
    81
wenzelm@5825
    82
(* get position *)
wenzelm@5825
    83
wenzelm@5825
    84
fun position_of (Token (pos, _)) = pos;
wenzelm@5825
    85
val pos_of = Position.str_of o position_of;
wenzelm@5825
    86
wenzelm@5825
    87
wenzelm@5825
    88
(* kind of token *)
wenzelm@5825
    89
wenzelm@5825
    90
fun is_kind k (Token (_, (k', _))) = k = k';
wenzelm@5825
    91
wenzelm@7026
    92
fun keyword_with pred (Token (_, (Keyword, x))) = pred x
wenzelm@7026
    93
  | keyword_with _ _ = false;
wenzelm@5825
    94
wenzelm@5825
    95
fun name_of (Token (_, (k, _))) = str_of_kind k;
wenzelm@5825
    96
wenzelm@7682
    97
fun is_proper (Token (_, (Space, _))) = false
wenzelm@7682
    98
  | is_proper (Token (_, (Comment, _))) = false
wenzelm@5825
    99
  | is_proper _ = true;
wenzelm@5825
   100
wenzelm@5825
   101
wenzelm@5825
   102
(* value of token *)
wenzelm@5825
   103
wenzelm@5825
   104
fun val_of (Token (_, (_, x))) = x;
wenzelm@5825
   105
wenzelm@5825
   106
fun token_leq (Token (_, (_, x)), Token (_, (_, x'))) = x <= x';
wenzelm@5825
   107
wenzelm@5825
   108
wenzelm@5825
   109
wenzelm@5825
   110
(** scanners **)
wenzelm@5825
   111
wenzelm@5825
   112
fun change_prompt scan = Scan.prompt "# " scan;
wenzelm@5825
   113
wenzelm@5825
   114
wenzelm@5825
   115
(* diagnostics *)
wenzelm@5825
   116
wenzelm@5825
   117
fun lex_err msg ((pos, cs), _) = "Outer lexical error" ^ Position.str_of pos ^ ": " ^ msg cs;
wenzelm@5825
   118
wenzelm@5825
   119
wenzelm@5825
   120
(* line numbering *)
wenzelm@5825
   121
wenzelm@5825
   122
fun incr_line scan = Scan.depend (fn pos => scan >> pair (Position.inc pos));
wenzelm@5825
   123
val keep_line = Scan.lift;
wenzelm@5825
   124
wenzelm@5825
   125
val scan_blank =
wenzelm@5825
   126
  incr_line ($$ "\n") ||
wenzelm@5825
   127
  keep_line (Scan.one Symbol.is_blank);
wenzelm@5825
   128
wenzelm@5825
   129
wenzelm@5825
   130
(* scan symbolic idents *)
wenzelm@5825
   131
wenzelm@5825
   132
val sym_chars = explode "!#$%&*+-/:<=>?@^_`|~";
wenzelm@5825
   133
fun is_sym_char s = s mem sym_chars;
wenzelm@5825
   134
wenzelm@5876
   135
val scan_symid = Scan.any1 is_sym_char >> implode;
wenzelm@5825
   136
wenzelm@5876
   137
fun is_symid s = s <> "" andalso forall is_sym_char (Symbol.explode s);
wenzelm@5876
   138
val is_sid = is_symid orf Syntax.is_identifier;
wenzelm@5825
   139
wenzelm@5825
   140
wenzelm@5825
   141
(* scan strings *)
wenzelm@5825
   142
wenzelm@5825
   143
val scan_str =
wenzelm@7682
   144
  scan_blank ||
wenzelm@6859
   145
  keep_line ($$ "\\" |-- Scan.one (Symbol.not_sync andf Symbol.not_eof)) ||
wenzelm@6859
   146
  keep_line (Scan.one (not_equal "\\" andf not_equal "\"" andf
wenzelm@6859
   147
    Symbol.not_sync andf Symbol.not_eof));
wenzelm@5825
   148
wenzelm@5825
   149
val scan_string =
wenzelm@5825
   150
  keep_line ($$ "\"") |--
wenzelm@5825
   151
    !! (lex_err (K "missing quote at end of string"))
wenzelm@5825
   152
      (change_prompt ((Scan.repeat scan_str >> implode) --| keep_line ($$ "\"")));
wenzelm@5825
   153
wenzelm@5825
   154
wenzelm@5825
   155
(* scan verbatim text *)
wenzelm@5825
   156
wenzelm@5825
   157
val scan_verb =
wenzelm@5825
   158
  scan_blank ||
wenzelm@6743
   159
  keep_line ($$ "*" --| Scan.ahead (Scan.one (not_equal "}"))) ||
wenzelm@6859
   160
  keep_line (Scan.one (not_equal "*" andf Symbol.not_sync andf Symbol.not_eof));
wenzelm@5825
   161
wenzelm@5825
   162
val scan_verbatim =
wenzelm@6743
   163
  keep_line ($$ "{" -- $$ "*") |--
wenzelm@5825
   164
    !! (lex_err (K "missing end of verbatim text"))
wenzelm@6743
   165
      (change_prompt ((Scan.repeat scan_verb >> implode) --| keep_line ($$ "*" -- $$ "}")));
wenzelm@5825
   166
wenzelm@5825
   167
wenzelm@5825
   168
(* scan space *)
wenzelm@5825
   169
wenzelm@5825
   170
val is_space = Symbol.is_blank andf not_equal "\n";
wenzelm@5825
   171
wenzelm@5825
   172
val scan_space =
wenzelm@7682
   173
  (keep_line (Scan.any1 is_space) -- Scan.optional (incr_line ($$ "\n")) "" ||
wenzelm@7682
   174
    keep_line (Scan.any is_space) -- incr_line ($$ "\n")) >> (fn (cs, c) => implode cs ^ c);
wenzelm@5825
   175
wenzelm@5825
   176
wenzelm@5825
   177
(* scan nested comments *)
wenzelm@5825
   178
wenzelm@5825
   179
val scan_cmt =
wenzelm@5825
   180
  Scan.lift scan_blank ||
wenzelm@5825
   181
  Scan.depend (fn d => keep_line ($$ "(" ^^ $$ "*") >> pair (d + 1)) ||
wenzelm@5825
   182
  Scan.depend (fn 0 => Scan.fail | d => keep_line ($$ "*" ^^ $$ ")") >> pair (d - 1)) ||
wenzelm@5825
   183
  Scan.lift (keep_line ($$ "*" --| Scan.ahead (Scan.one (not_equal ")")))) ||
wenzelm@6859
   184
  Scan.lift (keep_line (Scan.one (not_equal "*" andf Symbol.not_sync andf Symbol.not_eof)));
wenzelm@5825
   185
wenzelm@5825
   186
val scan_comment =
wenzelm@5825
   187
  keep_line ($$ "(" -- $$ "*") |--
wenzelm@5825
   188
    !! (lex_err (K "missing end of comment"))
wenzelm@5825
   189
      (change_prompt
wenzelm@7682
   190
        (Scan.pass 0 (Scan.repeat scan_cmt >> implode) --| keep_line ($$ "*" -- $$ ")")));
wenzelm@5825
   191
wenzelm@5825
   192
wenzelm@5825
   193
(* scan token *)
wenzelm@5825
   194
wenzelm@7026
   195
fun scan (lex1, lex2) (pos, cs) =
wenzelm@5825
   196
  let
wenzelm@5825
   197
    fun token k x = Token (pos, (k, x));
wenzelm@6859
   198
    fun sync _ = token Sync Symbol.sync;
wenzelm@5825
   199
wenzelm@5825
   200
    val scanner =
wenzelm@5825
   201
      scan_string >> token String ||
wenzelm@5825
   202
      scan_verbatim >> token Verbatim ||
wenzelm@7682
   203
      scan_space >> token Space ||
wenzelm@7682
   204
      scan_comment >> token Comment ||
wenzelm@6859
   205
      keep_line (Scan.one Symbol.is_sync >> sync) ||
wenzelm@5825
   206
      keep_line (Scan.max token_leq
wenzelm@7026
   207
        (Scan.max token_leq
wenzelm@7026
   208
          (Scan.literal lex1 >> (token Keyword o implode))
wenzelm@7026
   209
          (Scan.literal lex2 >> (token Command o implode)))
wenzelm@5825
   210
        (Syntax.scan_longid >> token LongIdent ||
wenzelm@5825
   211
          Syntax.scan_id >> token Ident ||
wenzelm@5825
   212
          Syntax.scan_var >> token Var ||
wenzelm@5825
   213
          Syntax.scan_tid >> token TypeIdent ||
wenzelm@5825
   214
          Syntax.scan_tvar >> token TypeVar ||
wenzelm@5825
   215
          Syntax.scan_nat >> token Nat ||
wenzelm@5825
   216
          scan_symid >> token SymIdent));
wenzelm@6859
   217
  in !! (lex_err (fn cs => "bad input " ^ quote (Symbol.beginning cs))) scanner (pos, cs) end;
wenzelm@5825
   218
wenzelm@5825
   219
wenzelm@5825
   220
(* source of (proper) tokens *)
wenzelm@5825
   221
wenzelm@6859
   222
val is_junk = (not o Symbol.is_blank) andf Symbol.not_sync andf Symbol.not_eof;
wenzelm@6859
   223
fun recover xs = keep_line (Scan.any1 is_junk) xs;
wenzelm@5825
   224
wenzelm@5825
   225
fun source do_recover get_lex pos src =
wenzelm@5825
   226
  Source.source' pos Symbol.stopper (Scan.bulk (fn xs => scan (get_lex ()) xs))
wenzelm@7682
   227
    (if do_recover then Some recover else None) src;
wenzelm@5825
   228
wenzelm@5825
   229
wenzelm@5825
   230
end;