src/Pure/term.ML
changeset 20122 27255556b762
parent 20116 f2aecd6e58ec
child 20129 95e84d2c9f2c
equal deleted inserted replaced
20121:848fc1a1d355 20122:27255556b762
   814 
   814 
   815 (*unfolding abstractions with substitution
   815 (*unfolding abstractions with substitution
   816   of bound variables and implicit eta-expansion*)
   816   of bound variables and implicit eta-expansion*)
   817 fun strip_abs_eta k t =
   817 fun strip_abs_eta k t =
   818   let
   818   let
   819     val used = fold_aterms (fn Free (v, _) => cons v | _ => I) t [];
   819     val used = fold_aterms (fn Free (v, _) => Name.declare v | _ => I) t Name.context;
   820     fun strip_abs t (0, used) = (([], t), (0, used))
   820     fun strip_abs t (0, used) = (([], t), (0, used))
   821       | strip_abs (Abs (v, T, t)) (k, used) =
   821       | strip_abs (Abs (v, T, t)) (k, used) =
   822           let
   822           let
   823             val v' = Name.variant used v;
   823             val ([v'], used') = Name.variants [v] used;
   824             val t' = subst_bound (Free (v, T), t);
   824             val t' = subst_bound (Free (v, T), t);
   825             val ((vs, t''), (k', used')) = strip_abs t' (k - 1, v' :: used);
   825             val ((vs, t''), (k', used'')) = strip_abs t' (k - 1, used');
   826           in (((v', T) :: vs, t''), (k', used')) end
   826           in (((v', T) :: vs, t''), (k', used'')) end
   827       | strip_abs t (k, used) = (([], t), (k, used));
   827       | strip_abs t (k, used) = (([], t), (k, used));
   828     fun expand_eta [] t _ = ([], t)
   828     fun expand_eta [] t _ = ([], t)
   829       | expand_eta (T::Ts) t used =
   829       | expand_eta (T::Ts) t used =
   830           let
   830           let
   831             val v = hd (Name.invent_list used "a" 1)
   831             val ([v], used') = Name.variants [""] used;
   832             val (vs, t') = expand_eta Ts (t $ Free (v, T)) (v :: used);
   832             val (vs, t') = expand_eta Ts (t $ Free (v, T)) used';
   833           in ((v, T) :: vs, t') end;
   833           in ((v, T) :: vs, t') end;
   834     val ((vs1, t'), (k', used')) = strip_abs t (k, used);
   834     val ((vs1, t'), (k', used')) = strip_abs t (k, used);
   835     val Ts = (fst o chop k' o fst o strip_type o fastype_of) t';
   835     val Ts = (fst o chop k' o fst o strip_type o fastype_of) t';
   836     val (vs2, t'') = expand_eta Ts t' used';
   836     val (vs2, t'') = expand_eta Ts t' used';
   837   in (vs1 @ vs2, t'') end;
   837   in (vs1 @ vs2, t'') end;