Quellcodebibliothek Statistik Leitseite products/sources/formale Sprachen/Isabelle/FOL/ex/Locale_Test/   (Beweissystem Isabelle Version 2025-1©)  Datei vom 16.11.2025 mit Größe 25 kB image not shown  

Quelle  Locale_Test1.thy   Sprache: Isabelle

 
(*  Title:      FOL/ex/Locale_Test/Locale_Test1.thy
    Author:     Clemens Ballarin, TU Muenchen

Test environment for the locale implementation.
*)


theory Locale_Test1
imports FOL
begin

typedecl int
instance int :: term ..

consts plus :: int => int => int (infixl + 60)
  zero :: int (0)
  minus :: int => int (- _)

axiomatization where
  int_assoc: (x + y::int) + z = x + (y + z) and
  int_zero: 0 + x = x and
  int_minus: (-x) + x = 0 and
  int_minus2: -(-x) = x

section Inference of parameter types

locale param1 = fixes p
print_locale! param1

locale param2 = fixes p :: 'b\
print_locale! param2

(*
locale param_top = param2 r for r :: "'b :: {}"
  Fails, cannot generalise parameter.
*)


locale param3 = fixes p (infix .. 50)
print_locale! param3

locale param4 = fixes p :: 'a => 'a => 'a\ (infix \..\ 50)
print_locale! param4


subsection Incremental type constraints

locale constraint1 =
  fixes  prod (infixl ** 65)
  assumes l_id: x ** y = x
  assumes assoc: (x ** y) ** z = x ** (y ** z)
print_locale! constraint1

locale constraint2 =
  fixes p and q
  assumes p = q
print_locale! constraint2


section Inheritance

locale semi =
  fixes prod (infixl ** 65)
  assumes assoc: (x ** y) ** z = x ** (y ** z)
print_locale! semi thm semi_def

locale lgrp = semi +
  fixes one and inv
  assumes lone: one ** x = x
    and linv: inv(x) ** x = one
print_locale! lgrp thm lgrp_def lgrp_axioms_def

locale add_lgrp = semi (++) for sum (infixl ++ 60) +
  fixes zero and neg
  assumes lzero: zero ++ x = x
    and lneg: neg(x) ++ x = zero
print_locale! add_lgrp thm add_lgrp_def add_lgrp_axioms_def

locale rev_lgrp = semi %x y. y ++ x for sum (infixl ++ 60)
print_locale! rev_lgrp thm rev_lgrp_def

locale hom = f: semi f + g: semi g for f and g
print_locale! hom thm hom_def

locale perturbation = semi + d: semi %x y. delta(x) ** delta(y) for delta
print_locale! perturbation thm perturbation_def

locale pert_hom = d1: perturbation f d1 + d2: perturbation f d2 for f d1 d2
print_locale! pert_hom thm pert_hom_def

text Alternative expression, obtaining nicer names in semi f.
locale pert_hom' = semi \f\ + d1: perturbation \f\ \d1\ + d2: perturbation \f\ \d2\ for f d1 d2
print_locale! pert_hom' thm pert_hom'_def


section Syntax declarations

locale logic =
  fixes land (infixl && 55)
    and lnot (-- _ [60] 60)
  assumes assoc: (x && y) && z = x && (y && z)
    and notnot: -- (-- x) = x
begin

definition lor (infixl || 50) where
  x || y = --(-- x && -- y)

end
print_locale! logic

locale use_decl = l: logic + semi (||)
print_locale! use_decl thm use_decl_def

locale extra_type =
  fixes a :: 'a\
    and P :: 'a => 'b => o
begin

definition test :: 'a => o\
  where test(x)  (b. P(x, b))

end

term extra_type.test thm extra_type.test_def

interpretation var?: extra_type 0 %x y. x = 0 .

thm var.test_def


text Under which circumstances notation remains active.

ML 
  fun check_syntax ctxt thm expected =
    let
      val obtained =
        Pretty.pure_string_of (Thm.pretty_thm (Config.put show_markup false ctxt) thm);
    in
      if obtained <> expected
      then error ("Theorem syntax '" ^ obtained ^ "' obtained, but '" ^ expected ^ "' expected.")
      else ()
    end;


