src/Pure/Isar/args.ML
author haftmann
Mon, 01 Dec 2008 19:41:16 +0100
changeset 28941 128459bd72d2
parent 28078 0c420e7579a6
child 28965 1de908189869
permissions -rw-r--r--
new Binding module
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Isar/args.ML
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
     3
    Author:     Markus Wenzel, TU Muenchen
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
     4
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
     5
Parsing with implicit value assigment.  Concrete argument syntax of
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
     6
attributes, methods etc.
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
     7
*)
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
     8
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
     9
signature ARGS =
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    10
sig
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    11
  type T = OuterLex.token
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    12
  type src
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    13
  val src: (string * T list) * Position.T -> src
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    14
  val dest_src: src -> (string * T list) * Position.T
21030
8b21407de526 moved pretty_attribs to attrib.ML;
wenzelm
parents: 20664
diff changeset
    15
  val pretty_src: Proof.context -> src -> Pretty.T
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    16
  val map_name: (string -> string) -> src -> src
21480
e2cc70e70b2f replaced map_values by morph_values;
wenzelm
parents: 21030
diff changeset
    17
  val morph_values: morphism -> src -> src
20263
fd0ed14ba1ea added maxidx_values;
wenzelm
parents: 20224
diff changeset
    18
  val maxidx_values: src -> int -> int
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    19
  val assignable: src -> src
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    20
  val closure: src -> src
27371
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
    21
  val context: Context.generic * T list -> Context.proof * (Context.generic * T list)
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
    22
  val theory: Context.generic * T list -> Context.theory * (Context.generic * T list)
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    23
  val $$$ : string -> T list -> string * T list
10035
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
    24
  val add: T list -> string * T list
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
    25
  val del: T list -> string * T list
8803
wenzelm
parents: 8687
diff changeset
    26
  val colon: T list -> string * T list
10035
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
    27
  val query: T list -> string * T list
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
    28
  val bang: T list -> string * T list
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
    29
  val query_colon: T list -> string * T list
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
    30
  val bang_colon: T list -> string * T list
