# HG changeset patch # User wenzelm # Date 1632932482 -7200 # Node ID 5399dfe9141c2a7a0cb09d22da28219dbb5c0002 # Parent b9331caf92c3346d42802028c70aa155cdebca9b clarified antiquotations; diff -r b9331caf92c3 -r 5399dfe9141c src/HOL/ex/Rewrite_Examples.thy --- a/src/HOL/ex/Rewrite_Examples.thy Wed Sep 29 11:55:09 2021 +0200 +++ b/src/HOL/ex/Rewrite_Examples.thy Wed Sep 29 18:21:22 2021 +0200 @@ -222,9 +222,9 @@ val (x, ctxt) = yield_singleton Variable.add_fixes "x" \<^context> (* Note that the pattern order is reversed *) val pat = [ - Rewrite.For [(x, SOME \<^typ>\nat\)], + Rewrite.For [(x, SOME \<^Type>\nat\)], Rewrite.In, - Rewrite.Term (@{const plus(nat)} $ Free (x, \<^typ>\nat\) $ \<^term>\1 :: nat\, [])] + Rewrite.Term (\<^Const>\plus \<^Type>\nat\ for \Free (x, \<^Type>\nat\)\ \<^term>\1 :: nat\\, [])] val to = NONE in CCONVERSION (Rewrite.rewrite_conv ctxt (pat, to) @{thms add.commute}) 1 end \) @@ -240,10 +240,10 @@ val pat = [ Rewrite.Concl, Rewrite.In, - Rewrite.Term (Free ("Q", (\<^typ>\int\ --> TVar (("'b",0), [])) --> \<^typ>\bool\) - $ Abs ("x", \<^typ>\int\, Rewrite.mk_hole 1 (\<^typ>\int\ --> TVar (("'b",0), [])) $ Bound 0), [(x, \<^typ>\int\)]), + Rewrite.Term (Free ("Q", (\<^Type>\int\ --> TVar (("'b",0), [])) --> \<^Type>\bool\) + $ Abs ("x", \<^Type>\int\, Rewrite.mk_hole 1 (\<^Type>\int\ --> TVar (("'b",0), [])) $ Bound 0), [(x, \<^Type>\int\)]), Rewrite.In, - Rewrite.Term (@{const plus(int)} $ Free (x, \<^typ>\int\) $ Var (("c", 0), \<^typ>\int\), []) + Rewrite.Term (\<^Const>\plus \<^Type>\int\ for \Free (x, \<^Type>\int\)\ \Var (("c", 0), \<^Type>\int\)\\, []) ] val to = NONE in CCONVERSION (Rewrite.rewrite_conv ctxt (pat, to) @{thms add.commute}) 1 end @@ -261,7 +261,7 @@ Rewrite.Term (Free ("Q", (\<^typ>\int\ --> TVar (("'b",0), [])) --> \<^typ>\bool\) $ Abs ("x", \<^typ>\int\, Rewrite.mk_hole 1 (\<^typ>\int\ --> TVar (("'b",0), [])) $ Bound 0), [(x, \<^typ>\int\)]), Rewrite.In, - Rewrite.Term (@{const plus(int)} $ Free (x, \<^typ>\int\) $ Var (("c", 0), \<^typ>\int\), []) + Rewrite.Term (\<^Const>\plus \<^Type>\int\ for \Free (x, \<^Type>\int\)\ \Var (("c", 0), \<^Type>\int\)\\, []) ] val to = NONE val th = Rewrite.rewrite_conv ctxt (pat, to) @{thms add.commute} ct @@ -274,7 +274,7 @@ val (x, ctxt) = yield_singleton Variable.add_fixes "x" \<^context> val pat = [ Rewrite.In, - Rewrite.Term (@{const plus(int)} $ Var (("c", 0), \<^typ>\int\) $ Var (("c", 0), \<^typ>\int\), []) + Rewrite.Term (\<^Const>\plus \<^Type>\int\ for \Var (("c", 0), \<^Type>\int\)\ \Var (("c", 0), \<^Type>\int\)\\, []) ] val to = NONE val _ = diff -r b9331caf92c3 -r 5399dfe9141c src/HOL/ex/veriT_Preprocessing.thy --- a/src/HOL/ex/veriT_Preprocessing.thy Wed Sep 29 11:55:09 2021 +0200 +++ b/src/HOL/ex/veriT_Preprocessing.thy Wed Sep 29 18:21:22 2021 +0200 @@ -42,12 +42,10 @@ val tuple_T = fastype_of tuple_t; val lambda_t = HOLogic.tupled_lambda tuple_t (list_comb (p, ts)); - val lambda_T = fastype_of lambda_t; val left_prems = map2 (curry Ctr_Sugar_Util.mk_Trueprop_eq) ts us; val right_prem = Ctr_Sugar_Util.mk_Trueprop_eq (list_comb (p, us), q); - val concl = Ctr_Sugar_Util.mk_Trueprop_eq - (Const (\<^const_name>\Let\, tuple_T --> lambda_T --> B) $ tuple_t $ lambda_t, q); + val concl = Ctr_Sugar_Util.mk_Trueprop_eq (\<^Const>\Let tuple_T B for tuple_t lambda_t\, q); val goal = Logic.list_implies (left_prems @ [right_prem], concl); val vars = Variable.add_free_names ctxt goal []; @@ -82,8 +80,8 @@ fun lambda_count (Abs (_, _, t)) = lambda_count t + 1 | lambda_count ((t as Abs _) $ _) = lambda_count t - 1 - | lambda_count ((t as Const (\<^const_name>\case_prod\, _) $ _) $ _) = lambda_count t - 1 - | lambda_count (Const (\<^const_name>\case_prod\, _) $ t) = lambda_count t - 1 + | lambda_count ((t as \<^Const_>\case_prod _ _ _\ $ _) $ _) = lambda_count t - 1 + | lambda_count \<^Const_>\case_prod _ _ _ for t\ = lambda_count t - 1 | lambda_count _ = 0; fun zoom apply = @@ -96,20 +94,16 @@ let val (t', u') = zo 1 (T :: bound_Ts) (t, u) in (t' $ arg, u') end - | zo 0 bound_Ts ((t as Const (\<^const_name>\case_prod\, _) $ _) $ arg, u) = + | zo 0 bound_Ts ((t as \<^Const_>\case_prod _ _ _\ $ _) $ arg, u) = let val (t', u') = zo 1 bound_Ts (t, u) in (t' $ arg, u') end | zo 0 bound_Ts tu = apply bound_Ts tu - | zo n bound_Ts (Const (\<^const_name>\case_prod\, - Type (\<^type_name>\fun\, [Type (\<^type_name>\fun\, [A, Type (\<^type_name>\fun\, [B, _])]), - Type (\<^type_name>\fun\, [AB, _])])) $ t, u) = + | zo n bound_Ts (\<^Const_>\case_prod A B _ for t\, u) = let val (t', u') = zo (n + 1) bound_Ts (t, u); val C = range_type (range_type (fastype_of t')); - in - (Const (\<^const_name>\case_prod\, (A --> B --> C) --> AB --> C) $ t', u') - end + in (\<^Const>\case_prod A B C for t'\, u') end | zo n bound_Ts (Abs (s, T, t), u) = let val (t', u') = zo (n - 1) (T :: bound_Ts) (t, u) in (Abs (s, T, t'), u') @@ -130,26 +124,26 @@ fun apply_Bind (lhs, rhs) = (case (lhs, rhs) of - (Const (\<^const_name>\All\, _) $ Abs (_, T, t), Const (\<^const_name>\All\, _) $ Abs (s, U, u)) => + (\<^Const_>\All _ for \Abs (_, T, t)\\, \<^Const_>\All _ for \Abs (s, U, u)\\) => (Abs (s, T, t), Abs (s, U, u)) - | (Const (\<^const_name>\Ex\, _) $ t, Const (\<^const_name>\Ex\, _) $ u) => (t, u) + | (\<^Const_>\Ex _ for t\, \<^Const_>\Ex _ for u\) => (t, u) | _ => raise TERM ("apply_Bind", [lhs, rhs])); fun apply_Sko_Ex (lhs, rhs) = (case lhs of - Const (\<^const_name>\Ex\, _) $ (t as Abs (_, T, _)) => + \<^Const_>\Ex _ for \t as Abs (_, T, _)\\ => (t $ (HOLogic.choice_const T $ t), rhs) | _ => raise TERM ("apply_Sko_Ex", [lhs])); fun apply_Sko_All (lhs, rhs) = (case lhs of - Const (\<^const_name>\All\, _) $ (t as Abs (s, T, body)) => + \<^Const_>\All _ for \t as Abs (s, T, body)\\ => (t $ (HOLogic.choice_const T $ Abs (s, T, HOLogic.mk_not body)), rhs) | _ => raise TERM ("apply_Sko_All", [lhs])); fun apply_Let_left ts j (lhs, _) = (case lhs of - Const (\<^const_name>\Let\, _) $ t $ _ => + \<^Const_>\Let _ _ for t _\ => let val ts0 = HOLogic.strip_tuple t in (nth ts0 j, nth ts j) end @@ -158,7 +152,7 @@ fun apply_Let_right ts bound_Ts (lhs, rhs) = let val t' = mk_tuple1 bound_Ts ts in (case lhs of - Const (\<^const_name>\Let\, _) $ _ $ u => (u $ t', rhs) + \<^Const_>\Let _ _ for _ u\ => (u $ t', rhs) | _ => raise TERM ("apply_Let_right", [lhs, rhs])) end;