src/Tools/Spec_Check/Examples.thy
author nipkow
Fri, 09 Jul 2021 10:36:20 +0200
changeset 74189 d4af818e0880
permissions -rw-r--r--
Backed out changeset fe8d0f4da0e6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
74189
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     1
theory Examples
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     2
imports Spec_Check
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     3
begin
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     4
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     5
section \<open>List examples\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     6
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     7
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     8
check_property "ALL xs. rev xs = xs";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
     9
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    10
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    11
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    12
check_property "ALL xs. rev (rev xs) = xs";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    13
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    14
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    15
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    16
section \<open>AList Specification\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    17
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    18
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    19
(* map_entry applies the function to the element *)
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    20
check_property "ALL k f xs. AList.lookup (op =) (AList.map_entry (op =) k f xs) k = Option.map f (AList.lookup (op =) xs k)";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    21
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    22
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    23
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    24
(* update always results in an entry *)
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    25
check_property "ALL k v xs. AList.defined (op =) (AList.update (op =) (k, v) xs) k";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    26
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    27
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    28
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    29
(* update always writes the value *)
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    30
check_property "ALL k v xs. AList.lookup (op =) (AList.update (op =) (k, v) xs) k = SOME v";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    31
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    32
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    33
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    34
(* default always results in an entry *)
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    35
check_property "ALL k v xs. AList.defined (op =) (AList.default (op =) (k, v) xs) k";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    36
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    37
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    38
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    39
(* delete always removes the entry *)
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    40
check_property "ALL k xs. not (AList.defined (op =) (AList.delete (op =) k xs) k)";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    41
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    42
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    43
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    44
(* default writes the entry iff it didn't exist *)
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    45
check_property "ALL k v xs. (AList.lookup (op =) (AList.default (op =) (k, v) xs) k = (if AList.defined (op =) xs k then AList.lookup (op =) xs k else SOME v))";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    46
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    47
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    48
section \<open>Examples on Types and Terms\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    49
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    50
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    51
check_property "ALL f g t. map_types (g o f) t = (map_types f o map_types g) t";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    52
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    53
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    54
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    55
check_property "ALL f g t. map_types (f o g) t = (map_types f o map_types g) t";
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    56
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    57
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    58
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    59
text \<open>One would think this holds:\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    60
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    61
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    62
check_property "ALL t ts. strip_comb (list_comb (t, ts)) = (t, ts)"
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    63
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    64
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    65
text \<open>But it only holds with this precondition:\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    66
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    67
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    68
check_property "ALL t ts. case t of _ $ _ => true | _ => strip_comb (list_comb (t, ts)) = (t, ts)"
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    69
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    70
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    71
section \<open>Some surprises\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    72
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    73
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    74
check_property "ALL Ts t. type_of1 (Ts, t) = fastype_of1 (Ts, t)"
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    75
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    76
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    77
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    78
ML_command \<open>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    79
val thy = \<^theory>;
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    80
check_property "ALL t u. if Pattern.matches thy (t, u) then Term.could_unify (t, u) else true"
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    81
\<close>
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    82
d4af818e0880 Backed out changeset fe8d0f4da0e6
nipkow
parents:
diff changeset
    83
end