doc-src/IsarAdvanced/Codegen/Thy/examples/set_list.ML
author wenzelm
Wed, 07 May 2008 12:38:55 +0200
changeset 26840 ec46381f149d
parent 26513 6f306c8c2c54
permissions -rw-r--r--
added logic-specific sessions;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
     1
structure HOL = 
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
     2
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
     3
26513
6f306c8c2c54 explicit class "eq" for operational equality
haftmann
parents: 25370
diff changeset
     4
type 'a eq = {eq : 'a -> 'a -> bool};
6f306c8c2c54 explicit class "eq" for operational equality
haftmann
parents: 25370
diff changeset
     5
fun eq (A_:'a eq) = #eq A_;
6f306c8c2c54 explicit class "eq" for operational equality
haftmann
parents: 25370
diff changeset
     6
6f306c8c2c54 explicit class "eq" for operational equality
haftmann
parents: 25370
diff changeset
     7
fun eqop A_ a = eq A_ a;
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
     8
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
     9
end; (*struct HOL*)
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
    10
e3962371f568 updated doc
haftmann
parents:
diff changeset
    11
structure List = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
    12
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
    13
e3962371f568 updated doc
haftmann
parents:
diff changeset
    14
fun foldr f (x :: xs) a = f x (foldr f xs a)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    15
  | foldr f [] a = a;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    16
25370
8b1aa4357320 updated;
wenzelm
parents: 24421
diff changeset
    17
fun member A_ x (y :: ys) =
8b1aa4357320 updated;
wenzelm
parents: 24421
diff changeset
    18
  (if HOL.eqop A_ y x then true else member A_ x ys)
23850
f1434532a562 updated
haftmann
parents: 23250
diff changeset
    19
  | member A_ x [] = false;
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
    20
e3962371f568 updated doc
haftmann
parents:
diff changeset
    21
end; (*struct List*)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    22
e3962371f568 updated doc
haftmann
parents:
diff changeset
    23
structure Set = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
    24
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
    25
e3962371f568 updated doc
haftmann
parents:
diff changeset
    26
datatype 'a set = Set of 'a list;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    27
e3962371f568 updated doc
haftmann
parents:
diff changeset
    28
val empty : 'a set = Set [];
e3962371f568 updated doc
haftmann
parents:
diff changeset
    29
e3962371f568 updated doc
haftmann
parents:
diff changeset
    30
fun insert x (Set xs) = Set (x :: xs);
e3962371f568 updated doc
haftmann
parents:
diff changeset
    31
25370
8b1aa4357320 updated;
wenzelm
parents: 24421
diff changeset
    32
fun uniona xs (Set ys) = List.foldr insert ys xs;
23107
0c3c55b7c98f *** empty log message ***
haftmann
parents: 22798
diff changeset
    33
23850
f1434532a562 updated
haftmann
parents: 23250
diff changeset
    34
fun member A_ x (Set xs) = List.member A_ x xs;
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
    35
25370
8b1aa4357320 updated;
wenzelm
parents: 24421
diff changeset
    36
fun unionaa (Set xs) = List.foldr uniona xs empty;
24421
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
    37
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
    38
end; (*struct Set*)