Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009 Matthew Fluet. |
2 | * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | structure Relation0 = | |
10 | struct | |
11 | ||
12 | datatype t = datatype order | |
13 | ||
14 | val equals: t * t -> bool = op = | |
15 | ||
16 | val toString = | |
17 | fn EQUAL => "Equal" | |
18 | | GREATER => "Greater" | |
19 | | LESS => "Less" | |
20 | ||
21 | fun lessEqual {<, equals} = | |
22 | let | |
23 | fun a > b = b < a | |
24 | fun a <= b = a < b orelse equals (a, b) | |
25 | fun a >= b = b < a orelse equals (b, a) | |
26 | fun compare (a, b) = if a < b then LESS | |
27 | else if equals (a, b) then EQUAL | |
28 | else GREATER | |
29 | fun min (x, y) = if x < y then x else y | |
30 | fun max (x, y) = if x < y then y else x | |
31 | in {> = op >, <= = op <=, >= = op >=, | |
32 | compare = compare, min = min, max = max} | |
33 | end | |
34 | ||
35 | fun compare c = | |
36 | let fun equals (x, y) = (case c (x, y) of | |
37 | EQUAL => true | |
38 | | _ => false) | |
39 | fun x < y = (case c (x, y) of | |
40 | LESS => true | |
41 | | _ => false) | |
42 | fun x <= y = (case c (x, y) of | |
43 | LESS => true | |
44 | | EQUAL => true | |
45 | | _ => false) | |
46 | fun x > y = (case c (x, y) of | |
47 | GREATER => true | |
48 | | _ => false) | |
49 | fun x >= y = (case c (x, y) of | |
50 | GREATER => true | |
51 | | EQUAL => true | |
52 | | _ => false) | |
53 | fun max (x, y) = (case c (x, y) of | |
54 | GREATER => x | |
55 | | _ => y) | |
56 | fun min (x, y) = (case c (x, y) of | |
57 | GREATER => y | |
58 | | _ => x) | |
59 | in {equals = equals, | |
60 | < = op <, > = op >, <= = op <=, >= = op >=, | |
61 | min = min, max = max} | |
62 | end | |
63 | ||
64 | end |