generalize code to handle zero-argument case gracefully (e.g. for nullay functions defined over codatatypes that corecurse through "fun"
authorblanchet
Thu, 19 Sep 2013 11:27:32 +0200
changeset 53733 cfd6257331ca
parent 53732 e2c0d0426d2b
child 53734 7613573f023a
generalize code to handle zero-argument case gracefully (e.g. for nullay functions defined over codatatypes that corecurse through "fun"
src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML
--- a/src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML	Thu Sep 19 11:27:30 2013 +0200
+++ b/src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML	Thu Sep 19 11:27:32 2013 +0200
@@ -586,18 +586,17 @@
     fun rewrite _ _ =
       let
         fun subst (Abs (v, T, b)) = Abs (v, T, subst b)
-          | subst (t as _ $ _) =
+          | subst t =
             let val (u, vs) = strip_comb t in
               if is_Free u andalso has_call u then
                 Const (@{const_name Inr}, dummyT) $
-                  (try (foldr1 (fn (x, y) => Const (@{const_name Pair}, dummyT) $ x $ y)) vs
-                    |> the_default (hd vs))
+                  (if null vs then HOLogic.unit
+                   else foldr1 (fn (x, y) => Const (@{const_name Pair}, dummyT) $ x $ y) vs)
               else if try (fst o dest_Const) u = SOME @{const_name prod_case} then
                 list_comb (u |> map_types (K dummyT), map subst vs)
               else
                 list_comb (subst u, map subst vs)
-            end
-          | subst t = t;
+            end;
       in
         subst
       end;