doc-src/Codegen/Thy/examples/collect_duplicates.ML
author haftmann
Tue, 07 Apr 2009 08:52:43 +0200
changeset 30880 257cbe43faa8
parent 30226 2f4684e2ea95
permissions -rw-r--r--
tuned manual
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
     1
structure HOL = 
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     2
struct
737a94f047e3 continued tutorial
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;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     8
23250
9886802cbbd6 updated documentation
haftmann
parents: 23107
diff changeset
     9
end; (*struct HOL*)
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    10
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    11
structure List = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    12
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    13
25370
8b1aa4357320 updated;
wenzelm
parents: 25182
diff changeset
    14
fun member A_ x (y :: ys) =
8b1aa4357320 updated;
wenzelm
parents: 25182
diff changeset
    15
  (if HOL.eqop A_ y x then true else member A_ x ys)
23850
f1434532a562 updated
haftmann
parents: 23250
diff changeset
    16
  | member 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
25182
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    23
fun collect_duplicates A_ xs ys (z :: zs) =
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    24
  (if List.member A_ z xs
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    25
    then (if List.member A_ z ys then collect_duplicates A_ xs ys zs
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    26
           else collect_duplicates A_ xs (z :: ys) zs)
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    27
    else collect_duplicates A_ (z :: xs) (z :: ys) zs)
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    28
  | collect_duplicates A_ xs ys [] = xs;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    29
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    30
end; (*struct Codegen*)