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; |