handle nested tuples in 'let's
authorblanchet
Thu, 17 Oct 2013 18:53:00 +0200
changeset 55589e475d86ab2ca
parent 55588 c206cb2a3afe
child 55590 c7119e1cde3e
handle nested tuples in 'let's
src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML
     1.1 --- a/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML	Thu Oct 17 16:45:54 2013 +0200
     1.2 +++ b/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML	Thu Oct 17 18:53:00 2013 +0200
     1.3 @@ -269,13 +269,17 @@
     1.4    end;
     1.5  
     1.6  fun unfold_let (Const (@{const_name Let}, _) $ arg1 $ arg2) = unfold_let (betapply (arg2, arg1))
     1.7 -  | unfold_let (Const (@{const_name prod_case}, _) $ (t as Abs (s1, T1, Abs (s2, T2, t'))) $ u) =
     1.8 -    let
     1.9 -      val x = (s1 ^ s2, Term.maxidx_of_term t + 1);
    1.10 -      val v = Var (x, HOLogic.mk_prodT (T1, T2));
    1.11 -    in
    1.12 -      unfold_let (Term.subst_Vars [(x, u)] (betapplys (t, [HOLogic.mk_fst v, HOLogic.mk_snd v])))
    1.13 -    end
    1.14 +  | unfold_let (Const (@{const_name prod_case}, _) $ t) =
    1.15 +    (case unfold_let t of
    1.16 +      t' as Abs (s1, T1, Abs (s2, T2, _)) =>
    1.17 +      let
    1.18 +        val x = (s1 ^ s2, Term.maxidx_of_term t + 1);
    1.19 +        val v = Var (x, HOLogic.mk_prodT (T1, T2));
    1.20 +      in
    1.21 +        lambda v (unfold_let (betapplys (t', [HOLogic.mk_fst v, HOLogic.mk_snd v])))
    1.22 +      end
    1.23 +    | _ => t)
    1.24 +  | unfold_let (t $ u) = betapply (unfold_let t, u)
    1.25    | unfold_let t = t;
    1.26  
    1.27  fun fold_rev_let_if_case ctxt f bound_Ts t =