8803
wenzelm
parents: 8687
diff changeset
    31
  val parens: (T list -> 'a * T list) -> T list -> 'a * T list
10150
a068c666c53e added "bracks";
wenzelm
parents: 10035
diff changeset
    32
  val bracks: (T list -> 'a * T list) -> T list -> 'a * T list
9809
58e9d55a9f88 added mode parser;
wenzelm
parents: 9748
diff changeset
    33
  val mode: string -> 'a * T list -> bool * ('a * T list)
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    34
  val maybe: (T list -> 'a * T list) -> T list -> 'a option * T list
27882
eaa9fef9f4c1 Args.name_source(_position) for proper position information;
wenzelm
parents: 27819
diff changeset
    35
  val name_source: T list -> string * T list
eaa9fef9f4c1 Args.name_source(_position) for proper position information;
wenzelm
parents: 27819
diff changeset
    36
  val name_source_position: T list -> (SymbolPos.text * Position.T) * T list
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    37
  val name: T list -> string * T list
28078
0c420e7579a6 added binding;
wenzelm
parents: 27882
diff changeset
    38
  val binding: T list -> Name.binding * T list
18037
1095d2213b9d syntax for literal facts;
wenzelm
parents: 17104
diff changeset
    39
  val alt_name: T list -> string * T list
16140
fc51e61d45fb added symbol scanner;
wenzelm
parents: 15987
diff changeset
    40
  val symbol: T list -> string * T list
17064
2fae6579fb2e added liberal_name;
wenzelm
parents: 16343
diff changeset
    41
  val liberal_name: T list -> string * T list
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
    42
  val var: T list -> indexname * T list
21496
a3ac0c55393f renamed Name value to Text, which is *not* a name in terms of morphisms;
wenzelm
parents: 21480
diff changeset
    43
  val internal_text: T list -> string * T list
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    44
  val internal_typ: T list -> typ * T list
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    45
  val internal_term: T list -> term * T list
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    46
  val internal_fact: T list -> thm list * T list
21662
ab802d4eaaf4 attribute value: morphism;
wenzelm
parents: 21496
diff changeset
    47
  val internal_attribute: T list -> (morphism -> attribute) * T list
21496
a3ac0c55393f renamed Name value to Text, which is *not* a name in terms of morphisms;
wenzelm
parents: 21480
diff changeset
    48
  val named_text: (string -> string) -> T list -> string * T list
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    49
  val named_typ: (string -> typ) -> T list -> typ * T list
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    50
  val named_term: (string -> term) -> T list -> term * T list
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    51
  val named_fact: (string -> thm list) -> T list -> thm list * T list
24002
9fe28da848b0 added terminator, named_attribute;
wenzelm
parents: 22932
diff changeset
    52
  val named_attribute: (string -> morphism -> attribute) -> T list ->
9fe28da848b0 added terminator, named_attribute;
wenzelm
parents: 22932
diff changeset
    53
    (morphism -> attribute) * T list
18635
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
    54
  val typ_abbrev: Context.generic * T list -> typ * (Context.generic * T list)
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
    55
  val typ: Context.generic * T list -> typ * (Context.generic * T list)
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
    56
  val term: Context.generic * T list -> term * (Context.generic * T list)
21724
04b4ed5e3033 added term_abbrev;
wenzelm
parents: 21697
diff changeset
    57
  val term_abbrev: Context.generic * T list -> term * (Context.generic * T list)
18635
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
    58
  val prop: Context.generic * T list -> term * (Context.generic * T list)
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
    59
  val tyname: Context.generic * T list -> string * (Context.generic * T list)
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
    60
  val const: Context.generic * T list -> string * (Context.generic * T list)
25343
31c55418de5a added const_proper;
wenzelm
parents: 25331
diff changeset
    61
  val const_proper: Context.generic * T list -> string * (Context.generic * T list)
18998
10c251f29847 Context.generic is canonical state of parsers;
wenzelm
parents: 18728
diff changeset
    62
  val bang_facts: Context.generic * T list -> thm list * (Context.generic * T list)
8536
de307f5bc89a goal_spec;
wenzelm
parents: 8282
diff changeset
    63
  val goal_spec: ((int -> tactic) -> tactic) -> ('a * T list)
de307f5bc89a goal_spec;
wenzelm
parents: 8282
diff changeset
    64
    -> ((int -> tactic) -> tactic) * ('a * T list)
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    65
  val parse: OuterLex.token list -> T list * OuterLex.token list
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    66
  val parse1: (string -> bool) -> OuterLex.token list -> T list * OuterLex.token list
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    67
  val attribs: (string -> string) -> T list -> src list * T list
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    68
  val opt_attribs: (string -> string) -> T list -> src list * T list
28078
0c420e7579a6 added binding;
wenzelm
parents: 27882
diff changeset
    69
  val thm_name: (string -> string) -> string -> T list -> (Name.binding * src list) * T list
0c420e7579a6 added binding;
wenzelm
parents: 27882
diff changeset
    70
  val opt_thm_name: (string -> string) -> string -> T list -> (Name.binding * src list) * T list
21879
a3efbae45735 switched argument order in *.syntax lifters
haftmann
parents: 21724
diff changeset
    71
  val syntax: string -> ('b * T list -> 'a * ('b * T list)) -> src -> 'b -> 'a * 'b
18998
10c251f29847 Context.generic is canonical state of parsers;
wenzelm
parents: 18728
diff changeset
    72
  val context_syntax: string -> (Context.generic * T list -> 'a * (Context.generic * T list)) ->
21879
a3efbae45735 switched argument order in *.syntax lifters
haftmann
parents: 21724
diff changeset
    73
    src -> Proof.context -> 'a * Proof.context
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    74
end;
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    75
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    76
structure Args: ARGS =
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    77
struct
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    78
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    79
structure T = OuterLex;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    80
structure P = OuterParse;
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    81
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    82
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
    83
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    84
(** datatype src **)
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    85
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    86
type T = T.token;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    87
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    88
datatype src = Src of (string * T list) * Position.T;
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    89
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    90
val src = Src;
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    91
fun dest_src (Src src) = src;
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
    92
21030
8b21407de526 moved pretty_attribs to attrib.ML;
wenzelm
parents: 20664
diff changeset
    93
fun pretty_src ctxt src =
8b21407de526 moved pretty_attribs to attrib.ML;
wenzelm
parents: 20664
diff changeset
    94
  let
21697
49da72cad42d tuned pretty_src output;
wenzelm
parents: 21662
diff changeset
    95
    val prt_thm = Pretty.backquote o ProofContext.pretty_thm ctxt;
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    96
    fun prt arg =
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    97
      (case T.get_value arg of
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    98
        SOME (T.Text s) => Pretty.str (quote s)
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
    99
      | SOME (T.Typ T) => Syntax.pretty_typ ctxt T
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   100
      | SOME (T.Term t) => Syntax.pretty_term ctxt t
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   101
      | SOME (T.Fact ths) => Pretty.enclose "(" ")" (Pretty.breaks (map prt_thm ths))
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   102
      | _ => Pretty.str (T.unparse arg));
21030
8b21407de526 moved pretty_attribs to attrib.ML;
wenzelm
parents: 20664
diff changeset
   103
    val (s, args) = #1 (dest_src src);
8b21407de526 moved pretty_attribs to attrib.ML;
wenzelm
parents: 20664
diff changeset
   104
  in Pretty.block (Pretty.breaks (Pretty.str s :: map prt args)) end;
8b21407de526 moved pretty_attribs to attrib.ML;
wenzelm
parents: 20664
diff changeset
   105
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   106
fun map_name f (Src ((s, args), pos)) = Src ((f s, args), pos);
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   107
fun map_args f (Src ((s, args), pos)) = Src ((s, map f args), pos);
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   108
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   109
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   110
(* values *)
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   111
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   112
fun morph_values phi = map_args (T.map_value
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   113
  (fn T.Text s => T.Text s
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   114
    | T.Typ T => T.Typ (Morphism.typ phi T)
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   115
    | T.Term t => T.Term (Morphism.term phi t)
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   116
    | T.Fact ths => T.Fact (Morphism.fact phi ths)
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   117
    | T.Attribute att => T.Attribute (Morphism.transform phi att)));
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   118
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   119
fun maxidx_values (Src ((_, args), _)) = args |> fold (fn arg =>
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   120
  (case T.get_value arg of
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   121
    SOME (T.Typ T) => Term.maxidx_typ T
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   122
  | SOME (T.Term t) => Term.maxidx_term t
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   123
  | SOME (T.Fact ths) => fold Thm.maxidx_thm ths
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   124
  | _ => I));
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   125
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   126
val assignable = map_args T.assignable;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   127
val closure = map_args T.closure;
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   128
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   129
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   130
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   131
(** argument scanners **)
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
   132
27371
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
   133
(* context *)
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
   134
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
   135
fun context x = (Scan.state >> Context.proof_of) x;
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
   136
fun theory x = (Scan.state >> Context.theory_of) x;
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
   137
f89aa7bd4602 added context/theory scanner;
wenzelm
parents: 27234
diff changeset
   138
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   139
(* basic *)
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   140
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   141
fun token atom = Scan.ahead P.not_eof --| atom;
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   142
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   143
val ident = token
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   144
  (P.short_ident || P.long_ident || P.sym_ident || P.term_var ||
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   145
    P.type_ident || P.type_var || P.number);
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   146
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   147
val string = token (P.string || P.verbatim);
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   148
val alt_string = token P.alt_string;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   149
val symbolic = token P.keyword_ident_or_symbolic;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   150
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   151
fun $$$ x = (ident >> T.content_of || P.keyword)
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   152
  :|-- (fn y => if x = y then Scan.succeed x else Scan.fail);
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   153
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   154
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   155
val named = ident || string;
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   156
10035
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
   157
val add = $$$ "add";
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
   158
val del = $$$ "del";
8803
wenzelm
parents: 8687
diff changeset
   159
val colon = $$$ ":";
10035
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
   160
val query = $$$ "?";
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
   161
val bang = $$$ "!";
20111
ba1676dd3546 query/bang_colon: separate tokens;
wenzelm
parents: 19482
diff changeset
   162
val query_colon = $$$ "?" ^^ $$$ ":";
ba1676dd3546 query/bang_colon: separate tokens;
wenzelm
parents: 19482
diff changeset
   163
val bang_colon = $$$ "!" ^^ $$$ ":";
10035
c095955e7575 added common args keywords;
wenzelm
parents: 9952
diff changeset
   164
8803
wenzelm
parents: 8687
diff changeset
   165
fun parens scan = $$$ "(" |-- scan --| $$$ ")";
10150
a068c666c53e added "bracks";
wenzelm
parents: 10035
diff changeset
   166
fun bracks scan = $$$ "[" |-- scan --| $$$ "]";
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   167
fun mode s = Scan.lift (Scan.optional (parens ($$$ s) >> K true) false);
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   168
fun maybe scan = $$$ "_" >> K NONE || scan >> SOME;
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   169
27882
eaa9fef9f4c1 Args.name_source(_position) for proper position information;
wenzelm
parents: 27819
diff changeset
   170
val name_source = named >> T.source_of;
eaa9fef9f4c1 Args.name_source(_position) for proper position information;
wenzelm
parents: 27819
diff changeset
   171
val name_source_position = named >> T.source_position_of;
eaa9fef9f4c1 Args.name_source(_position) for proper position information;
wenzelm
parents: 27819
diff changeset
   172
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   173
val name = named >> T.content_of;
28941
128459bd72d2 new Binding module
haftmann
parents: 28078
diff changeset
   174
val binding = P.position name >> Binding.binding_pos;
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   175
val alt_name = alt_string >> T.content_of;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   176
val symbol = symbolic >> T.content_of;
17064
2fae6579fb2e added liberal_name;
wenzelm
parents: 16343
diff changeset
   177
val liberal_name = symbol || name;
8233
85169951d515 attrib: keyword_symid;
wenzelm
parents: 8089
diff changeset
   178
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   179
val var = (ident >> T.content_of) :|-- (fn x =>
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   180
  (case Lexicon.read_variable x of SOME v => Scan.succeed v | NONE => Scan.fail));
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   181
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
   182
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   183
(* values *)
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   184
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   185
fun value dest = Scan.some (fn arg =>
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   186
  (case T.get_value arg of SOME v => (SOME (dest v) handle Match => NONE) | NONE => NONE));
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   187
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   188
fun evaluate mk eval arg =
27819
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   189
  let val x = eval arg in (T.assign (SOME (mk x)) arg; x) end;
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   190
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   191
val internal_text = value (fn T.Text s => s);
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   192
val internal_typ = value (fn T.Typ T => T);
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   193
val internal_term = value (fn T.Term t => t);
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   194
val internal_fact = value (fn T.Fact ths => ths);
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   195
val internal_attribute = value (fn T.Attribute att => att);
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   196
27819
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   197
fun named_text intern = internal_text || named >> evaluate T.Text (intern o T.content_of);
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   198
fun named_typ readT = internal_typ || named >> evaluate T.Typ (readT o T.source_of);
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   199
fun named_term read = internal_term || named >> evaluate T.Term (read o T.source_of);
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   200
fun named_fact get = internal_fact || named >> evaluate T.Fact (get o T.content_of) ||
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   201
  alt_string >> evaluate T.Fact (get o T.source_of);
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   202
fun named_attribute att = internal_attribute || named >> evaluate T.Attribute (att o T.content_of);
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   203
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   204
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   205
(* terms and types *)
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   206
18635
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
   207
val typ_abbrev = Scan.peek (named_typ o ProofContext.read_typ_abbrev o Context.proof_of);
25331
73072178e0ce Syntax.read_typ;
wenzelm
parents: 25323
diff changeset
   208
val typ = Scan.peek (named_typ o Syntax.read_typ o Context.proof_of);
24508
c8b82fec6447 replaced ProofContext.read_term/prop by general Syntax.read_term/prop;
wenzelm
parents: 24244
diff changeset
   209
val term = Scan.peek (named_term o Syntax.read_term o Context.proof_of);
21724
04b4ed5e3033 added term_abbrev;
wenzelm
parents: 21697
diff changeset
   210
val term_abbrev = Scan.peek (named_term o ProofContext.read_term_abbrev o Context.proof_of);
24508
c8b82fec6447 replaced ProofContext.read_term/prop by general Syntax.read_term/prop;
wenzelm
parents: 24244
diff changeset
   211
val prop = Scan.peek (named_term o Syntax.read_prop o Context.proof_of);
18635
58bbff56a914 added generic syntax;
wenzelm
parents: 18037
diff changeset
   212
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   213
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   214
(* type and constant names *)
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   215
25323
50d4c8257d06 removed obsolete Sign.read_tyname/const (cf. ProofContext);
wenzelm
parents: 24920
diff changeset
   216
val tyname = Scan.peek (named_typ o ProofContext.read_tyname o Context.proof_of)
18998
10c251f29847 Context.generic is canonical state of parsers;
wenzelm
parents: 18728
diff changeset
   217
  >> (fn Type (c, _) => c | TFree (a, _) => a | _ => "");
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   218
25323
50d4c8257d06 removed obsolete Sign.read_tyname/const (cf. ProofContext);
wenzelm
parents: 24920
diff changeset
   219
val const = Scan.peek (named_term o ProofContext.read_const o Context.proof_of)
18998
10c251f29847 Context.generic is canonical state of parsers;
wenzelm
parents: 18728
diff changeset
   220
  >> (fn Const (c, _) => c | Free (x, _) => x | _ => "");
7553
af3a1fe87c42 added bang_facts;
wenzelm
parents: 6447
diff changeset
   221
25343
31c55418de5a added const_proper;
wenzelm
parents: 25331
diff changeset
   222
val const_proper = Scan.peek (named_term o ProofContext.read_const_proper o Context.proof_of)
31c55418de5a added const_proper;
wenzelm
parents: 25331
diff changeset
   223
  >> (fn Const (c, _) => c | _ => "");
31c55418de5a added const_proper;
wenzelm
parents: 25331
diff changeset
   224
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   225
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   226
(* improper method arguments *)
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   227
18998
10c251f29847 Context.generic is canonical state of parsers;
wenzelm
parents: 18728
diff changeset
   228
val bang_facts = Scan.peek (fn context =>
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   229
  P.position ($$$ "!") >> (fn (_, pos) =>
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   230
    (warning ("use of prems in proof method" ^ Position.str_of pos);
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   231
      Assumption.prems_of (Context.proof_of context))) || Scan.succeed []);
8536
de307f5bc89a goal_spec;
wenzelm
parents: 8282
diff changeset
   232
de307f5bc89a goal_spec;
wenzelm
parents: 8282
diff changeset
   233
val from_to =
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   234
  P.nat -- ($$$ "-" |-- P.nat) >> (fn (i, j) => fn tac => Seq.INTERVAL tac i j) ||
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   235
  P.nat --| $$$ "-" >> (fn i => fn tac => fn st => Seq.INTERVAL tac i (Thm.nprems_of st) st) ||
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   236
  P.nat >> (fn i => fn tac => tac i) ||
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   237
  $$$ "!" >> K ALLGOALS;
8536
de307f5bc89a goal_spec;
wenzelm
parents: 8282
diff changeset
   238
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   239
val goal = $$$ "[" |-- P.!!! (from_to --| $$$ "]");
8536
de307f5bc89a goal_spec;
wenzelm
parents: 8282
diff changeset
   240
fun goal_spec def = Scan.lift (Scan.optional goal def);
8233
85169951d515 attrib: keyword_symid;
wenzelm
parents: 8089
diff changeset
   241
85169951d515 attrib: keyword_symid;
wenzelm
parents: 8089
diff changeset
   242
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   243
(* arguments within outer syntax *)
5878
769abc29bb8e several args parsers;
wenzelm
parents: 5822
diff changeset
   244
27382
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   245
fun parse_args is_symid =
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   246
  let
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   247
    val keyword_symid = token (P.keyword_with is_symid);
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   248
    fun atom blk = P.group "argument"
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   249
      (ident || keyword_symid || string || alt_string ||
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   250
        (if blk then token (P.$$$ ",") else Scan.fail));
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
   251
27382
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   252
    fun args blk x = Scan.optional (args1 blk) [] x
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   253
    and args1 blk x =
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   254
      ((Scan.repeat1
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   255
        (Scan.repeat1 (atom blk) ||
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   256
          argsp "(" ")" ||
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   257
          argsp "[" "]")) >> flat) x
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   258
    and argsp l r x = (token (P.$$$ l) ::: P.!!! (args true @@@ (token (P.$$$ r) >> single))) x;
27382
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   259
  in (args, args1) end;
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   260
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   261
val parse = #1 (parse_args T.ident_or_symbolic) false;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   262
fun parse1 is_symid = #2 (parse_args is_symid) false;
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
   263
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   264
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   265
(* attributes *)
27382
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   266
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   267
fun attribs intern =
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   268
  let
27819
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   269
    val attrib_name = internal_text || (symbolic || named)
6398f7aabdfc pass token source to typ/term etc.;
wenzelm
parents: 27811
diff changeset
   270
      >> evaluate T.Text (intern o T.content_of);
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   271
    val attrib = P.position (attrib_name -- P.!!! parse) >> src;
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   272
  in $$$ "[" |-- P.!!! (P.list attrib --| $$$ "]") end;
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   273
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   274
fun opt_attribs intern = Scan.optional (attribs intern) [];
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   275
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
   276
27377
0b9295c598f6 added thm_name, opt_thm_name;
wenzelm
parents: 27371
diff changeset
   277
(* theorem specifications *)
0b9295c598f6 added thm_name, opt_thm_name;
wenzelm
parents: 27371
diff changeset
   278
28078
0c420e7579a6 added binding;
wenzelm
parents: 27882
diff changeset
   279
fun thm_name intern s = binding -- opt_attribs intern --| $$$ s;
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   280
27377
0b9295c598f6 added thm_name, opt_thm_name;
wenzelm
parents: 27371
diff changeset
   281
fun opt_thm_name intern s =
28078
0c420e7579a6 added binding;
wenzelm
parents: 27882
diff changeset
   282
  Scan.optional
0c420e7579a6 added binding;
wenzelm
parents: 27882
diff changeset
   283
    ((binding -- opt_attribs intern || attribs intern >> pair Name.no_binding) --| $$$ s)
0c420e7579a6 added binding;
wenzelm
parents: 27882
diff changeset
   284
    (Name.no_binding, []);
27377
0b9295c598f6 added thm_name, opt_thm_name;
wenzelm
parents: 27371
diff changeset
   285
0b9295c598f6 added thm_name, opt_thm_name;
wenzelm
parents: 27371
diff changeset
   286
27382
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   287
b1285021424e tuned nested args parser;
wenzelm
parents: 27377
diff changeset
   288
(** syntax wrapper **)
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
   289
8282
58a33fd5b30c tuned syntax wrapper;
wenzelm
parents: 8233
diff changeset
   290
fun syntax kind scan (src as Src ((s, args), pos)) st =
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   291
  (case Scan.error (Scan.finite' T.stopper (Scan.option scan)) (st, args) of
21879
a3efbae45735 switched argument order in *.syntax lifters
haftmann
parents: 21724
diff changeset
   292
    (SOME x, (st', [])) => (x, st')
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   293
  | (_, (_, args')) =>
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   294
      error (kind ^ " " ^ quote s ^ Position.str_of pos ^ ": bad arguments\n  " ^
27811
44bc67675210 unified Args.T with OuterLex.token;
wenzelm
parents: 27732
diff changeset
   295
        space_implode " " (map T.unparse args')));
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15596
diff changeset
   296
21879
a3efbae45735 switched argument order in *.syntax lifters
haftmann
parents: 21724
diff changeset
   297
fun context_syntax kind scan src = apsnd Context.the_proof o syntax kind scan src o Context.Proof;
18998
10c251f29847 Context.generic is canonical state of parsers;
wenzelm
parents: 18728
diff changeset
   298
5822
3f824514ad88 Concrete argument syntax (for attributes, methods etc.).
wenzelm
parents:
diff changeset
   299
end;