src/Pure/sign.ML
changeset 26667 660b69b3c28a
parent 26637 0bfccafc52eb
child 26701 341c4d51d1c2
equal deleted inserted replaced
26666:433b165b0a8c 26667:660b69b3c28a
     3     Author:     Lawrence C Paulson and Markus Wenzel
     3     Author:     Lawrence C Paulson and Markus Wenzel
     4 
     4 
     5 Logical signature content: naming conventions, concrete syntax, type
     5 Logical signature content: naming conventions, concrete syntax, type
     6 signature, polymorphic constants.
     6 signature, polymorphic constants.
     7 *)
     7 *)
     8 
       
     9 signature SIGN_THEORY =
       
    10 sig
       
    11   val add_defsort: string -> theory -> theory
       
    12   val add_defsort_i: sort -> theory -> theory
       
    13   val add_types: (bstring * int * mixfix) list -> theory -> theory
       
    14   val add_nonterminals: bstring list -> theory -> theory
       
    15   val add_tyabbrs: (bstring * string list * string * mixfix) list -> theory -> theory
       
    16   val add_tyabbrs_i: (bstring * string list * typ * mixfix) list -> theory -> theory
       
    17   val add_syntax: (bstring * string * mixfix) list -> theory -> theory
       
    18   val add_syntax_i: (bstring * typ * mixfix) list -> theory -> theory
       
    19   val add_modesyntax: Syntax.mode -> (bstring * string * mixfix) list -> theory -> theory
       
    20   val add_modesyntax_i: Syntax.mode -> (bstring * typ * mixfix) list -> theory -> theory
       
    21   val del_modesyntax: Syntax.mode -> (bstring * string * mixfix) list -> theory -> theory
       
    22   val del_modesyntax_i: Syntax.mode -> (bstring * typ * mixfix) list -> theory -> theory
       
    23   val add_consts: (bstring * string * mixfix) list -> theory -> theory
       
    24   val add_consts_i: (bstring * typ * mixfix) list -> theory -> theory
       
    25   val add_trfuns:
       
    26     (string * (ast list -> ast)) list *
       
    27     (string * (term list -> term)) list *
       
    28     (string * (term list -> term)) list *
       
    29     (string * (ast list -> ast)) list -> theory -> theory
       
    30   val add_trfunsT:
       
    31     (string * (bool -> typ -> term list -> term)) list -> theory -> theory
       
    32   val add_advanced_trfuns:
       
    33     (string * (Proof.context -> ast list -> ast)) list *
       
    34     (string * (Proof.context -> term list -> term)) list *
       
    35     (string * (Proof.context -> term list -> term)) list *
       
    36     (string * (Proof.context -> ast list -> ast)) list -> theory -> theory
       
    37   val add_advanced_trfunsT:
       
    38     (string * (Proof.context -> bool -> typ -> term list -> term)) list -> theory -> theory
       
    39   val add_tokentrfuns:
       
    40     (string * string * (string -> output * int)) list -> theory -> theory
       
    41   val add_mode_tokentrfuns: string -> (string * (string -> output * int)) list
       
    42     -> theory -> theory
       
    43   val add_trrules: (xstring * string) Syntax.trrule list -> theory -> theory
       
    44   val del_trrules: (xstring * string) Syntax.trrule list -> theory -> theory
       
    45   val add_trrules_i: ast Syntax.trrule list -> theory -> theory
       
    46   val del_trrules_i: ast Syntax.trrule list -> theory -> theory
       
    47   val add_path: string -> theory -> theory
       
    48   val parent_path: theory -> theory
       
    49   val root_path: theory -> theory
       
    50   val absolute_path: theory -> theory
       
    51   val local_path: theory -> theory
       
    52   val no_base_names: theory -> theory
       
    53   val qualified_names: theory -> theory
       
    54   val sticky_prefix: string -> theory -> theory
       
    55   val restore_naming: theory -> theory -> theory
       
    56 end
       
    57 
     8 
    58 signature SIGN =
     9 signature SIGN =
    59 sig
    10 sig
    60   val rep_sg: theory ->
    11   val rep_sg: theory ->
    61    {naming: NameSpace.naming,
    12    {naming: NameSpace.naming,
   144     theory * (indexname -> typ option) * (indexname -> sort option) ->
    95     theory * (indexname -> typ option) * (indexname -> sort option) ->
   145     string list -> bool -> (string * typ) list -> term list * (indexname * typ) list
    96     string list -> bool -> (string * typ) list -> term list * (indexname * typ) list
   146   val simple_read_term: theory -> typ -> string -> term
    97   val simple_read_term: theory -> typ -> string -> term
   147   val read_term: theory -> string -> term
    98   val read_term: theory -> string -> term
   148   val read_prop: theory -> string -> term
    99   val read_prop: theory -> string -> term
       
   100   val add_defsort: string -> theory -> theory
       
   101   val add_defsort_i: sort -> theory -> theory
       
   102   val add_types: (bstring * int * mixfix) list -> theory -> theory
       
   103   val add_nonterminals: bstring list -> theory -> theory
       
   104   val add_tyabbrs: (bstring * string list * string * mixfix) list -> theory -> theory
       
   105   val add_tyabbrs_i: (bstring * string list * typ * mixfix) list -> theory -> theory
       
   106   val add_syntax: (bstring * string * mixfix) list -> theory -> theory
       
   107   val add_syntax_i: (bstring * typ * mixfix) list -> theory -> theory
       
   108   val add_modesyntax: Syntax.mode -> (bstring * string * mixfix) list -> theory -> theory
       
   109   val add_modesyntax_i: Syntax.mode -> (bstring * typ * mixfix) list -> theory -> theory
       
   110   val del_modesyntax: Syntax.mode -> (bstring * string * mixfix) list -> theory -> theory
       
   111   val del_modesyntax_i: Syntax.mode -> (bstring * typ * mixfix) list -> theory -> theory
       
   112   val notation: bool -> Syntax.mode -> (term * mixfix) list -> theory -> theory
       
   113   val add_consts: (bstring * string * mixfix) list -> theory -> theory
       
   114   val add_consts_i: (bstring * typ * mixfix) list -> theory -> theory
   149   val declare_const: Markup.property list -> bstring * typ * mixfix -> theory -> term * theory
   115   val declare_const: Markup.property list -> bstring * typ * mixfix -> theory -> term * theory
   150   val notation: bool -> Syntax.mode -> (term * mixfix) list -> theory -> theory
       
   151   val add_abbrev: string -> Markup.property list ->
   116   val add_abbrev: string -> Markup.property list ->
   152     bstring * term -> theory -> (term * term) * theory
   117     bstring * term -> theory -> (term * term) * theory
   153   val revert_abbrev: string -> string -> theory -> theory
   118   val revert_abbrev: string -> string -> theory -> theory
   154   include SIGN_THEORY
       
   155   val add_const_constraint: string * typ option -> theory -> theory
   119   val add_const_constraint: string * typ option -> theory -> theory
   156   val primitive_class: string * class list -> theory -> theory
   120   val primitive_class: string * class list -> theory -> theory
   157   val primitive_classrel: class * class -> theory -> theory
   121   val primitive_classrel: class * class -> theory -> theory
   158   val primitive_arity: arity -> theory -> theory
   122   val primitive_arity: arity -> theory -> theory
   159   val hide_classes: bool -> xstring list -> theory -> theory
   123   val add_trfuns:
   160   val hide_classes_i: bool -> string list -> theory -> theory
   124     (string * (ast list -> ast)) list *
   161   val hide_types: bool -> xstring list -> theory -> theory
   125     (string * (term list -> term)) list *
   162   val hide_types_i: bool -> string list -> theory -> theory
   126     (string * (term list -> term)) list *
   163   val hide_consts: bool -> xstring list -> theory -> theory
   127     (string * (ast list -> ast)) list -> theory -> theory
   164   val hide_consts_i: bool -> string list -> theory -> theory
   128   val add_trfunsT:
   165   val hide_names: bool -> string * xstring list -> theory -> theory
   129     (string * (bool -> typ -> term list -> term)) list -> theory -> theory
   166   val hide_names_i: bool -> string * string list -> theory -> theory
   130   val add_advanced_trfuns:
       
   131     (string * (Proof.context -> ast list -> ast)) list *
       
   132     (string * (Proof.context -> term list -> term)) list *
       
   133     (string * (Proof.context -> term list -> term)) list *
       
   134     (string * (Proof.context -> ast list -> ast)) list -> theory -> theory
       
   135   val add_advanced_trfunsT:
       
   136     (string * (Proof.context -> bool -> typ -> term list -> term)) list -> theory -> theory
       
   137   val add_tokentrfuns:
       
   138     (string * string * (string -> output * int)) list -> theory -> theory
       
   139   val add_mode_tokentrfuns: string -> (string * (string -> output * int)) list
       
   140     -> theory -> theory
       
   141   val add_trrules: (xstring * string) Syntax.trrule list -> theory -> theory
       
   142   val del_trrules: (xstring * string) Syntax.trrule list -> theory -> theory
       
   143   val add_trrules_i: ast Syntax.trrule list -> theory -> theory
       
   144   val del_trrules_i: ast Syntax.trrule list -> theory -> theory
       
   145   val add_path: string -> theory -> theory
       
   146   val parent_path: theory -> theory
       
   147   val root_path: theory -> theory
       
   148   val absolute_path: theory -> theory
       
   149   val local_path: theory -> theory
       
   150   val no_base_names: theory -> theory
       
   151   val qualified_names: theory -> theory
       
   152   val sticky_prefix: string -> theory -> theory
       
   153   val restore_naming: theory -> theory -> theory
       
   154   val hide_class: bool -> string -> theory -> theory
       
   155   val hide_type: bool -> string -> theory -> theory
       
   156   val hide_const: bool -> string -> theory -> theory
   167 end
   157 end
   168 
   158 
   169 structure Sign: SIGN =
   159 structure Sign: SIGN =
   170 struct
   160 struct
   171 
   161 
   750 val del_trrules = gen_trrules Syntax.remove_trrules;
   740 val del_trrules = gen_trrules Syntax.remove_trrules;
   751 val add_trrules_i = map_syn o Syntax.update_trrules_i;
   741 val add_trrules_i = map_syn o Syntax.update_trrules_i;
   752 val del_trrules_i = map_syn o Syntax.remove_trrules_i;
   742 val del_trrules_i = map_syn o Syntax.remove_trrules_i;
   753 
   743 
   754 
   744 
   755 (* modify naming *)
   745 (* naming *)
   756 
   746 
   757 val add_path        = map_naming o NameSpace.add_path;
   747 val add_path        = map_naming o NameSpace.add_path;
   758 val no_base_names   = map_naming NameSpace.no_base_names;
   748 val no_base_names   = map_naming NameSpace.no_base_names;
   759 val qualified_names = map_naming NameSpace.qualified_names;
   749 val qualified_names = map_naming NameSpace.qualified_names;
   760 val sticky_prefix   = map_naming o NameSpace.sticky_prefix;
   750 val sticky_prefix   = map_naming o NameSpace.sticky_prefix;
   767 fun local_path thy = thy |> root_path |> add_path (Context.theory_name thy);
   757 fun local_path thy = thy |> root_path |> add_path (Context.theory_name thy);
   768 
   758 
   769 
   759 
   770 (* hide names *)
   760 (* hide names *)
   771 
   761 
   772 fun hide_classes b xs thy = thy |> map_tsig (Type.hide_classes b (map (intern_class thy) xs));
   762 val hide_class = map_tsig oo Type.hide_class;
   773 val hide_classes_i = map_tsig oo Type.hide_classes;
   763 val hide_type = map_tsig oo Type.hide_type;
   774 fun hide_types b xs thy = thy |> map_tsig (Type.hide_types b (map (intern_type thy) xs));
   764 val hide_const = map_consts oo Consts.hide;
   775 val hide_types_i = map_tsig oo Type.hide_types;
       
   776 fun hide_consts b xs thy = thy |> map_consts (fold (Consts.hide b o intern_const thy) xs);
       
   777 val hide_consts_i = map_consts oo (fold o Consts.hide);
       
   778 
       
   779 local
       
   780 
       
   781 val kinds =
       
   782  [("class", (intern_class, can o certify_class, hide_classes_i)),
       
   783   ("type", (intern_type, declared_tyname, hide_types_i)),
       
   784   ("const", (intern_const, declared_const, hide_consts_i))];
       
   785 
       
   786 fun gen_hide int b (kind, xnames) thy =
       
   787   (case AList.lookup (op =) kinds kind of
       
   788     SOME (intern, check, hide) =>
       
   789       let
       
   790         val names = if int then map (intern thy) xnames else xnames;
       
   791         val bads = filter_out (check thy) names;
       
   792       in
       
   793         if null bads then hide b names thy
       
   794         else error ("Attempt to hide undeclared item(s): " ^ commas_quote bads)
       
   795       end
       
   796   | NONE => error ("Bad name space specification: " ^ quote kind));
       
   797 
       
   798 in
       
   799 
       
   800 val hide_names = gen_hide true;
       
   801 val hide_names_i = gen_hide false;
       
   802 
   765 
   803 end;
   766 end;
   804 
       
   805 end;