declare [[show_hyps]]

locale "syntax" =
  fixes p1 :: 'a => 'b
    and p2 :: 'b => o\
begin

definition d1 :: 'a => o\ (\D1'(_')\) where \d1(x) \ \ p2(p1(x))\
definition d2 :: 'b => o\ (\D2'(_')\) where \d2(x) \ \ p2(x)\

thm d1_def d2_def

end

thm syntax.d1_def syntax.d2_def

locale syntax' = "syntax" \p1\ \p2\ for p1 :: \'a => 'a\ and p2 :: \'a => o
begin

thm d1_def d2_def  (* should print as "D1(?x) <-> ..." and "D2(?x) <-> ..." *)

ML 
  check_syntax 🍋 @{thm d1_def} "D1(?x) \ \ p2(p1(?x))";
  check_syntax 🍋 @{thm d2_def} "D2(?x) \ \ p2(?x)";


end

locale syntax'' = "syntax" p3 p2 for p3 :: 'a => 'b and p2 :: 'b => o\
begin

thm d1_def d2_def
  (* should print as "d1(?x) <-> ..." and "D2(?x) <-> ..." *)

ML 
  check_syntax 🍋 @{thm d1_def} "d1(?x) \ \ p2(p3(?x))";
  check_syntax 🍋 @{thm d2_def} "D2(?x) \ \ p2(?x)";


end


section Foundational versions of theorems

thm logic.assoc
thm logic.lor_def


section Defines

locale logic_def =
  fixes land (infixl && 55)
    and lor (infixl || 50)
    and lnot (-- _ [60] 60)
  assumes assoc: (x && y) && z = x && (y && z)
    and notnot: -- (-- x) = x
  defines x || y == --(-- x && -- y)
begin

thm lor_def

lemma x || y = --(-- x && --y)
  by (unfold lor_def) (rule refl)

end

(* Inheritance of defines *)

locale logic_def2 = logic_def
begin

lemma x || y = --(-- x && --y)
  by (unfold lor_def) (rule refl)

end


section Notes

(* A somewhat arcane homomorphism example *)

definition semi_hom where
  semi_hom(prod, sum, h)  (x y. h(prod(x, y)) = sum(h(x), h(y)))

lemma semi_hom_mult:
  semi_hom(prod, sum, h) ==> h(prod(x, y)) = sum(h(x), h(y))
  by (simp add: semi_hom_def)

locale semi_hom_loc = prod: semi prod + sum: semi sum
  for prod and sum and h +
  assumes semi_homh: semi_hom(prod, sum, h)
  notes semi_hom_mult = semi_hom_mult [OF semi_homh]

thm semi_hom_loc.semi_hom_mult
(* unspecified, attribute not applied in background theory !!! *)

lemma (in semi_hom_loc) h(prod(x, y)) = sum(h(x), h(y))
  by (rule semi_hom_mult)

(* Referring to facts from within a context specification *)

lemma
  assumes x:  P
  notes y = x
  shows True ..


section Theorem statements

lemma (in lgrp) lcancel:
  x ** y = x ** z  y = z
proof
  assume x ** y = x ** z
  then have inv(x) ** x ** y = inv(x) ** x ** z by (simp add: assoc)
  then show y = z by (simp add: lone linv)
qed simp
print_locale! lgrp


locale rgrp = semi +
  fixes one and inv
  assumes rone: x ** one = x
    and rinv: x ** inv(x) = one
begin

lemma rcancel:
  y ** x = z ** x  y = z
proof
  assume y ** x = z ** x
  then have y ** (x ** inv(x)) = z ** (x ** inv(x))
    by (simp add: assoc [symmetric])
  then show y = z by (simp add: rone rinv)
qed simp

end
print_locale! rgrp


subsection Patterns

lemma (in rgrp)
  assumes y ** x = z ** x (is ?a)
  shows y = z (is ?t)
