src/Pure/more_thm.ML
changeset 70159 57503fe1b0ff
parent 70155 169d167554bd
child 70404 9dc99e3153b3
equal deleted inserted replaced
70158:a3d5e561e18a 70159:57503fe1b0ff
    26   val eq_ctyp: ctyp * ctyp -> bool
    26   val eq_ctyp: ctyp * ctyp -> bool
    27   val aconvc: cterm * cterm -> bool
    27   val aconvc: cterm * cterm -> bool
    28   val add_tvars: thm -> ctyp list -> ctyp list
    28   val add_tvars: thm -> ctyp list -> ctyp list
    29   val add_frees: thm -> cterm list -> cterm list
    29   val add_frees: thm -> cterm list -> cterm list
    30   val add_vars: thm -> cterm list -> cterm list
    30   val add_vars: thm -> cterm list -> cterm list
    31   val dest_ctyp_fun: ctyp -> ctyp * ctyp
    31   val dest_funT: ctyp -> ctyp * ctyp
    32   val strip_type: ctyp -> ctyp list * ctyp
    32   val strip_type: ctyp -> ctyp list * ctyp
    33   val all_name: Proof.context -> string * cterm -> cterm -> cterm
    33   val all_name: Proof.context -> string * cterm -> cterm -> cterm
    34   val all: Proof.context -> cterm -> cterm -> cterm
    34   val all: Proof.context -> cterm -> cterm -> cterm
    35   val mk_binop: cterm -> cterm -> cterm -> cterm
    35   val mk_binop: cterm -> cterm -> cterm -> cterm
    36   val dest_binop: cterm -> cterm * cterm
    36   val dest_binop: cterm -> cterm * cterm
   144 val add_vars = Thm.fold_atomic_cterms (fn a => is_Var (Thm.term_of a) ? insert (op aconvc) a);
   144 val add_vars = Thm.fold_atomic_cterms (fn a => is_Var (Thm.term_of a) ? insert (op aconvc) a);
   145 
   145 
   146 
   146 
   147 (* ctyp operations *)
   147 (* ctyp operations *)
   148 
   148 
   149 fun dest_ctyp_fun cT =
   149 fun dest_funT cT =
   150   (case Thm.typ_of cT of
   150   (case Thm.typ_of cT of
   151     Type ("fun", _) => let val [A, B] = Thm.dest_ctyp cT in (A, B) end
   151     Type ("fun", _) => let val [A, B] = Thm.dest_ctyp cT in (A, B) end
   152   | T => raise TYPE ("dest_ctyp_fun", [T], []));
   152   | T => raise TYPE ("dest_funT", [T], []));
   153 
   153 
   154 (* ctyp version of strip_type: maps  [T1,...,Tn]--->T  to   ([T1,T2,...,Tn], T) *)
   154 (* ctyp version of strip_type: maps  [T1,...,Tn]--->T  to   ([T1,T2,...,Tn], T) *)
   155 fun strip_type cT =
   155 fun strip_type cT =
   156   (case Thm.typ_of cT of
   156   (case Thm.typ_of cT of
   157     Type ("fun", _) =>
   157     Type ("fun", _) =>
   158       let
   158       let
   159         val (cT1, cT2) = dest_ctyp_fun cT;
   159         val (cT1, cT2) = dest_funT cT;
   160         val (cTs, cT') = strip_type cT2
   160         val (cTs, cT') = strip_type cT2
   161       in (cT1 :: cTs, cT') end
   161       in (cT1 :: cTs, cT') end
   162   | _ => ([], cT));
   162   | _ => ([], cT));
   163 
   163 
   164 
   164