src/Provers/simp.ML
changeset 231 cb6a24451544
parent 1 c6a6e3db5353
child 611 11098f505bfe
equal deleted inserted replaced
230:ec8a2b6aa8a7 231:cb6a24451544
   455 
   455 
   456 (*NB: the "Adding rewrites:" trace will look strange because assumptions
   456 (*NB: the "Adding rewrites:" trace will look strange because assumptions
   457       are represented by rules, generalized over their parameters*)
   457       are represented by rules, generalized over their parameters*)
   458 fun add_asms(ss,thm,a,anet,ats,cs) =
   458 fun add_asms(ss,thm,a,anet,ats,cs) =
   459     let val As = strip_varify(nth_subgoal i thm, a, []);
   459     let val As = strip_varify(nth_subgoal i thm, a, []);
   460 	val thms = map (trivial o Sign.cterm_of(#sign(rep_thm(thm))))As;
   460 	val thms = map (trivial o cterm_of(#sign(rep_thm(thm))))As;
   461 	val new_rws = flat(map mk_rew_rules thms);
   461 	val new_rws = flat(map mk_rew_rules thms);
   462 	val rwrls = map mk_trans (flat(map mk_rew_rules thms));
   462 	val rwrls = map mk_trans (flat(map mk_rew_rules thms));
   463 	val anet' = foldr lhs_insert_thm (rwrls,anet)
   463 	val anet' = foldr lhs_insert_thm (rwrls,anet)
   464     in  if !tracing andalso not(null new_rws)
   464     in  if !tracing andalso not(null new_rws)
   465 	then (writeln"Adding rewrites:";  prths new_rws;  ())
   465 	then (writeln"Adding rewrites:";  prths new_rws;  ())
   583 
   583 
   584 fun mk_cong sg (f,aTs,rT) (refl,eq) =
   584 fun mk_cong sg (f,aTs,rT) (refl,eq) =
   585 let val tsig = #tsig(Sign.rep_sg sg);
   585 let val tsig = #tsig(Sign.rep_sg sg);
   586     val k = length aTs;
   586     val k = length aTs;
   587     fun ri((subst,va as Var(_,Ta),vb as Var(_,Tb),P),i,si,T,yik) =
   587     fun ri((subst,va as Var(_,Ta),vb as Var(_,Tb),P),i,si,T,yik) =
   588 	let val ca = Sign.cterm_of sg va
   588 	let val ca = cterm_of sg va
   589 	    and cx = Sign.cterm_of sg (eta_Var(("X"^si,0),T))
   589 	    and cx = cterm_of sg (eta_Var(("X"^si,0),T))
   590 	    val cb = Sign.cterm_of sg vb
   590 	    val cb = cterm_of sg vb
   591 	    and cy = Sign.cterm_of sg (eta_Var(("Y"^si,0),T))
   591 	    and cy = cterm_of sg (eta_Var(("Y"^si,0),T))
   592 	    val cP = Sign.cterm_of sg P
   592 	    val cP = cterm_of sg P
   593 	    and cp = Sign.cterm_of sg (Pinst(f,rT,eq,k,i,T,yik,aTs))
   593 	    and cp = cterm_of sg (Pinst(f,rT,eq,k,i,T,yik,aTs))
   594 	in cterm_instantiate [(ca,cx),(cb,cy),(cP,cp)] subst end;
   594 	in cterm_instantiate [(ca,cx),(cb,cy),(cP,cp)] subst end;
   595     fun mk(c,T::Ts,i,yik) =
   595     fun mk(c,T::Ts,i,yik) =
   596 	let val si = radixstring(26,"a",i)
   596 	let val si = radixstring(26,"a",i)
   597 	in case find_subst tsig T of
   597 	in case find_subst tsig T of
   598 	     None => mk(c,Ts,i-1,eta_Var(("X"^si,0),T)::yik)
   598 	     None => mk(c,Ts,i-1,eta_Var(("X"^si,0),T)::yik)