# HG changeset patch # User wenzelm # Date 1138727971 -3600 # Node ID ddb6803da1974ad929bbf88d49b8eba6f53e01b1 # Parent 853fa34047a46f73c5418ea89d6a9f0b65cf22d0 added consts_retricted; pretty/print_consts: parameter restriction; diff -r 853fa34047a4 -r ddb6803da197 src/Pure/Isar/local_theory.ML --- a/src/Pure/Isar/local_theory.ML Tue Jan 31 18:19:30 2006 +0100 +++ b/src/Pure/Isar/local_theory.ML Tue Jan 31 18:19:31 2006 +0100 @@ -10,14 +10,16 @@ val params_of: Proof.context -> (string * typ) list val hyps_of: Proof.context -> term list val standard: Proof.context -> thm -> thm - val pretty_consts: Proof.context -> (string * typ) list -> Pretty.T - val print_consts: Proof.context -> (string * typ) list -> unit + val pretty_consts: Proof.context -> (string * typ -> bool) -> (string * typ) list -> Pretty.T + val print_consts: Proof.context -> (string * typ -> bool) -> (string * typ) list -> unit val theory: (theory -> theory) -> Proof.context -> Proof.context val theory_result: (theory -> 'a * theory) -> Proof.context -> 'a * Proof.context val init: xstring option -> theory -> Proof.context val init_i: string option -> theory -> Proof.context val exit: Proof.context -> Proof.context * theory val consts: ((bstring * typ) * mixfix) list -> Proof.context -> term list * Proof.context + val consts_restricted: (string * typ -> bool) -> + ((bstring * typ) * mixfix) list -> Proof.context -> term list * Proof.context val axioms: ((bstring * Attrib.src list) * term list) list -> Proof.context -> (bstring * thm list) list * Proof.context val axioms_finish: (Proof.context -> thm -> thm) -> @@ -41,7 +43,7 @@ structure Data = ProofDataFun ( - val name = "Isar/local_theory"; + val name = "Pure/local_theory"; type T = {locale: (string * (cterm list * Proof.context)) option, params: (string * typ) list, @@ -79,13 +81,13 @@ in -fun pretty_consts ctxt cs = - (case params_of ctxt of +fun pretty_consts ctxt pred cs = + (case filter pred (params_of ctxt) of [] => pretty_vars ctxt "constants" cs | ps => Pretty.chunks [pretty_vars ctxt "parameters" ps, pretty_vars ctxt "constants" cs]); -fun print_consts _ [] = () - | print_consts ctxt cs = Pretty.writeln (pretty_consts ctxt cs); +fun print_consts _ _ [] = () + | print_consts ctxt pred cs = Pretty.writeln (pretty_consts ctxt pred cs); end; @@ -135,10 +137,10 @@ (* consts *) -fun consts decls ctxt = +fun consts_restricted pred decls ctxt = let val thy = ProofContext.theory_of ctxt; - val params = params_of ctxt; + val params = filter pred (params_of ctxt); val ps = map Free params; val Ps = map #2 params; in @@ -148,6 +150,8 @@ Term.list_comb (Const (Sign.full_name thy c, Ps ---> T), ps))) end; +val consts = consts_restricted (K true); + (* fact definitions *) @@ -223,9 +227,10 @@ val (x, mx) = var; val ((name, atts), rhs) = spec; val name' = if name = "" then Thm.def_name x else name; + val rhs_frees = Term.add_frees rhs []; in ctxt - |> consts [((x, Term.fastype_of rhs), mx)] + |> consts_restricted (member (op =) rhs_frees) [((x, Term.fastype_of rhs), mx)] |-> (fn [lhs] => theory_result (add_def (name', Logic.mk_equals (lhs, rhs))) #-> (fn th => fn ctxt' => note ((name', atts), [finish ctxt' lhs th]) ctxt')