doc-src/IsarAdvanced/Codegen/Thy/examples/collect_duplicates.ML
author urbanc
Fri, 17 Nov 2006 17:32:30 +0100
changeset 21405 26b51f724fe6
parent 21190 08ec81dfc7fb
child 21452 f825e0b4d566
permissions -rw-r--r--
added an intro lemma for freshness of products; set up the simplifier so that it can deal with the compact and long notation for freshness constraints (FIXME: it should also be able to deal with the special case of freshness of atoms)
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
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     4
structure Code_Generator = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     5
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     6
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     7
type 'a eq = {eq_ : 'a -> 'a -> bool};
21190
08ec81dfc7fb (continued)
haftmann
parents: 21172
diff changeset
     8
fun eq (A_:'a eq) = #eq_ A_;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     9
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    10
end; (*struct Code_Generator*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    11
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    12
structure HOL = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    13
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    14
21190
08ec81dfc7fb (continued)
haftmann
parents: 21172
diff changeset
    15
fun op_eq (A_:'a Code_Generator.eq) a b = Code_Generator.eq A_ a b;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    16
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    17
end; (*struct HOL*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    18
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    19
structure List = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    20
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    21
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    22
fun memberl (A_1_:'a_1 Code_Generator.eq) x (y :: ys) =
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    23
  HOL.op_eq A_1_ x y orelse memberl A_1_ x ys
21172
eea3c9048c7a updated;
wenzelm
parents: 21147
diff changeset
    24
  | memberl (A_1_:'a_1 Code_Generator.eq) x [] = false;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    25
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    26
end; (*struct List*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    27
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    28
structure Codegen = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    29
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    30
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    31
fun collect_duplicates (A_:'a Code_Generator.eq) xs ys (z :: zs) =
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    32
  (if List.memberl A_ z xs
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    33
    then (if List.memberl A_ z ys then collect_duplicates A_ xs ys zs
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    34
           else collect_duplicates A_ xs (z :: ys) zs)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    35
    else collect_duplicates A_ (z :: xs) (z :: ys) zs)
21172
eea3c9048c7a updated;
wenzelm
parents: 21147
diff changeset
    36
  | collect_duplicates (A_:'a Code_Generator.eq) y ys [] = y;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    37
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    38
end; (*struct Codegen*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    39
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    40
end; (*struct ROOT*)