doc-src/IsarAdvanced/Codegen/Thy/examples/pick2.ML
author haftmann
Tue, 15 Jul 2008 16:02:07 +0200
changeset 27609 b23c9ad0fe7d
parent 26318 967323f93c67
permissions -rw-r--r--
tuned code theorem bookkeeping
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
21190
08ec81dfc7fb (continued)
haftmann
parents: 21172
diff changeset
     1
structure Nat = 
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     2
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     3
24421
acfb2413faa3 updated
haftmann
parents: 23850
diff changeset
     4
datatype nat = Suc of nat | Zero_nat;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
     5
26318
967323f93c67 updated generated files;
wenzelm
parents: 24421
diff changeset
     6
fun less_nat m (Suc n) = less_eq_nat m n
21994
dfa5133dbe73 updated manual
haftmann
parents: 21993
diff changeset
     7
  | less_nat n Zero_nat = false
26318
967323f93c67 updated generated files;
wenzelm
parents: 24421
diff changeset
     8
and less_eq_nat (Suc m) n = less_nat m n
967323f93c67 updated generated files;
wenzelm
parents: 24421
diff changeset
     9
  | less_eq_nat Zero_nat n = true;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    10
21994
dfa5133dbe73 updated manual
haftmann
parents: 21993
diff changeset
    11
fun minus_nat (Suc m) (Suc n) = minus_nat m n
dfa5133dbe73 updated manual
haftmann
parents: 21993
diff changeset
    12
  | minus_nat Zero_nat n = Zero_nat
22751
1bfd75c1f232 updated
haftmann
parents: 22386
diff changeset
    13
  | minus_nat m Zero_nat = m;
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    14
21190
08ec81dfc7fb (continued)
haftmann
parents: 21172
diff changeset
    15
end; (*struct Nat*)
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    16
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    17
structure Codegen = 
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    18
struct
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    19
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    20
fun pick ((k, v) :: xs) n =
21190
08ec81dfc7fb (continued)
haftmann
parents: 21172
diff changeset
    21
  (if Nat.less_nat n k then v else pick xs (Nat.minus_nat n k));
21147
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    22
737a94f047e3 continued tutorial
haftmann
parents:
diff changeset
    23
end; (*struct Codegen*)