--- a/src/HOL/datatype.ML Tue Mar 12 14:39:34 1996 +0100
+++ b/src/HOL/datatype.ML Wed Mar 13 11:55:25 1996 +0100
@@ -42,9 +42,8 @@
\ in recursive application on rhs"
in
(case assoc (pairs,xk) of
- None => raise RecError
- ("illegal occurence of " ^ fname ^ " on rhs")
- | Some(U) => list_comb(U,map subst (ls @ rs)))
+ None => list_comb(f, map subst b)
+ | Some U => list_comb(U, map subst (ls @ rs)))
end
else list_comb(f, map subst b)
end
@@ -393,16 +392,12 @@
,list_comb(rec_comb
, fns @ map Bound (0 ::(length ls downto 1))));
val sg = sign_of thy;
- val defpair = mk_defpair (Const(fname,dummyT),rhs)
+ val defpair = (fname ^ "_" ^ tname ^ "_def",
+ Logic.mk_equals (Const(fname,dummyT), rhs))
val defpairT as (_, _ $ Const(_,T) $ _ ) = inferT_axm sg defpair;
val varT = Type.varifyT T;
val ftyp = the (Sign.const_type sg fname);
- in
- if Type.typ_instance (#tsig(Sign.rep_sg sg), ftyp, varT)
- then add_defs_i [defpairT] thy
- else error("Primrec definition error: \ntype of " ^ fname
- ^ " is not instance of type deduced from equations")
- end;
+ in add_defs_i [defpairT] thy end;
in
datatypes := map (fn (x,_,_) => x) cons_list' @ (!datatypes);
--- a/src/HOL/thy_syntax.ML Tue Mar 12 14:39:34 1996 +0100
+++ b/src/HOL/thy_syntax.ML Wed Mar 13 11:55:25 1996 +0100
@@ -171,9 +171,13 @@
fun mk_primrec_decl ((fname, tname), axms) =
let
+ (*Isolate type name from the structure's identifier it may be stored in*)
+ val tname' = implode (snd (take_suffix (not_equal ".") (explode tname)));
+
fun mk_prove (name, eqn) =
"val " ^ name ^ " = store_thm (" ^ quote name
- ^ ", prove_goalw thy [get_def thy " ^ fname ^ "] " ^ eqn ^ "\n\
+ ^ ", prove_goalw thy [get_def thy "
+ ^ (quote (strip_quotes fname ^ "_" ^ tname')) ^ "] " ^ eqn ^ "\n\
\ (fn _ => [Simp_tac 1]));";
val axs = mk_list (map (fn (n, a) => mk_pair (quote n, a)) axms);