# HG changeset patch # User wenzelm # Date 1439749512 -7200 # Node ID b70c4db3874f733ee58ceba778ec7908db5394fe # Parent 35a3f66629ad788c75ccaeb93aa6683d97544a54 produce certified vars without access to theory_of_thm, and without context; diff -r 35a3f66629ad -r b70c4db3874f src/Pure/more_thm.ML --- a/src/Pure/more_thm.ML Sun Aug 16 19:44:21 2015 +0200 +++ b/src/Pure/more_thm.ML Sun Aug 16 20:25:12 2015 +0200 @@ -314,28 +314,39 @@ local -fun forall_elim_vars_aux vars i th = +fun dest_all ct = + (case Thm.term_of ct of + Const ("Pure.all", _) $ Abs (a, _, _) => + let val (x, ct') = Thm.dest_abs NONE (Thm.dest_arg ct) + in SOME ((a, Thm.ctyp_of_cterm x), ct') end + | _ => NONE); + +fun dest_all_list ct = + (case dest_all ct of + NONE => [] + | SOME (v, ct') => v :: dest_all_list ct'); + +fun forall_elim_vars_list vars i th = let - val thy = Thm.theory_of_thm th; val used = (Thm.fold_terms o Term.fold_aterms) (fn Var ((x, j), _) => if i = j then insert (op =) x else I | _ => I) th []; - val cvars = (Name.variant_list used (map #1 vars), vars) - |> ListPair.map (fn (x, (_, T)) => Thm.global_cterm_of thy (Var ((x, i), T))); - in fold Thm.forall_elim cvars th end; + val vars' = (Name.variant_list used (map #1 vars), vars) + |> ListPair.map (fn (x, (_, T)) => Thm.var ((x, i), T)); + in fold Thm.forall_elim vars' th end; in fun forall_elim_vars i th = - forall_elim_vars_aux (Term.strip_all_vars (Thm.prop_of th)) i th; + forall_elim_vars_list (dest_all_list (Thm.cprop_of th)) i th; fun forall_elim_var i th = let val vars = - (case Thm.prop_of th of - Const ("Pure.all", _) $ Abs (a, T, _) => [(a, T)] - | _ => raise THM ("forall_elim_vars", i, [th])); - in forall_elim_vars_aux vars i th end; + (case dest_all (Thm.cprop_of th) of + SOME (v, _) => [v] + | NONE => raise THM ("forall_elim_var", i, [th])); + in forall_elim_vars_list vars i th end; end; diff -r 35a3f66629ad -r b70c4db3874f src/Pure/thm.ML --- a/src/Pure/thm.ML Sun Aug 16 19:44:21 2015 +0200 +++ b/src/Pure/thm.ML Sun Aug 16 20:25:12 2015 +0200 @@ -40,6 +40,7 @@ val dest_fun2: cterm -> cterm val dest_arg1: cterm -> cterm val dest_abs: string option -> cterm -> cterm * cterm + val var: indexname * ctyp -> cterm val apply: cterm -> cterm -> cterm val lambda_name: string * cterm -> cterm -> cterm val lambda: cterm -> cterm -> cterm @@ -254,6 +255,10 @@ (* constructors *) +fun var ((x, i), Ctyp {thy, T, maxidx, sorts}) = + if i < 0 then raise TERM ("var: bad index", [Var ((x, i), T)]) + else Cterm {thy = thy, t = Var ((x, i), T), T = T, maxidx = Int.max (i, maxidx), sorts = sorts}; + fun apply (cf as Cterm {t = f, T = Type ("fun", [dty, rty]), maxidx = maxidx1, sorts = sorts1, ...}) (cx as Cterm {t = x, T, maxidx = maxidx2, sorts = sorts2, ...}) =