src/Pure/Isar/antiquote.ML
author wenzelm
Fri, 19 Jan 2007 22:08:23 +0100
changeset 22114 560c5b5dda1c
parent 19305 5c16895d548b
child 23677 1114cc909800
permissions -rw-r--r--
tuned signature; added scan_arguments;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Isar/antiquote.ML
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     3
    Author:     Markus Wenzel, TU Muenchen
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     4
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     5
Text with antiquotations of inner items (terms, types etc.).
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     6
*)
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     7
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     8
signature ANTIQUOTE =
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
     9
sig
12881
eeb36b66480e ANTIQUOTE_FAIL;
wenzelm
parents: 9138
diff changeset
    10
  exception ANTIQUOTE_FAIL of (string * Position.T) * exn
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    11
  datatype antiquote = Text of string | Antiq of string * Position.T
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    12
  val is_antiq: antiquote -> bool
22114
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    13
  val scan_antiquotes: string * Position.T -> antiquote list
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    14
  val scan_arguments: Scan.lexicon -> (OuterLex.token list -> 'a * OuterLex.token list) ->
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    15
    string * Position.T -> 'a
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    16
end;
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    17
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    18
structure Antiquote: ANTIQUOTE =
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    19
struct
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    20
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    21
(* datatype antiquote *)
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    22
12881
eeb36b66480e ANTIQUOTE_FAIL;
wenzelm
parents: 9138
diff changeset
    23
exception ANTIQUOTE_FAIL of (string * Position.T) * exn;
eeb36b66480e ANTIQUOTE_FAIL;
wenzelm
parents: 9138
diff changeset
    24
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    25
datatype antiquote =
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    26
  Text of string |
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    27
  Antiq of string * Position.T;
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    28
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    29
fun is_antiq (Text _) = false
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    30
  | is_antiq (Antiq _) = true;
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    31
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    32
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    33
(* scan_antiquote *)
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    34
22114
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    35
structure T = OuterLex;
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    36
22114
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    37
local
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    38
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    39
val scan_txt =
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    40
  T.scan_blank ||
19305
5c16895d548b avoid polymorphic equality;
wenzelm
parents: 14981
diff changeset
    41
  T.keep_line ($$ "@" --| Scan.ahead (~$$ "{")) ||
5c16895d548b avoid polymorphic equality;
wenzelm
parents: 14981
diff changeset
    42
  T.keep_line (Scan.one (fn s => s <> "@" andalso Symbol.not_sync s andalso Symbol.not_eof s));
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    43
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    44
fun escape "\\" = "\\\\"
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    45
  | escape "\"" = "\\\""
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    46
  | escape s = s;
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    47
14598
7009f59711e3 Replaced quote by Library.quote, since quote now refers to Symbol.quote
berghofe
parents: 12881
diff changeset
    48
val quote_escape = Library.quote o implode o map escape o Symbol.explode;
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    49
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    50
val scan_ant =
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    51
  T.scan_blank ||
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    52
  T.scan_string >> quote_escape ||
19305
5c16895d548b avoid polymorphic equality;
wenzelm
parents: 14981
diff changeset
    53
  T.keep_line (Scan.one (fn s => s <> "}" andalso Symbol.not_sync s andalso Symbol.not_eof s));
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    54
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    55
val scan_antiq =
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    56
  T.keep_line ($$ "@" -- $$ "{") |--
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    57
    T.!!! "missing closing brace of antiquotation"
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    58
      (Scan.repeat scan_ant >> implode) --| T.keep_line ($$ "}");
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    59
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    60
in
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    61
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    62
fun scan_antiquote (pos, ss) = (pos, ss) |>
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    63
  (Scan.repeat1 scan_txt >> (Text o implode) ||
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    64
    scan_antiq >> (fn s => Antiq (s, pos)));
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    65
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    66
end;
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    67
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    68
22114
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    69
(* scan_antiquotes *)
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    70
22114
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    71
fun scan_antiquotes (s, pos) =
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    72
  (case Scan.error (Scan.finite' Symbol.stopper (Scan.repeat scan_antiquote))
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    73
      (pos, Symbol.explode s) of
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    74
    (xs, (_, [])) => xs
22114
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    75
  | (_, (pos', ss)) => error ("Malformed quotation/antiquotation source at: " ^
14729
0e987111a17e changed Symbol.beginning;
wenzelm
parents: 14598
diff changeset
    76
      quote (Symbol.beginning 10 ss) ^ Position.str_of pos'));
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    77
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    78
22114
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    79
(* scan_arguments *)
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    80
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    81
fun scan_arguments lex antiq (s, pos) =
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    82
  let
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    83
    fun err msg = cat_error msg
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    84
      ("Malformed antiquotation: " ^ quote ("@{" ^ s ^ "}") ^ Position.str_of pos);
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    85
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    86
    val res =
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    87
      Source.of_string s
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    88
      |> Symbol.source false
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    89
      |> T.source false (K (lex, Scan.empty_lexicon)) pos
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    90
      |> T.source_proper
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    91
      |> Source.source T.stopper (Scan.error (Scan.bulk antiq)) NONE
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    92
      |> Source.exhaust;
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    93
  in (case res of [x] => x | _ => err "") handle ERROR msg => err msg end;
560c5b5dda1c tuned signature;
wenzelm
parents: 19305
diff changeset
    94
9138
6a4fae41a75f Text with antiquotations of inner items (terms, types etc.).
wenzelm
parents:
diff changeset
    95
end;