src/Pure/General/antiquote.ML
author wenzelm
Sat, 23 Jul 2011 16:37:17 +0200
changeset 44818 9b00f09f7721
parent 43379 e21362bf1d93
child 45627 c2a3f1c84179
permissions -rw-r--r--
defer evaluation of Scan.message, for improved performance in the frequent situation where failure is handled later (e.g. via ||);
wenzelm@30590
     1
(*  Title:      Pure/General/antiquote.ML
wenzelm@9138
     2
    Author:     Markus Wenzel, TU Muenchen
wenzelm@9138
     3
wenzelm@30590
     4
Text with antiquotations of inner items (types, terms, theorems etc.).
wenzelm@9138
     5
*)
wenzelm@9138
     6
wenzelm@9138
     7
signature ANTIQUOTE =
wenzelm@9138
     8
sig
wenzelm@30593
     9
  datatype 'a antiquote =
wenzelm@30593
    10
    Text of 'a |
wenzelm@30698
    11
    Antiq of Symbol_Pos.T list * Position.range |
wenzelm@30593
    12
    Open of Position.T |
wenzelm@30593
    13
    Close of Position.T
wenzelm@30639
    14
  val is_text: 'a antiquote -> bool
wenzelm@30645
    15
  val report: ('a -> unit) -> 'a antiquote -> unit
wenzelm@30645
    16
  val check_nesting: 'a antiquote list -> unit
wenzelm@43379
    17
  val scan_antiq: Symbol_Pos.T list -> (Symbol_Pos.T list * Position.range) * Symbol_Pos.T list
wenzelm@30593
    18
  val scan: Symbol_Pos.T list -> 'a antiquote * Symbol_Pos.T list
wenzelm@30593
    19
  val scan_text: Symbol_Pos.T list -> Symbol_Pos.T list antiquote * Symbol_Pos.T list
wenzelm@30645
    20
  val read: Symbol_Pos.T list * Position.T -> Symbol_Pos.T list antiquote list
wenzelm@9138
    21
end;
wenzelm@9138
    22
wenzelm@9138
    23
structure Antiquote: ANTIQUOTE =
wenzelm@9138
    24
struct
wenzelm@9138
    25
wenzelm@9138
    26
(* datatype antiquote *)
wenzelm@9138
    27
wenzelm@30593
    28
datatype 'a antiquote =
wenzelm@30593
    29
  Text of 'a |
wenzelm@30698
    30
  Antiq of Symbol_Pos.T list * Position.range |
wenzelm@27342
    31
  Open of Position.T |
wenzelm@27342
    32
  Close of Position.T;
wenzelm@9138
    33
wenzelm@30639
    34
fun is_text (Text _) = true
wenzelm@30639
    35
  | is_text _ = false;
wenzelm@27342
    36
wenzelm@27342
    37
wenzelm@30645
    38
(* report *)
wenzelm@30645
    39
wenzelm@39776
    40
fun report_antiq pos = Position.report pos Markup.antiq;
wenzelm@30645
    41
wenzelm@30645
    42
fun report report_text (Text x) = report_text x
wenzelm@30698
    43
  | report _ (Antiq (_, (pos, _))) = report_antiq pos
wenzelm@30645
    44
  | report _ (Open pos) = report_antiq pos
wenzelm@30645
    45
  | report _ (Close pos) = report_antiq pos;
wenzelm@30645
    46
wenzelm@30645
    47
wenzelm@27342
    48
(* check_nesting *)
wenzelm@27342
    49
wenzelm@27342
    50
fun err_unbalanced pos =
wenzelm@27342
    51
  error ("Unbalanced antiquotation block parentheses" ^ Position.str_of pos);
wenzelm@27342
    52
wenzelm@27342
    53
fun check_nesting antiqs =
wenzelm@27342
    54
  let
wenzelm@27342
    55
    fun check [] [] = ()
wenzelm@27342
    56
      | check [] (pos :: _) = err_unbalanced pos
wenzelm@27342
    57
      | check (Open pos :: ants) ps = check ants (pos :: ps)
wenzelm@27342
    58
      | check (Close pos :: _) [] = err_unbalanced pos
wenzelm@27342
    59
      | check (Close _ :: ants) (_ :: ps) = check ants ps
wenzelm@27342
    60
      | check (_ :: ants) ps = check ants ps;
wenzelm@27342
    61
  in check antiqs [] end;
wenzelm@9138
    62
wenzelm@9138
    63
wenzelm@30593
    64
(* scan *)
wenzelm@9138
    65
wenzelm@30576
    66
open Basic_Symbol_Pos;
wenzelm@22114
    67
wenzelm@9138
    68
local
wenzelm@9138
    69
wenzelm@9138
    70
val scan_txt =
wenzelm@27767
    71
  $$$ "@" --| Scan.ahead (~$$$ "{") ||
wenzelm@27767
    72
  Scan.one (fn (s, _) => s <> "@" andalso s <> "\\<lbrace>" andalso s <> "\\<rbrace>"
wenzelm@27767
    73
    andalso Symbol.is_regular s) >> single;
wenzelm@9138
    74
wenzelm@9138
    75
val scan_ant =
wenzelm@43374
    76
  Scan.trace (Symbol_Pos.scan_string_qq || Symbol_Pos.scan_string_bq) >> #2 ||
wenzelm@27767
    77
  Scan.one (fn (s, _) => s <> "}" andalso Symbol.is_regular s) >> single;
wenzelm@9138
    78
wenzelm@43379
    79
val scan_open = Symbol_Pos.scan_pos --| $$$ "\\<lbrace>";
wenzelm@43379
    80
val scan_close = Symbol_Pos.scan_pos --| $$$ "\\<rbrace>";
wenzelm@43379
    81
wenzelm@43379
    82
in
wenzelm@43379
    83
wenzelm@9138
    84
val scan_antiq =
wenzelm@30576
    85
  Symbol_Pos.scan_pos -- ($$$ "@" |-- $$$ "{" |--
wenzelm@44818
    86
    Symbol_Pos.!!! (fn () => "missing closing brace of antiquotation")
wenzelm@30576
    87
      (Scan.repeat scan_ant -- ($$$ "}" |-- Symbol_Pos.scan_pos)))
wenzelm@30698
    88
  >> (fn (pos1, (body, pos2)) => (flat body, Position.range pos1 pos2));
wenzelm@30593
    89
wenzelm@30593
    90
fun scan x = (scan_antiq >> Antiq || scan_open >> Open || scan_close >> Close) x;
wenzelm@30593
    91
val scan_text = scan || Scan.repeat1 scan_txt >> (Text o flat);
wenzelm@9138
    92
wenzelm@9138
    93
end;
wenzelm@9138
    94
wenzelm@9138
    95
wenzelm@27767
    96
(* read *)
wenzelm@9138
    97
wenzelm@30645
    98
fun read (syms, pos) =
wenzelm@30645
    99
  (case Scan.read Symbol_Pos.stopper (Scan.repeat scan_text) syms of
wenzelm@30645
   100
    SOME xs => (List.app (report (K ())) xs; check_nesting xs; xs)
wenzelm@30645
   101
  | NONE => error ("Malformed quotation/antiquotation source" ^ Position.str_of pos));
wenzelm@9138
   102
wenzelm@9138
   103
end;