doc-src/IsarAdvanced/Codegen/Thy/examples/set_list.ML
author haftmann
Thu, 26 Apr 2007 13:32:55 +0200
changeset 22798 e3962371f568
child 23107 0c3c55b7c98f
permissions -rw-r--r--
updated doc
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
22798
e3962371f568 updated doc
haftmann
parents:
diff changeset
     1
structure ROOT = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
     2
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
     3
e3962371f568 updated doc
haftmann
parents:
diff changeset
     4
structure Code_Generator = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
     5
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
     6
e3962371f568 updated doc
haftmann
parents:
diff changeset
     7
type 'a eq = {op_eq : 'a -> 'a -> bool};
e3962371f568 updated doc
haftmann
parents:
diff changeset
     8
fun op_eq (A_:'a eq) = #op_eq A_;
e3962371f568 updated doc
haftmann
parents:
diff changeset
     9
e3962371f568 updated doc
haftmann
parents:
diff changeset
    10
end; (*struct Code_Generator*)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    11
e3962371f568 updated doc
haftmann
parents:
diff changeset
    12
structure List = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
    13
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
    14
e3962371f568 updated doc
haftmann
parents:
diff changeset
    15
fun foldr f (x :: xs) a = f x (foldr f xs a)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    16
  | foldr f [] a = a;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    17
e3962371f568 updated doc
haftmann
parents:
diff changeset
    18
fun memberl A_ x (y :: ys) =
e3962371f568 updated doc
haftmann
parents:
diff changeset
    19
  Code_Generator.op_eq A_ x y orelse memberl A_ x ys
e3962371f568 updated doc
haftmann
parents:
diff changeset
    20
  | memberl A_ x [] = false;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    21
e3962371f568 updated doc
haftmann
parents:
diff changeset
    22
end; (*struct List*)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    23
e3962371f568 updated doc
haftmann
parents:
diff changeset
    24
structure Set = 
e3962371f568 updated doc
haftmann
parents:
diff changeset
    25
struct
e3962371f568 updated doc
haftmann
parents:
diff changeset
    26
e3962371f568 updated doc
haftmann
parents:
diff changeset
    27
datatype 'a set = Set of 'a list;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    28
e3962371f568 updated doc
haftmann
parents:
diff changeset
    29
fun opa A_ x (Set xs) = List.memberl A_ x xs;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    30
e3962371f568 updated doc
haftmann
parents:
diff changeset
    31
val empty : 'a set = Set [];
e3962371f568 updated doc
haftmann
parents:
diff changeset
    32
e3962371f568 updated doc
haftmann
parents:
diff changeset
    33
fun insert x (Set xs) = Set (x :: xs);
e3962371f568 updated doc
haftmann
parents:
diff changeset
    34
e3962371f568 updated doc
haftmann
parents:
diff changeset
    35
fun op_Un xs (Set ys) = List.foldr insert ys xs;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    36
e3962371f568 updated doc
haftmann
parents:
diff changeset
    37
fun union (Set xs) = List.foldr op_Un xs empty;
e3962371f568 updated doc
haftmann
parents:
diff changeset
    38
e3962371f568 updated doc
haftmann
parents:
diff changeset
    39
end; (*struct Set*)
e3962371f568 updated doc
haftmann
parents:
diff changeset
    40
e3962371f568 updated doc
haftmann
parents:
diff changeset
    41
end; (*struct ROOT*)