src/Pure/Isar/local_syntax.ML
author wenzelm
Wed, 10 Oct 2007 17:31:59 +0200
changeset 24951 834b8c2b9553
parent 20785 d60f81c56fd4
child 24954 0664f10a4094
permissions -rw-r--r--
replaced add_modesyntax by general update_modesyntax (add or del); tuned;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Isar/local_syntax.ML
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     3
    Author:     Makarius
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     4
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     5
Local syntax depending on theory syntax.
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     6
*)
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     7
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     8
val show_structs = ref false;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
     9
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    10
signature LOCAL_SYNTAX =
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    11
sig
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    12
  type T
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    13
  val syn_of: T -> Syntax.syntax
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    14
  val structs_of: T -> string list
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    15
  val init: theory -> T
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    16
  val rebuild: theory -> T -> T
19660
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
    17
  val add_syntax: theory -> (bool * (string * typ * mixfix)) list -> T -> T
20785
d60f81c56fd4 Syntax.mode;
wenzelm
parents: 19660
diff changeset
    18
  val set_mode: Syntax.mode -> T -> T
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    19
  val restore_mode: T -> T -> T
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    20
  val update_modesyntax: theory -> bool -> Syntax.mode ->
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    21
    (bool * (string * typ * mixfix)) list -> T -> T
19369
a4374b41c9bf simplified handling of authentic syntax (cf. early externing in consts.ML);
wenzelm
parents: 19016
diff changeset
    22
  val extern_term: T -> term -> term
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    23
end;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    24
19016
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
    25
structure LocalSyntax: LOCAL_SYNTAX =
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    26
struct
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    27
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    28
(* datatype T *)
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    29
19386
38d83ffd6217 add_syntax: actually observe print mode;
wenzelm
parents: 19369
diff changeset
    30
type local_mixfix =
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    31
  (string * bool) *                                    (*name, fixed?*)
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    32
  ((bool * Syntax.mode) * (string * typ * mixfix));    (*add?, mode, declaration*)
19386
38d83ffd6217 add_syntax: actually observe print mode;
wenzelm
parents: 19369
diff changeset
    33
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    34
datatype T = Syntax of
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    35
 {thy_syntax: Syntax.syntax,
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    36
  local_syntax: Syntax.syntax,
20785
d60f81c56fd4 Syntax.mode;
wenzelm
parents: 19660
diff changeset
    37
  mode: Syntax.mode,
19386
38d83ffd6217 add_syntax: actually observe print mode;
wenzelm
parents: 19369
diff changeset
    38
  mixfixes: local_mixfix list,
19369
a4374b41c9bf simplified handling of authentic syntax (cf. early externing in consts.ML);
wenzelm
parents: 19016
diff changeset
    39
  idents: string list * string list};
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    40
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    41
fun make_syntax (thy_syntax, local_syntax, mode, mixfixes, idents) =
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    42
  Syntax {thy_syntax = thy_syntax, local_syntax = local_syntax,
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    43
    mode = mode, mixfixes = mixfixes, idents = idents};
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    44
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    45
fun map_syntax f (Syntax {thy_syntax, local_syntax, mode, mixfixes, idents}) =
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    46
  make_syntax (f (thy_syntax, local_syntax, mode, mixfixes, idents));
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    47
19369
a4374b41c9bf simplified handling of authentic syntax (cf. early externing in consts.ML);
wenzelm
parents: 19016
diff changeset
    48
fun is_consistent thy (Syntax {thy_syntax, ...}) =
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    49
  Syntax.eq_syntax (Sign.syn_of thy, thy_syntax);
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    50
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    51
fun syn_of (Syntax {local_syntax, ...}) = local_syntax;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    52
fun idents_of (Syntax {idents, ...}) = idents;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    53
val structs_of = #1 o idents_of;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    54
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    55
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    56
(* build syntax *)
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    57
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    58
fun build_syntax thy mode mixfixes (idents as (structs, _)) =
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    59
  let
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    60
    val thy_syntax = Sign.syn_of thy;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    61
    val is_logtype = Sign.is_logtype thy;
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    62
    fun const_gram ((true, m), decls) = Syntax.extend_const_gram is_logtype m decls
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    63
      | const_gram ((false, m), decls) = Syntax.remove_const_gram is_logtype m decls;
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    64
    val (atrs, trs, trs', atrs') = Syntax.struct_trfuns structs;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    65
    val local_syntax = thy_syntax
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    66
      |> Syntax.extend_trfuns
