88 val add_modesyntax: Syntax.mode -> (string * string * mixfix) list -> theory -> theory |
88 val add_modesyntax: Syntax.mode -> (string * string * mixfix) list -> theory -> theory |
89 val add_modesyntax_i: Syntax.mode -> (string * typ * mixfix) list -> theory -> theory |
89 val add_modesyntax_i: Syntax.mode -> (string * typ * mixfix) list -> theory -> theory |
90 val del_modesyntax: Syntax.mode -> (string * string * mixfix) list -> theory -> theory |
90 val del_modesyntax: Syntax.mode -> (string * string * mixfix) list -> theory -> theory |
91 val del_modesyntax_i: Syntax.mode -> (string * typ * mixfix) list -> theory -> theory |
91 val del_modesyntax_i: Syntax.mode -> (string * typ * mixfix) list -> theory -> theory |
92 val notation: bool -> Syntax.mode -> (term * mixfix) list -> theory -> theory |
92 val notation: bool -> Syntax.mode -> (term * mixfix) list -> theory -> theory |
93 val declare_const: Properties.T -> (binding * typ) * mixfix -> theory -> term * theory |
93 val declare_const: (binding * typ) * mixfix -> theory -> term * theory |
94 val add_consts: (binding * string * mixfix) list -> theory -> theory |
94 val add_consts: (binding * string * mixfix) list -> theory -> theory |
95 val add_consts_i: (binding * typ * mixfix) list -> theory -> theory |
95 val add_consts_i: (binding * typ * mixfix) list -> theory -> theory |
96 val add_abbrev: string -> Properties.T -> binding * term -> theory -> (term * term) * theory |
96 val add_abbrev: string -> binding * term -> theory -> (term * term) * theory |
97 val revert_abbrev: string -> string -> theory -> theory |
97 val revert_abbrev: string -> string -> theory -> theory |
98 val add_const_constraint: string * typ option -> theory -> theory |
98 val add_const_constraint: string * typ option -> theory -> theory |
99 val primitive_class: binding * class list -> theory -> theory |
99 val primitive_class: binding * class list -> theory -> theory |
100 val primitive_classrel: class * class -> theory -> theory |
100 val primitive_classrel: class * class -> theory -> theory |
101 val primitive_arity: arity -> theory -> theory |
101 val primitive_arity: arity -> theory -> theory |
432 |
432 |
433 fun add_types types thy = thy |> map_sign (fn (naming, syn, tsig, consts) => |
433 fun add_types types thy = thy |> map_sign (fn (naming, syn, tsig, consts) => |
434 let |
434 let |
435 val syn' = Syntax.update_type_gram (map (fn (a, n, mx) => (Name.of_binding a, n, mx)) types) syn; |
435 val syn' = Syntax.update_type_gram (map (fn (a, n, mx) => (Name.of_binding a, n, mx)) types) syn; |
436 val decls = map (fn (a, n, mx) => (Binding.map_name (Syntax.type_name mx) a, n)) types; |
436 val decls = map (fn (a, n, mx) => (Binding.map_name (Syntax.type_name mx) a, n)) types; |
437 val tsig' = fold (Type.add_type naming []) decls tsig; |
437 val tsig' = fold (Type.add_type naming) decls tsig; |
438 in (naming, syn', tsig', consts) end); |
438 in (naming, syn', tsig', consts) end); |
439 |
439 |
440 |
440 |
441 (* add nonterminals *) |
441 (* add nonterminals *) |
442 |
442 |
443 fun add_nonterminals ns thy = thy |> map_sign (fn (naming, syn, tsig, consts) => |
443 fun add_nonterminals ns thy = thy |> map_sign (fn (naming, syn, tsig, consts) => |
444 let |
444 let |
445 val syn' = Syntax.update_consts (map Name.of_binding ns) syn; |
445 val syn' = Syntax.update_consts (map Name.of_binding ns) syn; |
446 val tsig' = fold (Type.add_nonterminal naming []) ns tsig; |
446 val tsig' = fold (Type.add_nonterminal naming) ns tsig; |
447 in (naming, syn', tsig', consts) end); |
447 in (naming, syn', tsig', consts) end); |
448 |
448 |
449 |
449 |
450 (* add type abbreviations *) |
450 (* add type abbreviations *) |
451 |
451 |
455 val ctxt = ProofContext.init thy; |
455 val ctxt = ProofContext.init thy; |
456 val syn' = Syntax.update_type_gram [(Name.of_binding a, length vs, mx)] syn; |
456 val syn' = Syntax.update_type_gram [(Name.of_binding a, length vs, mx)] syn; |
457 val b = Binding.map_name (Syntax.type_name mx) a; |
457 val b = Binding.map_name (Syntax.type_name mx) a; |
458 val abbr = (b, vs, certify_typ_mode Type.mode_syntax thy (parse_typ ctxt rhs)) |
458 val abbr = (b, vs, certify_typ_mode Type.mode_syntax thy (parse_typ ctxt rhs)) |
459 handle ERROR msg => cat_error msg ("in type abbreviation " ^ quote (Binding.str_of b)); |
459 handle ERROR msg => cat_error msg ("in type abbreviation " ^ quote (Binding.str_of b)); |
460 val tsig' = Type.add_abbrev naming [] abbr tsig; |
460 val tsig' = Type.add_abbrev naming abbr tsig; |
461 in (naming, syn', tsig', consts) end); |
461 in (naming, syn', tsig', consts) end); |
462 |
462 |
463 val add_tyabbrs = fold (gen_add_tyabbr Syntax.parse_typ); |
463 val add_tyabbrs = fold (gen_add_tyabbr Syntax.parse_typ); |
464 val add_tyabbrs_i = fold (gen_add_tyabbr (K I)); |
464 val add_tyabbrs_i = fold (gen_add_tyabbr (K I)); |
465 |
465 |
510 val T' = Logic.varifyT T; |
510 val T' = Logic.varifyT T; |
511 in ((b, T'), (c_syn, T', mx), Const (c, T)) end; |
511 in ((b, T'), (c_syn, T', mx), Const (c, T)) end; |
512 val args = map prep raw_args; |
512 val args = map prep raw_args; |
513 in |
513 in |
514 thy |
514 thy |
515 |> map_consts (fold (Consts.declare authentic (naming_of thy) tags o #1) args) |
515 |> map_consts (fold (Consts.declare authentic (naming_of thy) o #1) args) |
516 |> add_syntax_i (map #2 args) |
516 |> add_syntax_i (map #2 args) |
517 |> pair (map #3 args) |
517 |> pair (map #3 args) |
518 end; |
518 end; |
519 |
519 |
520 in |
520 in |
521 |
521 |
522 fun add_consts args = snd o gen_add_consts Syntax.parse_typ false [] args; |
522 fun add_consts args = snd o gen_add_consts Syntax.parse_typ false args; |
523 fun add_consts_i args = snd o gen_add_consts (K I) false [] args; |
523 fun add_consts_i args = snd o gen_add_consts (K I) false args; |
524 |
524 |
525 fun declare_const tags ((b, T), mx) thy = |
525 fun declare_const ((b, T), mx) thy = |
526 let |
526 let |
527 val pos = Binding.pos_of b; |
527 val pos = Binding.pos_of b; |
528 val ([const as Const (c, _)], thy') = gen_add_consts (K I) true tags [(b, T, mx)] thy; |
528 val ([const as Const (c, _)], thy') = gen_add_consts (K I) true [(b, T, mx)] thy; |
529 val _ = Position.report (Markup.const_decl c) pos; |
529 val _ = Position.report (Markup.const_decl c) pos; |
530 in (const, thy') end; |
530 in (const, thy') end; |
531 |
531 |
532 end; |
532 end; |
533 |
533 |
534 |
534 |
535 (* abbreviations *) |
535 (* abbreviations *) |
536 |
536 |
537 fun add_abbrev mode tags (b, raw_t) thy = |
537 fun add_abbrev mode (b, raw_t) thy = |
538 let |
538 let |
539 val pp = Syntax.pp_global thy; |
539 val pp = Syntax.pp_global thy; |
540 val prep_tm = no_frees pp o Term.no_dummy_patterns o cert_term_abbrev thy; |
540 val prep_tm = no_frees pp o Term.no_dummy_patterns o cert_term_abbrev thy; |
541 val t = (prep_tm raw_t handle TYPE (msg, _, _) => error msg | TERM (msg, _) => error msg) |
541 val t = (prep_tm raw_t handle TYPE (msg, _, _) => error msg | TERM (msg, _) => error msg) |
542 handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.str_of b)); |
542 handle ERROR msg => cat_error msg ("in constant abbreviation " ^ quote (Binding.str_of b)); |
543 val (res, consts') = consts_of thy |
543 val (res, consts') = consts_of thy |
544 |> Consts.abbreviate pp (tsig_of thy) (naming_of thy) mode tags (b, t); |
544 |> Consts.abbreviate pp (tsig_of thy) (naming_of thy) mode (b, t); |
545 in (res, thy |> map_consts (K consts')) end; |
545 in (res, thy |> map_consts (K consts')) end; |
546 |
546 |
547 fun revert_abbrev mode c = map_consts (Consts.revert_abbrev mode c); |
547 fun revert_abbrev mode c = map_consts (Consts.revert_abbrev mode c); |
548 |
548 |
549 |
549 |