1(*
2 *  util/tuple.sml  --  functions on tuples
3 *
4 *  COPYRIGHT (c) 1997 by Martin Erwig.  See COPYRIGHT file for details.
5 *)
6
7structure UTuple =
8struct
9
10  (* building *)
11  fun pair x y = (x,y)
12  fun triple x y z = (x,y,z)
13
14  (* projection *)
15     (** pairs **)
16  fun swap (x,y) = (y,x)
17  fun p1 (x,y) = x
18  fun p2 (x,y) = y
19     (** triples **)
20  fun rotl (x,y,z) = (y,z,x)
21  fun t1  (x,y,z) = x
22  fun t2  (x,y,z) = y
23  fun t3  (x,y,z) = z
24  fun t12 (x,y,z) = (x,y)
25  fun t23 (x,y,z) = (y,z)
26  fun t13 (x,y,z) = (x,z)
27     (** quadruples **)
28  fun rotl (x,y,z,a) = (y,z,a,x)
29  fun q1  (x,y,z,a) = x
30  fun q2  (x,y,z,a) = y
31  fun q3  (x,y,z,a) = z
32  fun q4  (x,y,z,a) = a
33  fun q12 (x,y,z,a) = (x,y)
34  fun q23 (x,y,z,a) = (y,z)
35  fun q34 (x,y,z,a) = (z,a)
36      (* ... *)
37
38  (* extension *)
39     (** pairs **)
40  fun pL a (x,y) = (a,x,y)
41  fun pR a (x,y) = (x,y,a)
42     (** triples **)
43  fun tL a (x,y,z) = (a,x,y,z)
44  fun tR a (x,y,z) = (x,y,z,a)
45
46  (* distribution *)
47     (** plain pairs *)
48  fun P1 f (x,y) = (f x,y)
49  fun P2 f (x,y) = (x,f y)
50     (** plain pairs *)
51  fun T1 f (x,y,z) = (f x,y,z)
52  fun T2 f (x,y,z) = (x,f y,z)
53  fun T3 f (x,y,z) = (x,y,f z)
54
55
56  (* sectioning *)
57  fun secl f x = fn y=>f (x,y)
58  fun secr f y = fn x=>f (x,y)
59end
60