src/HOL/ex/Recdef.ML
author wenzelm
Mon, 03 Nov 1997 12:13:18 +0100
changeset 4089 96fba19bcbe2
parent 3919 c036caebfc75
child 4423 a129b817b58a
permissions -rw-r--r--
isatool fixclasimp;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3417
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     1
(*  Title:      HOL/ex/Recdef.ML
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     2
    ID:         $Id$
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     3
    Author:     Konrad Lawrence C Paulson
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     4
    Copyright   1997  University of Cambridge
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     5
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     6
A few proofs to demonstrate the functions defined in Recdef.thy
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     7
Lemma statements from Konrad Slind's Web site
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     8
*)
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
     9
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    10
open Recdef;
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    11
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    12
Addsimps qsort.rules;
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    13
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    14
goal thy "(x mem qsort (ord,l)) = (x mem l)";
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    15
by (res_inst_tac [("u","ord"),("v","l")] qsort.induct 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3919
diff changeset
    16
by (ALLGOALS (asm_simp_tac (simpset() addsplits [expand_if])));
3417
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    17
by (Blast_tac 1);
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    18
qed "qsort_mem_stable";
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    19
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    20
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    21
(** The silly g function: example of nested recursion **)
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    22
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    23
Addsimps g.rules;
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    24
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    25
goal thy "g x < Suc x";
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    26
by (res_inst_tac [("u","x")] g.induct 1);
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    27
by (Auto_tac());
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    28
by (trans_tac 1);
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    29
qed "g_terminates";
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    30
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    31
goal thy "g x = 0";
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    32
by (res_inst_tac [("u","x")] g.induct 1);
4089
96fba19bcbe2 isatool fixclasimp;
wenzelm
parents: 3919
diff changeset
    33
by (ALLGOALS (asm_simp_tac (simpset() addsimps [g_terminates])));
3417
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    34
qed "g_zero";
58ccb80eb50a New example theory: Recdef
paulson
parents:
diff changeset
    35
3590
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    36
(*** the contrived `mapf' ***)
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    37
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    38
(* proving the termination condition: *)
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    39
val [tc] = mapf.tcs;
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    40
goalw_cterm [] (cterm_of (sign_of thy) (HOLogic.mk_Trueprop tc));
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    41
br allI 1;
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    42
by(case_tac "n=0" 1);
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    43
by(ALLGOALS Asm_simp_tac);
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    44
val lemma = result();
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    45
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    46
(* removing the termination condition from the generated thms: *)
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    47
val [mapf_0,mapf_Suc] = mapf.rules;
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    48
val mapf_Suc = lemma RS mapf_Suc;
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    49
4d307341d0af Added example mapf which requires a special congruence rule.
nipkow
parents: 3417
diff changeset
    50
val mapf_induct = lemma RS mapf.induct;