diff -r 51e5cc3793d2 -r a394c7337966 Quot/quotient_term.ML --- a/Quot/quotient_term.ML Wed Jan 20 16:50:31 2010 +0100 +++ b/Quot/quotient_term.ML Thu Jan 21 07:38:34 2010 +0100 @@ -366,6 +366,7 @@ val mk_babs = Const (@{const_name Babs}, dummyT) val mk_ball = Const (@{const_name Ball}, dummyT) val mk_bex = Const (@{const_name Bex}, dummyT) +val mk_bex1 = Const (@{const_name Bex1}, dummyT) val mk_resp = Const (@{const_name Respects}, dummyT) (* - applies f to the subterm of an abstraction, @@ -460,6 +461,24 @@ else mk_bex $ (mk_resp $ resrel) $ subtrm end + | (Const (@{const_name "Ex1"}, ty) $ t, Const (@{const_name "Ex1"}, ty') $ t') => + let + val subtrm = apply_subt (regularize_trm ctxt) (t, t') + in + if ty = ty' then Const (@{const_name "Ex1"}, ty) $ subtrm + else mk_bex1 $ (mk_resp $ equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm + end + + | (Const (@{const_name "Bex1"}, ty) $ (Const (@{const_name "Respects"}, _) $ resrel) $ t, Const (@{const_name "Ex1"}, ty') $ t') => + let + val subtrm = apply_subt (regularize_trm ctxt) (t, t') + val needrel = Syntax.check_term ctxt (equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) + in + if resrel <> needrel + then term_mismatch "regularize(bex1)" ctxt resrel needrel + else mk_bex1 $ (mk_resp $ resrel) $ subtrm + end + | (* equalities need to be replaced by appropriate equivalence relations *) (Const (@{const_name "op ="}, ty), Const (@{const_name "op ="}, ty')) => if ty = ty' then rtrm