doc-src/IsarAdvanced/Codegen/Thy/examples/collect_duplicates.ML
author wenzelm
Thu, 14 Jun 2007 23:04:40 +0200
changeset 23395 15fb6637690e
parent 23250 9886802cbbd6
child 23850 f1434532a562
permissions -rw-r--r--
method assumption: uniform treatment of prems as legacy feature;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     1
structure ROOT = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     2
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     3
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
     4
structure HOL = 
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     5
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     6
23107
0c3c55b7c98f *** empty log message ***
haftmann
parents: 22798
diff changeset
     7
type 'a eq = {eq : 'a -> 'a -> bool};
0c3c55b7c98f *** empty log message ***
haftmann
parents: 22798
diff changeset
     8
fun eq (A_:'a eq) = #eq A_;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     9
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
    10
end; (*struct HOL*)
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    11
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    12
structure List = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    13
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    14
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
    15
fun memberl A_ x (y :: ys) = HOL.eq A_ x y orelse memberl A_ x ys
22188
a63889770d57 adjusted manual to improved treatment of overloaded constants
haftmann
parents: 22015
diff changeset
    16
  | memberl A_ x [] = false;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    17
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    18
end; (*struct List*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    19
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    20
structure Codegen = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    21
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    22
22798
e3962371f568 updated doc
haftmann
parents: 22751
diff changeset
    23
fun collect_duplicates B_ xs ys (z :: zs) =
e3962371f568 updated doc
haftmann
parents: 22751
diff changeset
    24
  (if List.memberl B_ z xs
e3962371f568 updated doc
haftmann
parents: 22751
diff changeset
    25
    then (if List.memberl B_ z ys then collect_duplicates B_ xs ys zs
e3962371f568 updated doc
haftmann
parents: 22751
diff changeset
    26
           else collect_duplicates B_ xs (z :: ys) zs)
e3962371f568 updated doc
haftmann
parents: 22751
diff changeset
    27
    else collect_duplicates B_ (z :: xs) (z :: ys) zs)
e3962371f568 updated doc
haftmann
parents: 22751
diff changeset
    28
  | collect_duplicates B_ xs ys [] = xs;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    29
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    30
end; (*struct Codegen*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    31
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    32
end; (*struct ROOT*)