Fixed bug in subst causing primrec functions returning functions
authorberghofe
Fri, 18 May 2007 11:12:03 +0200
changeset 23006 c46abff9a7a0
parent 23005 914a1de067b6
child 23007 e025695d9b0e
Fixed bug in subst causing primrec functions returning functions to be rejected.
src/HOL/Nominal/nominal_primrec.ML
--- a/src/HOL/Nominal/nominal_primrec.ML	Fri May 18 09:16:57 2007 +0200
+++ b/src/HOL/Nominal/nominal_primrec.ML	Fri May 18 11:12:03 2007 +0200
@@ -116,11 +116,14 @@
                 val (x', rs) = (hd rest, tl rest)
                   handle Empty => raise RecError ("not enough arguments\
                    \ in recursive application\nof function " ^ quote fname' ^ " on rhs");
-                val _ = (case eqns of
+                val rs' = (case eqns of
                     (_, (ls', _, rs', _, _)) :: _ =>
-                      if ls = map Free ls' andalso rs = map Free rs' then ()
-                      else raise RecError param_err
-                  | _ => ());
+                      let val (rs1, rs2) = chop (length rs') rs
+                      in
+                        if ls = map Free ls' andalso rs1 = map Free rs' then rs2
+                        else raise RecError param_err
+                      end
+                  | _ => raise RecError ("no equations for " ^ quote fname'));
                 val (x, xs) = strip_comb x'
               in case AList.lookup (op =) subs x
                of NONE =>
@@ -129,7 +132,7 @@
                     |-> (fn ts' => pair (list_comb (f, ts')))
                 | SOME (i', y) =>
                     fs
-                    |> fold_map (subst subs) xs
+                    |> fold_map (subst subs) (xs @ rs')
                     ||> process_fun thy descr rec_eqns (i', fnameT')
                     |-> (fn ts' => pair (list_comb (y, ts')))
               end