doc-src/IsarAdvanced/Codegen/Thy/examples/tree.ML
author wenzelm
Tue, 18 Mar 2008 20:34:26 +0100
changeset 26318 967323f93c67
parent 25731 b3e415b0cf5c
child 26513 6f306c8c2c54
permissions -rw-r--r--
updated generated files;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
23250
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
     1
structure HOL = 
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
     2
struct
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
     3
24421
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
     4
type 'a eq = {eqop : 'a -> 'a -> bool};
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
     5
fun eqop (A_:'a eq) = #eqop A_;
23250
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
     6
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
     7
type 'a ord = {less_eq : 'a -> 'a -> bool, less : 'a -> 'a -> bool};
926dde4d96de updated
haftmann
parents: 23850
diff changeset
     8
fun less_eq (A_:'a ord) = #less_eq A_;
926dde4d96de updated
haftmann
parents: 23850
diff changeset
     9
fun less (A_:'a ord) = #less A_;
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    10
23250
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
    11
end; (*struct HOL*)
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
    12
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    13
structure Orderings = 
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    14
struct
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    15
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    16
type 'a order = {Orderings__ord_order : 'a HOL.ord};
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    17
fun ord_order (A_:'a order) = #Orderings__ord_order A_;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    18
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    19
type 'a linorder = {Orderings__order_linorder : 'a order};
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    20
fun order_linorder (A_:'a linorder) = #Orderings__order_linorder A_;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    21
23250
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
    22
end; (*struct Orderings*)
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    23
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    24
structure Nat = 
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    25
struct
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    26
24421
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    27
datatype nat = Suc of nat | Zero_nat;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    28
25731
b3e415b0cf5c updated;
wenzelm
parents: 25182
diff changeset
    29
fun eqop_nat Zero_nat Zero_nat = true
b3e415b0cf5c updated;
wenzelm
parents: 25182
diff changeset
    30
  | eqop_nat (Suc m) (Suc n) = eqop_nat m n
b3e415b0cf5c updated;
wenzelm
parents: 25182
diff changeset
    31
  | eqop_nat Zero_nat (Suc a) = false
b3e415b0cf5c updated;
wenzelm
parents: 25182
diff changeset
    32
  | eqop_nat (Suc a) Zero_nat = false;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    33
24421
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    34
val eq_nat = {eqop = eqop_nat} : nat HOL.eq;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    35
26318
967323f93c67 updated generated files;
wenzelm
parents: 25731
diff changeset
    36
fun less_nat m (Suc n) = less_eq_nat m n
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    37
  | less_nat n Zero_nat = false
26318
967323f93c67 updated generated files;
wenzelm
parents: 25731
diff changeset
    38
and less_eq_nat (Suc m) n = less_nat m n
967323f93c67 updated generated files;
wenzelm
parents: 25731
diff changeset
    39
  | less_eq_nat Zero_nat n = true;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    40
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    41
val ord_nat = {less_eq = less_eq_nat, less = less_nat} : nat HOL.ord;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    42
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    43
val order_nat = {Orderings__ord_order = ord_nat} : nat Orderings.order;
23250
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
    44
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    45
val linorder_nat = {Orderings__order_linorder = order_nat} :
23250
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
    46
  nat Orderings.linorder;
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
    47
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    48
end; (*struct Nat*)
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    49
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    50
structure Codegen = 
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    51
struct
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    52
24421
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    53
datatype ('a, 'b) searchtree =
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    54
  Branch of ('a, 'b) searchtree * 'a * ('a, 'b) searchtree |
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    55
  Leaf of 'a * 'b;
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    56
25182
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    57
fun update (A1_, A2_) (it, entry) (Branch (t1, key, t2)) =
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    58
  (if HOL.less_eq ((Orderings.ord_order o Orderings.order_linorder) A2_)
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    59
        it key
25182
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    60
    then Branch (update (A1_, A2_) (it, entry) t1, key, t2)
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    61
    else Branch (t1, key, update (A1_, A2_) (it, entry) t2))
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    62
  | update (A1_, A2_) (it, entry) (Leaf (key, vala)) =
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    63
    (if HOL.eqop A1_ it key then Leaf (key, entry)
24193
926dde4d96de updated
haftmann
parents: 23850
diff changeset
    64
      else (if HOL.less_eq
25182
64e3f45dc6f4 updated;
wenzelm
parents: 24421
diff changeset
    65
                 ((Orderings.ord_order o Orderings.order_linorder) A2_) it
23250
9886802cbbd6 updated documentation
haftmann
parents: 23132
diff changeset
    66
                 key
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    67
             then Branch (Leaf (it, entry), it, Leaf (key, vala))
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    68
             else Branch (Leaf (key, vala), it, Leaf (it, entry))));
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    69
23132
ae52b82dc5d8 updated
haftmann
parents: 23107
diff changeset
    70
val example : (Nat.nat, (Nat.nat list)) searchtree =
24421
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    71
  update (Nat.eq_nat, Nat.linorder_nat)
23132
ae52b82dc5d8 updated
haftmann
parents: 23107
diff changeset
    72
    (Nat.Suc (Nat.Suc (Nat.Suc (Nat.Suc Nat.Zero_nat))),
ae52b82dc5d8 updated
haftmann
parents: 23107
diff changeset
    73
      [Nat.Suc (Nat.Suc Nat.Zero_nat), Nat.Suc (Nat.Suc Nat.Zero_nat)])
24421
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    74
    (update (Nat.eq_nat, Nat.linorder_nat)
23132
ae52b82dc5d8 updated
haftmann
parents: 23107
diff changeset
    75
      (Nat.Suc (Nat.Suc (Nat.Suc Nat.Zero_nat)),
ae52b82dc5d8 updated
haftmann
parents: 23107
diff changeset
    76
        [Nat.Suc (Nat.Suc (Nat.Suc Nat.Zero_nat))])
24421
acfb2413faa3 updated
haftmann
parents: 24193
diff changeset
    77
      (update (Nat.eq_nat, Nat.linorder_nat)
23132
ae52b82dc5d8 updated
haftmann
parents: 23107
diff changeset
    78
        (Nat.Suc (Nat.Suc Nat.Zero_nat), [Nat.Suc (Nat.Suc Nat.Zero_nat)])
ae52b82dc5d8 updated
haftmann
parents: 23107
diff changeset
    79
        (Leaf (Nat.Suc Nat.Zero_nat, []))));
22490
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    80
1822ec4fcecd added example file
haftmann
parents:
diff changeset
    81
end; (*struct Codegen*)