proof -
  txt Weird proof involving patterns from context element and conclusion.
  {
    assume ?a
    then have y ** (x ** inv(x)) = z ** (x ** inv(x))
      by (simp add: assoc [symmetric])
    then have ?t by (simp add: rone rinv)
  }
  note x = this
  show ?t by (rule x [OF ?a])
qed


section Interpretation between locales: sublocales

sublocale lgrp < right?: rgrp
print_facts
proof unfold_locales
  {
    fix x
    have inv(x) ** x ** one = inv(x) ** x by (simp add: linv lone)
    then show x ** one = x by (simp add: assoc lcancel)
  }
  note rone = this
  {
    fix x
    have inv(x) ** x ** inv(x) = inv(x) ** one
      by (simp add: linv lone rone)
    then show x ** inv(x) = one by (simp add: assoc lcancel)
  }
qed

(* effect on printed locale *)

print_locale! lgrp

(* use of derived theorem *)

lemma (in lgrp)
  y ** x = z ** x  y = z
  apply (rule rcancel)
  done

(* circular interpretation *)

sublocale rgrp < left: lgrp
proof unfold_locales
  {
    fix x
    have one ** (x ** inv(x)) = x ** inv(x) by (simp add: rinv rone)
    then show one ** x = x by (simp add: assoc [symmetric] rcancel)
  }
  note lone = this
  {
    fix x
    have inv(x) ** (x ** inv(x)) = one ** inv(x)
      by (simp add: rinv lone rone)
    then show inv(x) ** x = one by (simp add: assoc [symmetric] rcancel)
  }
qed

(* effect on printed locale *)

print_locale! rgrp
print_locale! lgrp


(* Duality *)

locale order =
  fixes less :: 'a => 'a => o (infix << 50)
  assumes refl: x << x
    and trans: [| x << y; y << z |] ==> x << z

sublocale order < dual: order %x y. y << x
  apply unfold_locales apply (rule refl) apply (blast intro: trans)
  done

print_locale! order  (* Only two instances of order. *)

locale order' =
  fixes less :: 'a => 'a => o (infix << 50)
  assumes refl: x << x
    and trans: [| x << y; y << z |] ==> x << z

locale order_with_def = order'
begin

definition greater :: 'a => 'a => o (infix >> 50) where
  x >> y  y << x

end

sublocale order_with_def < dual: order' \(>>)\
  apply unfold_locales
  unfolding greater_def
  apply (rule refl) apply (blast intro: trans)
  done

print_locale! order_with_def
(* Note that decls come after theorems that make use of them. *)


(* locale with many parameters ---
   interpretations generate alternating group A5 *)



locale A5 =
  fixes A and B and C and D and E
  assumes eq:  B  C  D  E

sublocale A5 < 1: A5 _ _ D E C
print_facts
  using eq apply (blast intro: A5.intro) done

sublocale A5 < 2: A5 C _ E _ A
print_facts
  using eq apply (blast intro: A5.intro) done

sublocale A5 < 3: A5 B C A _ _
print_facts
  using eq apply (blast intro: A5.intro) done

(* Any even permutation of parameters is subsumed by the above. *)

print_locale! A5


(* Free arguments of instance *)

locale trivial =
  fixes P and Q :: o
  assumes Q:  P  Q
begin

lemma Q_triv: Q using Q by fast

end

sublocale trivial < x: trivial x _
  apply unfold_locales using Q by fast

print_locale! trivial

context trivial
begin
thm x.Q [where ?x = True]
end

sublocale trivial < y: trivial Q Q
  by unfold_locales
  (* Succeeds since previous interpretation is more general. *)

print_locale! trivial  (* No instance for y created (subsumed). *)


subsection Sublocale, then interpretation in theory

interpretation int?: lgrp (+) 0 minus
proof unfold_locales
qed (rule int_assoc int_zero int_minus)+

thm int.assoc int.semi_axioms

interpretation int2?: semi (+)
  by unfold_locales  (* subsumed, thm int2.assoc not generated *)

