modernized specifications -- some attempts to avoid wild axiomatizations;
authorwenzelm
Tue, 29 Mar 2011 23:15:25 +0200
changeset 42155 ffe99b07c9c0
parent 42154 478bdcea240a
child 42156 df219e736a5d
modernized specifications -- some attempts to avoid wild axiomatizations; comp: retain infix \<circ> to retain type "o" from FOL; tuned proofs;
src/CCL/ex/Flag.thy
src/CCL/ex/List.thy
src/CCL/ex/Nat.thy
src/CCL/ex/Stream.thy
--- a/src/CCL/ex/Flag.thy	Tue Mar 29 22:36:56 2011 +0200
+++ b/src/CCL/ex/Flag.thy	Tue Mar 29 23:15:25 2011 +0200
@@ -10,24 +10,24 @@
 imports List
 begin
 
-consts
-  Colour             :: "i set"
-  red                :: "i"
-  white              :: "i"
-  blue               :: "i"
-  ccase              :: "[i,i,i,i]=>i"
-  flag               :: "i"
+definition Colour :: "i set"
+  where "Colour == Unit + Unit + Unit"
+
+definition red :: "i"
+  where "red == inl(one)"
+
+definition white :: "i"
+  where "white == inr(inl(one))"
 
-axioms
+definition blue :: "i"
+  where "blue == inr(inr(one))"
 
-  Colour_def:  "Colour == Unit + Unit + Unit"
-  red_def:        "red == inl(one)"
-  white_def:    "white == inr(inl(one))"
-  blue_def:     "blue == inr(inr(one))"
+definition ccase :: "[i,i,i,i]=>i"
+  where "ccase(c,r,w,b) == when(c,%x. r,%wb. when(wb,%x. w,%x. b))"
 
-  ccase_def:   "ccase(c,r,w,b) == when(c,%x. r,%wb. when(wb,%x. w,%x. b))"
-
-  flag_def:    "flag == lam l. letrec
+definition flag :: "i"
+  where
+    "flag == lam l. letrec
       flagx l be lcase(l,<[],<[],[]>>,
                        %h t. split(flagx(t),%lr p. split(p,%lw lb.
                             ccase(h, <red$lr,<lw,lb>>,
@@ -35,13 +35,14 @@
                                      <lr,<lw,blue$lb>>))))
       in flagx(l)"
 
-  Flag_def:
-     "Flag(l,x) == ALL lr:List(Colour).ALL lw:List(Colour).ALL lb:List(Colour).
-                    x = <lr,<lw,lb>> -->
-                  (ALL c:Colour.(c mem lr = true --> c=red) &
-                                (c mem lw = true --> c=white) &
-                                (c mem lb = true --> c=blue)) &
-                  Perm(l,lr @ lw @ lb)"
+axiomatization Perm :: "i => i => o"
+definition Flag :: "i => i => o" where
+  "Flag(l,x) == ALL lr:List(Colour).ALL lw:List(Colour).ALL lb:List(Colour).
+                x = <lr,<lw,lb>> -->
+              (ALL c:Colour.(c mem lr = true --> c=red) &
+                            (c mem lw = true --> c=white) &
+                            (c mem lb = true --> c=blue)) &
+              Perm(l,lr @ lw @ lb)"
 
 
 lemmas flag_defs = Colour_def red_def white_def blue_def ccase_def
@@ -68,7 +69,7 @@
   apply assumption
   done
 
-lemma "flag : PROD l:List(Colour).{x:List(Colour)*List(Colour)*List(Colour).FLAG(x,l)}"
+lemma "flag : PROD l:List(Colour).{x:List(Colour)*List(Colour)*List(Colour).Flag(x,l)}"
   apply (unfold flag_def)
   apply (tactic {* gen_ccs_tac @{context}
     [@{thm redT}, @{thm whiteT}, @{thm blueT}, @{thm ccaseT}] 1 *})
--- a/src/CCL/ex/List.thy	Tue Mar 29 22:36:56 2011 +0200
+++ b/src/CCL/ex/List.thy	Tue Mar 29 23:15:25 2011 +0200
@@ -9,46 +9,47 @@
 imports Nat
 begin
 
-consts
-  map       :: "[i=>i,i]=>i"
-  comp      :: "[i=>i,i=>i]=>i=>i"    (infixr "o" 55)
-  append    :: "[i,i]=>i"             (infixr "@" 55)
-  member    :: "[i,i]=>i"             (infixr "mem" 55)
-  filter    :: "[i,i]=>i"
-  flat      :: "i=>i"
-  partition :: "[i,i]=>i"
-  insert    :: "[i,i,i]=>i"
-  isort     :: "i=>i"
-  qsort     :: "i=>i"
+definition map :: "[i=>i,i]=>i"
+  where "map(f,l) == lrec(l,[],%x xs g. f(x)$g)"
+
+definition comp :: "[i=>i,i=>i]=>i=>i"  (infixr "\<circ>" 55)
+  where "f \<circ> g == (%x. f(g(x)))"
+
+definition append :: "[i,i]=>i"  (infixr "@" 55)
+  where "l @ m == lrec(l,m,%x xs g. x$g)"
 
