doc-src/Codegen/Thy/examples/example.ML
author haftmann
Tue, 07 Apr 2009 08:52:43 +0200
changeset 30880 257cbe43faa8
parent 30226 2f4684e2ea95
child 33707 68841fb382e0
permissions -rw-r--r--
tuned manual
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     1
structure Example = 
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     2
struct
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     3
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     4
fun foldl f a [] = a
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     5
  | foldl f a (x :: xs) = foldl f (f a x) xs;
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     6
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     7
fun rev xs = foldl (fn xsa => fn x => x :: xsa) [] xs;
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     8
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
     9
fun list_case f1 f2 (a :: lista) = f2 a lista
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    10
  | list_case f1 f2 [] = f1;
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    11
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    12
datatype 'a queue = AQueue of 'a list * 'a list;
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    13
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    14
val empty : 'a queue = AQueue ([], [])
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    15
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    16
fun dequeue (AQueue ([], [])) = (NONE, AQueue ([], []))
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    17
  | dequeue (AQueue (xs, y :: ys)) = (SOME y, AQueue (xs, ys))
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    18
  | dequeue (AQueue (v :: va, [])) =
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    19
    let
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    20
      val y :: ys = rev (v :: va);
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    21
    in
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    22
      (SOME y, AQueue ([], ys))
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    23
    end;
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    24
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    25
fun enqueue x (AQueue (xs, ys)) = AQueue (x :: xs, ys);
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    26
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    27
end; (*struct Example*)