ML (Global_Theory.get_thms 🍋 "int2.assoc";
    raise Fail "thm int2.assoc was generated")
  handle ERROR _ => ([]:thm list);

thm int.lone int.right.rone
  (* the latter comes through the sublocale relation *)


subsection Interpretation in theorythen sublocale

interpretation fol: logic (+) minus
  by unfold_locales (rule int_assoc int_minus2)+

locale logic2 =
  fixes land (infixl && 55)
    and lnot (-- _ [60] 60)
  assumes assoc: (x && y) && z = x && (y && z)
    and notnot: -- (-- x) = x
begin

definition lor (infixl || 50) where
  x || y = --(-- x && -- y)

end

sublocale logic < two: logic2
  by unfold_locales (rule assoc notnot)+

thm fol.two.assoc


subsection Declarations and sublocale

locale logic_a = logic
locale logic_b = logic

sublocale logic_a < logic_b
  by unfold_locales


subsection Interpretation

subsection Rewrite morphism

locale logic_o =
  fixes land (infixl && 55)
    and lnot (-- _ [60] 60)
  assumes assoc_o: (x && y) && z  x && (y && z)
    and notnot_o: -- (-- x)  x
begin

definition lor_o (infixl || 50) where
  x || y  --(-- x && -- y)

end

interpretation x: logic_o () Not
  rewrites bool_logic_o: x.lor_o(x, y)  x  y
proof -
  show bool_logic_o: PROP logic_o((), Not) by unfold_locales fast+
  show logic_o.lor_o((), Not, x, y)  x  y
    by (unfold logic_o.lor_o_def [OF bool_logic_o]) fast
qed

thm x.lor_o_def bool_logic_o

lemma lor_triv:  z ..

lemma (in logic_o) lor_triv: x || y  x || y by fast

thm lor_triv [where z = True(* Check strict prefix. *)
  x.lor_triv


subsection Rewrite morphisms in expressions

interpretation y: logic_o () Not rewrites bool_logic_o2: logic_o.lor_o((), Not, x, y)  x  y
proof -
  show bool_logic_o: PROP logic_o((), Not) by unfold_locales fast+
  show logic_o.lor_o((), Not, x, y)  x  y unfolding logic_o.lor_o_def [OF bool_logic_o] by fast
qed


subsection Inheritance of rewrite morphisms

locale reflexive =
  fixes le :: 'a => 'a => o (infix  50)
  assumes refl:  x
begin

definition less (infix  50) where  y  x  y  x  y

end

axiomatization
  gle :: 'a => 'a => o and gless :: 'a => 'a => o and
  gle' :: \'a => 'a => o\ and gless' :: 'a => 'a => o
where
  grefl: gle(x, x) and gless_def: gless(x, y)  gle(x, y)  x  y and
  grefl': \gle'(x, x) and gless'_def: \gless'(x, y)  gle'(x, y) \ x \ y\

text Setup

locale mixin = reflexive
begin
lemmas less_thm = less_def
end

interpretation le: mixin gle rewrites reflexive.less(gle, x, y)  gless(x, y)
proof -
  show mixin(gle) by unfold_locales (rule grefl)
  note reflexive = this[unfolded mixin_def]
  show reflexive.less(gle, x, y)  gless(x, y)
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

text Rewrite morphism propagated along the locale hierarchy

locale mixin2 = mixin
begin
lemmas less_thm2 = less_def
end

interpretation le: mixin2 gle
  by unfold_locales

thm le.less_thm2  (* rewrite morphism applied *)
lemma gless(x, y)  gle(x, y)  x  y
  by (rule le.less_thm2)

text Rewrite morphism does not leak to a side branch.

locale mixin3 = reflexive
begin
lemmas less_thm3 = less_def
end

interpretation le: mixin3 gle
  by unfold_locales

thm le.less_thm3  (* rewrite morphism not applied *)
lemma reflexive.less(gle, x, y)  gle(x, y)  x  y by (rule le.less_thm3)

text Rewrite morphism only available in original context

locale mixin4_base = reflexive

locale mixin4_mixin = mixin4_base

interpretation le: mixin4_mixin gle
  rewrites reflexive.less(gle, x, y)  gless(x, y)
proof -
  show mixin4_mixin(gle) by unfold_locales (rule grefl)
  note reflexive = this[unfolded mixin4_mixin_def mixin4_base_def mixin_def]
  show reflexive.less(gle, x, y)  gless(x, y)
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

locale mixin4_copy = mixin4_base
begin
lemmas less_thm4 = less_def
end

locale mixin4_combined = le1?: mixin4_mixin le'\ + le2?: mixin4_copy \le\ for le' le
begin
lemmas less_thm4' = less_def
end

interpretation le4: mixin4_combined gle'\ \gle\
  by unfold_locales (rule grefl')