-axioms
+axiomatization member :: "[i,i]=>i"  (infixr "mem" 55)  (* FIXME dangling eq *)
+  where "a mem l == lrec(l,false,%h t g. if eq(a,h) then true else g)"
 
-  map_def:     "map(f,l)   == lrec(l,[],%x xs g. f(x)$g)"
-  comp_def:    "f o g == (%x. f(g(x)))"
-  append_def:  "l @ m == lrec(l,m,%x xs g. x$g)"
-  member_def:  "a mem l == lrec(l,false,%h t g. if eq(a,h) then true else g)"
-  filter_def:  "filter(f,l) == lrec(l,[],%x xs g. if f`x then x$g else g)"
-  flat_def:    "flat(l) == lrec(l,[],%h t g. h @ g)"
+definition filter :: "[i,i]=>i"
+  where "filter(f,l) == lrec(l,[],%x xs g. if f`x then x$g else g)"
 
-  insert_def:  "insert(f,a,l) == lrec(l,a$[],%h t g. if f`a`h then a$h$t else h$g)"
-  isort_def:   "isort(f) == lam l. lrec(l,[],%h t g. insert(f,h,g))"
+definition flat :: "i=>i"
+  where "flat(l) == lrec(l,[],%h t g. h @ g)"
 
-  partition_def:
+definition partition :: "[i,i]=>i" where
   "partition(f,l) == letrec part l a b be lcase(l,<a,b>,%x xs.
                             if f`x then part(xs,x$a,b) else part(xs,a,x$b))
                     in part(l,[],[])"
-  qsort_def:   "qsort(f) == lam l. letrec qsortx l be lcase(l,[],%h t.
+
+definition insert :: "[i,i,i]=>i"
+  where "insert(f,a,l) == lrec(l,a$[],%h t g. if f`a`h then a$h$t else h$g)"
+
+definition isort :: "i=>i"
+  where "isort(f) == lam l. lrec(l,[],%h t g. insert(f,h,g))"
+
+definition qsort :: "i=>i" where
+  "qsort(f) == lam l. letrec qsortx l be lcase(l,[],%h t.
                                    let p be partition(f`h,t)
                                    in split(p,%x y. qsortx(x) @ h$qsortx(y)))
                           in qsortx(l)"
 
-
 lemmas list_defs = map_def comp_def append_def filter_def flat_def
   insert_def isort_def partition_def qsort_def
 
 lemma listBs [simp]:
-  "!!f g. (f o g) = (%a. f(g(a)))"
-  "!!a f g. (f o g)(a) = f(g(a))"
+  "!!f g. (f \<circ> g) = (%a. f(g(a)))"
+  "!!a f g. (f \<circ> g)(a) = f(g(a))"
   "!!f. map(f,[]) = []"
   "!!f x xs. map(f,x$xs) = f(x)$map(f,xs)"
   "!!m. [] @ m = m"
@@ -85,7 +86,7 @@
 
 lemma appendTS:
   "[| l : {l:List(A). m : {m:List(A).P(l @ m)}} |] ==> l @ m : {x:List(A). P(x)}"
-  by (blast intro!: SubtypeI appendT elim!: SubtypeE)
+  by (blast intro!: appendT)
 
 lemma filterT: "[| f:A->Bool;   l : List(A) |] ==> filter(f,l) : List(A)"
   apply (unfold filter_def)
@@ -105,7 +106,7 @@
 lemma insertTS:
   "[| f : {f:A->A->Bool. a : {a:A. l : {l:List(A).P(insert(f,a,l))}}} |] ==>  
    insert(f,a,l)  : {x:List(A). P(x)}"
-  by (blast intro!: SubtypeI insertT elim!: SubtypeE)
+  by (blast intro!: insertT)
 
 lemma partitionT:
   "[| f:A->Bool;  l : List(A) |] ==> partition(f,l) : List(A)*List(A)"
--- a/src/CCL/ex/Nat.thy	Tue Mar 29 22:36:56 2011 +0200
+++ b/src/CCL/ex/Nat.thy	Tue Mar 29 23:15:25 2011 +0200
@@ -9,37 +9,44 @@
 imports Wfd
 begin
 
-consts
+definition not :: "i=>i"
+  where "not(b) == if b then false else true"
+
+definition add :: "[i,i]=>i"  (infixr "#+" 60)
+  where "a #+ b == nrec(a,b,%x g. succ(g))"
 
-  not   :: "i=>i"
-  add   :: "[i,i]=>i"            (infixr "#+" 60)
-  mult  :: "[i,i]=>i"            (infixr "#*" 60)
-  sub   :: "[i,i]=>i"            (infixr "#-" 60)
-  div   :: "[i,i]=>i"            (infixr "##" 60)
-  lt    :: "[i,i]=>i"            (infixr "#<" 60)
-  le    :: "[i,i]=>i"            (infixr "#<=" 60)
-  ackermann :: "[i,i]=>i"
+definition mult :: "[i,i]=>i"  (infixr "#*" 60)
+  where "a #* b == nrec(a,zero,%x g. b #+ g)"
 
