doc-src/IsarAdvanced/Codegen/Thy/examples/set_list.ML
author haftmann
Fri, 24 Aug 2007 14:14:17 +0200
changeset 24421 acfb2413faa3
parent 23850 f1434532a562
child 25370 8b1aa4357320
permissions -rw-r--r--
updated
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
24421
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
     4
type 'a eq = {eqop : 'a -> 'a -> bool};
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
     5
fun eqop (A_:'a eq) = #eqop A_;
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
     6
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
     7
end; (*struct HOL*)
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
     8
e3962371f568 updated doc
haftmann
parents:
diff changeset
     9
structure List = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
    10
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
    11
e3962371f568 updated doc
haftmann
parents:
diff changeset
    12
fun foldr f (x :: xs) a = f x (foldr f xs a)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    13
  | foldr f [] a = a;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    14
24421
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
    15
fun member A_ x (y :: ys) = HOL.eqop A_ x y orelse member A_ x ys
23850
f1434532a562 updated
haftmann
parents: 23250
diff changeset
    16
  | member A_ x [] = false;
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
    17
e3962371f568 updated doc
haftmann
parents:
diff changeset
    18
end; (*struct List*)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    19
e3962371f568 updated doc
haftmann
parents:
diff changeset
    20
structure Set = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
    21
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
    22
e3962371f568 updated doc
haftmann
parents:
diff changeset
    23
datatype 'a set = Set of 'a list;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    24
e3962371f568 updated doc
haftmann
parents:
diff changeset
    25
val empty : 'a set = Set [];
e3962371f568 updated doc
haftmann
parents:
diff changeset
    26
e3962371f568 updated doc
haftmann
parents:
diff changeset
    27
fun insert x (Set xs) = Set (x :: xs);
e3962371f568 updated doc
haftmann
parents:
diff changeset
    28
24421
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
    29
fun union xs (Set ys) = List.foldr insert ys xs;
23107
0c3c55b7c98f *** empty log message ***
haftmann
parents: 22798
diff changeset
    30
23850
f1434532a562 updated
haftmann
parents: 23250
diff changeset
    31
fun member A_ x (Set xs) = List.member A_ x xs;
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
    32
24421
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
    33
fun uniona (Set xs) = List.foldr union xs empty;
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
    34
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
    35
end; (*struct Set*)