thm le4.less_thm4' (* rewrite morphism not applied *)
lemma reflexive.less(gle, x, y)  gle(x, y)  x  y
  by (rule le4.less_thm4')

text Inherited rewrite morphism applied to new theorem

locale mixin5_base = reflexive

locale mixin5_inherited = mixin5_base

interpretation le5: mixin5_base gle
  rewrites reflexive.less(gle, x, y)  gless(x, y)
proof -
  show mixin5_base(gle) by unfold_locales
  note reflexive = this[unfolded mixin5_base_def mixin_def]
  show reflexive.less(gle, x, y)  gless(x, y)
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

interpretation le5: mixin5_inherited gle
  by unfold_locales

lemmas (in mixin5_inherited) less_thm5 = less_def

thm le5.less_thm5  (* rewrite morphism applied *)
lemma gless(x, y)  gle(x, y)  x  y
  by (rule le5.less_thm5)

text Rewrite morphism pushed down to existing inherited locale

locale mixin6_base = reflexive

locale mixin6_inherited = mixin5_base

interpretation le6: mixin6_base gle
  by unfold_locales
interpretation le6: mixin6_inherited gle
  by unfold_locales
interpretation le6: mixin6_base gle
  rewrites reflexive.less(gle, x, y)  gless(x, y)
proof -
  show mixin6_base(gle) by unfold_locales
  note reflexive = this[unfolded mixin6_base_def mixin_def]
  show reflexive.less(gle, x, y)  gless(x, y)
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

lemmas (in mixin6_inherited) less_thm6 = less_def

thm le6.less_thm6  (* mixin applied *)
lemma gless(x, y)  gle(x, y)  x  y
  by (rule le6.less_thm6)

text Existing rewrite morphism inherited through sublocale relation

locale mixin7_base = reflexive

locale mixin7_inherited = reflexive

interpretation le7: mixin7_base gle
  rewrites reflexive.less(gle, x, y)  gless(x, y)
proof -
  show mixin7_base(gle) by unfold_locales
  note reflexive = this[unfolded mixin7_base_def mixin_def]
  show reflexive.less(gle, x, y)  gless(x, y)
    by (simp add: reflexive.less_def[OF reflexive] gless_def)
qed

interpretation le7: mixin7_inherited gle
  by unfold_locales

lemmas (in mixin7_inherited) less_thm7 = less_def

thm le7.less_thm7  (* before, rewrite morphism not applied *)
lemma reflexive.less(gle, x, y)  gle(x, y)  x  y
  by (rule le7.less_thm7)

sublocale mixin7_inherited < mixin7_base
  by unfold_locales

lemmas (in mixin7_inherited) less_thm7b = less_def

thm le7.less_thm7b  (* after, mixin applied *)
lemma gless(x, y)  gle(x, y)  x  y
  by (rule le7.less_thm7b)


text This locale will be interpreted in later theories.

locale mixin_thy_merge = le: reflexive le + le': reflexive \le' for le le'


subsection Rewrite morphisms in sublocale

text Simulate a specification of left groups where unit and inverse are defined
  rather than specified.  This is possible, but not in FOL, due to the lack of a
  selection operator.

axiomatization glob_one and glob_inv
  where glob_lone: prod(glob_one(prod), x) = x
    and glob_linv: prod(glob_inv(prod, x), x) = glob_one(prod)

locale dgrp = semi
begin

definition one where one = glob_one(prod)

lemma lone: one ** x = x
  unfolding one_def by (rule glob_lone)

definition inv where inv(x) = glob_inv(prod, x)

lemma linv: inv(x) ** x = one
  unfolding one_def inv_def by (rule glob_linv)

end

sublocale lgrp < def?: dgrp
  rewrites one_equation: dgrp.one(prod) = one and inv_equation: dgrp.inv(prod, x) = inv(x)
proof -
  show dgrp(prod) by unfold_locales
  from this interpret d: dgrp .
  🍋 Unit
  have dgrp.one(prod) = glob_one(prod) by (rule d.one_def)
  also have ... = glob_one(prod) ** one by (simp add: rone)
  also have ... = one by (simp add: glob_lone)
  finally show dgrp.one(prod) = one .
  🍋 Inverse
  then have dgrp.inv(prod, x) ** x = inv(x) ** x by (simp add: glob_linv d.linv linv)
  then show dgrp.inv(prod, x) = inv(x) by (simp add: rcancel)
qed

print_locale! lgrp

context lgrp
begin

text Equations stored in target

lemma dgrp.one(prod) = one by (rule one_equation)
lemma dgrp.inv(prod, x) = inv(x) by (rule inv_equation)

text Rewrite morphisms applied

lemma one = glob_one(prod) by (rule one_def)
lemma inv(x) = glob_inv(prod, x) by (rule inv_def)

end

text Interpreted versions

lemma 0 = glob_one ((+)) by (rule int.def.one_def)
lemma - x = glob_inv((+), x) by (rule int.def.inv_def)

text Roundup applies rewrite morphisms at declaration level in DFS tree

locale roundup = fixes x assumes true:  True

sublocale roundup  sub: roundup x rewrites  True  True
  apply unfold_locales apply (simp add: true) done
lemma (in roundup) True  True  True by (rule sub.true)


section Interpretation in named contexts

locale container
begin
interpretation "private": roundup True by unfold_locales rule
lemmas true_copy = private.true
end

context container
begin
ML (Context.>> (fn generic => let val context = Context.proof_of generic
  val _ = Proof_Context.get_thms context "private.true" in generic end);
  raise Fail "thm private.true was persisted")
  handle ERROR _ => ([]:thm list);
thm true_copy
end


section Interpretation in proofs

notepad
begin
  interpret "local": lgrp (+) 0 minus
    by unfold_locales  (* subsumed *)
  {
    fix zero :: int
    assume !!x. zero + x = x !!x. (-x) + x = zero
    then interpret local_fixed: lgrp (+) zero minus
      by unfold_locales
    thm local_fixed.lone
  }
  assume !!x zero. zero + x = x !!x zero. (-x) + x = zero
  then interpret local_free: lgrp (+) zero minus for zero
    by unfold_locales
  thm local_free.lone [where ?zero = 0]
end

notepad
begin
  {
    fix pand and pnot and por
    assume passoc: x y z. pand(pand(x, y), z)  pand(x, pand(y, z))
      and pnotnot: x. pnot(pnot(x))  x
      and por_def: x y. por(x, y)  pnot(pand(pnot(x), pnot(y)))
    interpret loc: logic_o pand pnot
      rewrites por_eq: x y. logic_o.lor_o(pand, pnot, x, y)  por(x, y)  (* FIXME *)
    proof -
      show logic_o: PROP logic_o(pand, pnot) using passoc pnotnot by unfold_locales
      fix x y
      show logic_o.lor_o(pand, pnot, x, y)  por(x, y)
        by (unfold logic_o.lor_o_def [OF logic_o]) (rule por_def [symmetric])
    qed
    print_interps logic_o
    have x y. por(x, y)  pnot(pand(pnot(x), pnot(y))) by (rule loc.lor_o_def)
  }
end

end

Messung V0.5
C=97 H=93 G=94

¤ Dauer der Verarbeitung: 0.23 Sekunden  (vorverarbeitet)  ¤

*© Formatika GbR, Deutschland






Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.