-defs
-
-  not_def:     "not(b) == if b then false else true"
+definition sub :: "[i,i]=>i"  (infixr "#-" 60)
+  where
+    "a #- b ==
+      letrec sub x y be ncase(y,x,%yy. ncase(x,zero,%xx. sub(xx,yy)))
+      in sub(a,b)"
 
-  add_def:     "a #+ b == nrec(a,b,%x g. succ(g))"
-  mult_def:    "a #* b == nrec(a,zero,%x g. b #+ g)"
-  sub_def:     "a #- b == letrec sub x y be ncase(y,x,%yy. ncase(x,zero,%xx. sub(xx,yy)))
-                        in sub(a,b)"
-  le_def:     "a #<= b == letrec le x y be ncase(x,true,%xx. ncase(y,false,%yy. le(xx,yy)))
-                        in le(a,b)"
-  lt_def:     "a #< b == not(b #<= a)"
+definition le :: "[i,i]=>i"  (infixr "#<=" 60)
+  where
+    "a #<= b ==
+      letrec le x y be ncase(x,true,%xx. ncase(y,false,%yy. le(xx,yy)))
+      in le(a,b)"
+
+definition lt :: "[i,i]=>i"  (infixr "#<" 60)
+  where "a #< b == not(b #<= a)"
 
-  div_def:    "a ## b == letrec div x y be if x #< y then zero else succ(div(x#-y,y))
-                       in div(a,b)"
-  ack_def:
-  "ackermann(a,b) == letrec ack n m be ncase(n,succ(m),%x.
-                          ncase(m,ack(x,succ(zero)),%y. ack(x,ack(succ(x),y))))
-                    in ack(a,b)"
+definition div :: "[i,i]=>i"  (infixr "##" 60)
+  where
+    "a ## b ==
+      letrec div x y be if x #< y then zero else succ(div(x#-y,y))
+      in div(a,b)"
 
-lemmas nat_defs = not_def add_def mult_def sub_def le_def lt_def ack_def napply_def
+definition ackermann :: "[i,i]=>i"
+  where
+    "ackermann(a,b) ==
+      letrec ack n m be ncase(n,succ(m),%x.
+        ncase(m,ack(x,succ(zero)),%y. ack(x,ack(succ(x),y))))
+      in ack(a,b)"
+
+lemmas nat_defs = not_def add_def mult_def sub_def le_def lt_def ackermann_def napply_def
 
 lemma natBs [simp]:
   "not(true) = false"
@@ -94,7 +101,7 @@
 lemmas relI = NatPR_wf [THEN NatPR_wf [THEN lex_wf, THEN wfI]]
 
 lemma "[| a:Nat;  b:Nat |] ==> ackermann(a,b) : Nat"
-  apply (unfold ack_def)
+  apply (unfold ackermann_def)
   apply (tactic {* gen_ccs_tac @{context} [] 1 *})
   apply (erule NatPRI [THEN lexI1 [THEN relI]] NatPRI [THEN lexI2 [THEN relI]])+
   done
--- a/src/CCL/ex/Stream.thy	Tue Mar 29 22:36:56 2011 +0200
+++ b/src/CCL/ex/Stream.thy	Tue Mar 29 23:15:25 2011 +0200
@@ -9,15 +9,11 @@
 imports List
 begin
 
-consts
-  iter1   ::  "[i=>i,i]=>i"
-  iter2   ::  "[i=>i,i]=>i"
+definition iter1 :: "[i=>i,i]=>i"
+  where "iter1(f,a) == letrec iter x be x$iter(f(x)) in iter(a)"
 
-defs
-
-  iter1_def:   "iter1(f,a) == letrec iter x be x$iter(f(x)) in iter(a)"
-  iter2_def:   "iter2(f,a) == letrec iter x be x$map(f,iter(x)) in iter(a)"
-
+definition iter2 :: "[i=>i,i]=>i"
+  where "iter2(f,a) == letrec iter x be x$map(f,iter(x)) in iter(a)"
 
 (*
 Proving properties about infinite lists using coinduction:
@@ -30,9 +26,9 @@
 
 lemma map_comp:
   assumes 1: "l:Lists(A)"
-  shows "map(f o g,l) = map(f,map(g,l))"
+  shows "map(f \<circ> g,l) = map(f,map(g,l))"
   apply (tactic {* eq_coinduct3_tac @{context}
-    "{p. EX x y. p=<x,y> & (EX l:Lists (A) .x=map (f o g,l) & y=map (f,map (g,l)))}" 1 *})
+    "{p. EX x y. p=<x,y> & (EX l:Lists (A) .x=map (f \<circ> g,l) & y=map (f,map (g,l)))}" 1 *})
    apply (blast intro: 1)
   apply safe
   apply (drule ListsXH [THEN iffD1])