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) |