doc-src/IsarAdvanced/Codegen/Thy/examples/lexicographic.ML
author haftmann
Fri, 05 Jan 2007 14:31:44 +0100
changeset 22015 12b94d7f7e1f
parent 21993 4b802a9e0738
child 22188 a63889770d57
permissions -rw-r--r--
adaptions
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
21452
f825e0b4d566 final draft
haftmann
parents: 21190
diff changeset
     7
type 'a eq = {op_eq_ : 'a -> 'a -> bool};
f825e0b4d566 final draft
haftmann
parents: 21190
diff changeset
     8
fun op_eq (A_:'a eq) = #op_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 Product_Type = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    13
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    14
22015
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    15
fun op_eq_prod (A_:'a Code_Generator.eq) (B_:'b Code_Generator.eq)
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    16
  (x1, y1) (x2, y2) =
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    17
  Code_Generator.op_eq A_ x1 x2 andalso Code_Generator.op_eq B_ y1 y2;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    18
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    19
end; (*struct Product_Type*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    20
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    21
structure Orderings = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    22
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    23
21190
08ec81dfc7fb (continued)
haftmann
parents: 21147
diff changeset
    24
type 'a ord = {less_eq_ : 'a -> 'a -> bool, less_ : 'a -> 'a -> bool};
08ec81dfc7fb (continued)
haftmann
parents: 21147
diff changeset
    25
fun less_eq (A_:'a ord) = #less_eq_ A_;
08ec81dfc7fb (continued)
haftmann
parents: 21147
diff changeset
    26
fun less (A_:'a ord) = #less_ A_;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    27
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    28
end; (*struct Orderings*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    29
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    30
structure Codegen = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    31
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    32
21190
08ec81dfc7fb (continued)
haftmann
parents: 21147
diff changeset
    33
fun less_prod (B_:'b Code_Generator.eq * 'b Orderings.ord)
08ec81dfc7fb (continued)
haftmann
parents: 21147
diff changeset
    34
  (C_:'c Code_Generator.eq * 'c Orderings.ord) p1 p2 =
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    35
  let
21993
4b802a9e0738 updated manual
haftmann
parents: 21452
diff changeset
    36
    val (x1, y1) = p1;
4b802a9e0738 updated manual
haftmann
parents: 21452
diff changeset
    37
    val (x2, y2) = p2;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    38
  in
22015
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    39
    Orderings.less (#2 B_) x1 x2 orelse
21993
4b802a9e0738 updated manual
haftmann
parents: 21452
diff changeset
    40
      Code_Generator.op_eq (#1 B_) x1 x2 andalso
22015
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    41
        Orderings.less (#2 C_) y1 y2
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    42
  end;
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    43
21190
08ec81dfc7fb (continued)
haftmann
parents: 21147
diff changeset
    44
fun less_eq_prod (B_:'b Code_Generator.eq * 'b Orderings.ord)
08ec81dfc7fb (continued)
haftmann
parents: 21147
diff changeset
    45
  (C_:'c Code_Generator.eq * 'c Orderings.ord) p1 p2 =
22015
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    46
  less_prod ((#1 B_), (#2 B_)) ((#1 C_), (#2 C_)) p1 p2 orelse
12b94d7f7e1f adaptions
haftmann
parents: 21993
diff changeset
    47
    Product_Type.op_eq_prod (#1 B_) (#1 C_) p1 p2;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    48
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    49
end; (*struct Codegen*)
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    50
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    51
end; (*struct ROOT*)