doc-src/Codegen/Thy/examples/example.ML
author haftmann
Tue, 17 Aug 2010 14:19:12 +0200
changeset 38460 628fee3eb449
parent 37610 1b09880d9734
child 48863 881e8a96e617
permissions -rw-r--r--
nicer code for rev
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
34156
3a7937841585 Changes in generated code, apparently caused by changes to the code generation system itself.
paulson
parents: 33707
diff changeset
     1
structure Example : sig
38460
628fee3eb449 nicer code for rev
haftmann
parents: 37610
diff changeset
     2
  val id : 'a -> 'a
628fee3eb449 nicer code for rev
haftmann
parents: 37610
diff changeset
     3
  val fold : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
34156
3a7937841585 Changes in generated code, apparently caused by changes to the code generation system itself.
paulson
parents: 33707
diff changeset
     4
  val rev : 'a list -> 'a list
3a7937841585 Changes in generated code, apparently caused by changes to the code generation system itself.
paulson
parents: 33707
diff changeset
     5
  datatype 'a queue = AQueue of 'a list * 'a list
3a7937841585 Changes in generated code, apparently caused by changes to the code generation system itself.
paulson
parents: 33707
diff changeset
     6
  val empty : 'a queue
3a7937841585 Changes in generated code, apparently caused by changes to the code generation system itself.
paulson
parents: 33707
diff changeset
     7
  val dequeue : 'a queue -> 'a option * 'a queue
3a7937841585 Changes in generated code, apparently caused by changes to the code generation system itself.
paulson
parents: 33707
diff changeset
     8
  val enqueue : 'a -> 'a queue -> 'a queue
3a7937841585 Changes in generated code, apparently caused by changes to the code generation system itself.
paulson
parents: 33707
diff changeset
     9
end = struct
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    10
38460
628fee3eb449 nicer code for rev
haftmann
parents: 37610
diff changeset
    11
fun id x = (fn xa => xa) x;
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    12
38460
628fee3eb449 nicer code for rev
haftmann
parents: 37610
diff changeset
    13
fun fold f [] = id
628fee3eb449 nicer code for rev
haftmann
parents: 37610
diff changeset
    14
  | fold f (x :: xs) = fold f xs o f x;
628fee3eb449 nicer code for rev
haftmann
parents: 37610
diff changeset
    15
628fee3eb449 nicer code for rev
haftmann
parents: 37610
diff changeset
    16
fun rev xs = fold (fn a => fn b => a :: b) xs [];
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    17
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    18
datatype 'a queue = AQueue of 'a list * 'a list;
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    19
33707
68841fb382e0 dropped obsolete documentation; updated generated sources
haftmann
parents: 30226
diff changeset
    20
val empty : 'a queue = AQueue ([], []);
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    21
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    22
fun dequeue (AQueue ([], [])) = (NONE, AQueue ([], []))
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    23
  | dequeue (AQueue (xs, y :: ys)) = (SOME y, AQueue (xs, ys))
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    24
  | dequeue (AQueue (v :: va, [])) =
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    25
    let
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    26
      val y :: ys = rev (v :: va);
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    27
    in
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    28
      (SOME y, AQueue ([], ys))
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    29
    end;
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    30
29798
6df726203e39 proper datatype abstraction example
haftmann
parents: 29297
diff changeset
    31
fun enqueue x (AQueue (xs, ys)) = AQueue (x :: xs, ys);
28421
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    32
05d202350b8d reorganized examples
haftmann
parents:
diff changeset
    33
end; (*struct Example*)