19386
38d83ffd6217 add_syntax: actually observe print mode;
wenzelm
parents: 19369
diff changeset
    67
          (map Syntax.mk_trfun atrs, map Syntax.mk_trfun trs,
38d83ffd6217 add_syntax: actually observe print mode;
wenzelm
parents: 19369
diff changeset
    68
           map Syntax.mk_trfun trs', map Syntax.mk_trfun atrs')
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    69
      |> fold const_gram (AList.coalesce (op =) (rev (map snd mixfixes)));
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    70
  in make_syntax (thy_syntax, local_syntax, mode, mixfixes, idents) end;
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    71
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    72
fun init thy = build_syntax thy Syntax.default_mode [] ([], []);
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    73
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    74
fun rebuild thy (syntax as Syntax {mode, mixfixes, idents, ...}) =
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    75
  if is_consistent thy syntax then syntax
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    76
  else build_syntax thy mode mixfixes idents;
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    77
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
    78
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    79
(* mixfix declarations *)
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    80
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    81
local
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    82
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    83
fun prep_mixfix _ (_, (_, _, Structure)) = NONE
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    84
  | prep_mixfix mode (fixed, (x, T, mx)) =
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    85
      let val c = if fixed then Syntax.fixedN ^ x else x
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    86
      in SOME ((x, fixed), (mode, (c, T, mx))) end;
19016
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
    87
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
    88
fun prep_struct (fixed, (c, _, Structure)) =
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
    89
      if fixed then SOME c
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    90
      else error ("Bad mixfix declaration for constant: " ^ quote c)
19016
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
    91
  | prep_struct _ = NONE;
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    92
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    93
in
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
    94
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    95
fun update_syntax add thy raw_decls
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    96
    (syntax as (Syntax {mode, mixfixes, idents = (structs, _), ...})) =
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
    97
  (case filter_out (fn (_, (_, _, mx)) => mx = NoSyn) raw_decls of
19016
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
    98
    [] => syntax
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
    99
  | decls =>
f26377a4605a tuned mixfixes, mixfix_conflict;
wenzelm
parents: 18997
diff changeset
   100
      let
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
   101
        val mixfixes' = rev (map_filter (prep_mixfix (add, mode)) decls) @ mixfixes;
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
   102
        val structs' = structs @ map_filter prep_struct decls;
20785
d60f81c56fd4 Syntax.mode;
wenzelm
parents: 19660
diff changeset
   103
        val fixes' = fold (fn ((x, true), _) => cons x | _ => I) mixfixes' [];
19541
1bb8e26a26ee maintain implicit syntax mode;
wenzelm
parents: 19482
diff changeset
   104
      in build_syntax thy mode mixfixes' (structs', fixes') end);
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   105
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
   106
val add_syntax = update_syntax true;
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
   107
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   108
end;
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   109
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   110
19660
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   111
(* syntax mode *)
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   112
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   113
fun set_mode mode = map_syntax (fn (thy_syntax, local_syntax, _, mixfixes, idents) =>
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   114
  (thy_syntax, local_syntax, mode, mixfixes, idents));
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   115
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   116
fun restore_mode (Syntax {mode, ...}) = set_mode mode;
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   117
24951
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
   118
fun update_modesyntax thy add mode args syntax =
834b8c2b9553 replaced add_modesyntax by general update_modesyntax (add or del);
wenzelm
parents: 20785
diff changeset
   119
  syntax |> set_mode mode |> update_syntax add thy args |> restore_mode syntax;
19660
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   120
e3ec6839c631 added add_modesyntax;
wenzelm
parents: 19618
diff changeset
   121
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   122
(* extern_term *)
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   123
19369
a4374b41c9bf simplified handling of authentic syntax (cf. early externing in consts.ML);
wenzelm
parents: 19016
diff changeset
   124
fun extern_term syntax =
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   125
  let
19369
a4374b41c9bf simplified handling of authentic syntax (cf. early externing in consts.ML);
wenzelm
parents: 19016
diff changeset
   126
    val (structs, fixes) = idents_of syntax;
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   127
    fun map_free (t as Free (x, T)) =
19618
wenzelm
parents: 19541
diff changeset
   128
          let val i = find_index (fn s => s = x) structs + 1 in
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   129
            if i = 0 andalso member (op =) fixes x then
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   130
              Const (Syntax.fixedN ^ x, T)
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   131
            else if i = 1 andalso not (! show_structs) then
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   132
              Syntax.const "_struct" $ Syntax.const "_indexdefault"
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   133
            else t
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   134
          end
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   135
      | map_free t = t;
19369
a4374b41c9bf simplified handling of authentic syntax (cf. early externing in consts.ML);
wenzelm
parents: 19016
diff changeset
   136
  in Term.map_aterms map_free end;
18997
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   137
3229c88bbbdf Local syntax depending on theory syntax.
wenzelm
parents:
diff changeset
   138
end;