Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2017 Matthew Fluet. |
2 | * Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * Copyright (C) 1997-2000 NEC Research Institute. | |
5 | * | |
6 | * MLton is released under a BSD-style license. | |
7 | * See the file MLton-LICENSE for details. | |
8 | *) | |
9 | ||
10 | structure Region: REGION = | |
11 | struct | |
12 | ||
13 | datatype t = | |
14 | Bogus | |
15 | | T of {left: SourcePos.t, | |
16 | right: SourcePos.t} | |
17 | ||
18 | val bogus = Bogus | |
19 | ||
20 | local | |
21 | fun make f r = | |
22 | case r of | |
23 | Bogus => NONE | |
24 | | T r => SOME (f r) | |
25 | in | |
26 | val left = make #left | |
27 | val right = make #right | |
28 | end | |
29 | ||
30 | val extendRight = | |
31 | fn (Bogus, _) => Bogus | |
32 | | (T {left, ...}, right) => T {left = left, right = right} | |
33 | ||
34 | val toString = | |
35 | fn Bogus => SourcePos.toString (SourcePos.bogus) | |
36 | | T {left, right} => | |
37 | if SourcePos.isBogus left | |
38 | orelse SourcePos.isBogus right | |
39 | orelse not (SourcePos.fileEquals (left, right)) | |
40 | then SourcePos.toString left | |
41 | else concat [SourcePos.toString left, "-", | |
42 | SourcePos.posToString right] | |
43 | ||
44 | val layout = Layout.str o toString | |
45 | ||
46 | val make = T | |
47 | ||
48 | val append = | |
49 | fn (Bogus, r) => r | |
50 | | (r, Bogus) => r | |
51 | | (T {left, ...}, T {right, ...}) => T {left = left, right = right} | |
52 | ||
53 | fun compare (r, r') = | |
54 | case (left r, left r') of | |
55 | (NONE, NONE) => EQUAL | |
56 | | (NONE, _) => LESS | |
57 | | (_, NONE) => GREATER | |
58 | | (SOME p, SOME p') => SourcePos.compare (p, p') | |
59 | ||
60 | val compare = | |
61 | Trace.trace2 ("Region.compare", layout, layout, Relation.layout) compare | |
62 | ||
63 | fun equals (r, r') = compare (r, r') = EQUAL | |
64 | ||
65 | fun r <= r' = | |
66 | case compare (r, r') of | |
67 | EQUAL => true | |
68 | | GREATER => false | |
69 | | LESS => true | |
70 | ||
71 | structure Wrap = | |
72 | struct | |
73 | type region = t | |
74 | datatype 'a t = T of {node: 'a, | |
75 | region: region} | |
76 | ||
77 | fun node (T {node, ...}) = node | |
78 | fun region (T {region, ...}) = region | |
79 | fun makeRegion (node, region) = T {node = node, region = region} | |
80 | fun makeRegion' (node, left, right) = T {node = node, | |
81 | region = make {left = left, | |
82 | right = right}} | |
83 | ||
84 | fun dest (T {node, region}) = (node, region) | |
85 | end | |
86 | ||
87 | end |