Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009,2014 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 String: STRING = | |
10 | struct | |
11 | open String1 | |
12 | ||
13 | fun unfold (n, a, f) = | |
14 | let | |
15 | val r = ref a | |
16 | in | |
17 | tabulate (n, fn _ => | |
18 | let | |
19 | val (b, a) = f (!r) | |
20 | val () = r := a | |
21 | in | |
22 | b | |
23 | end) | |
24 | end | |
25 | ||
26 | fun concatV ss = | |
27 | case Vector.length ss of | |
28 | 0 => "" | |
29 | | 1 => Vector.sub (ss, 0) | |
30 | | _ => | |
31 | let | |
32 | val n = | |
33 | Vector.fold (ss, 0, fn (s, n) => n + size s) | |
34 | val a = Array.new (n, #"a") | |
35 | val _ = | |
36 | Vector.fold | |
37 | (ss, 0, fn (s, i) => | |
38 | fold (s, i, fn (c, i) => | |
39 | (Array.update (a, i, c); | |
40 | i + 1))) | |
41 | in | |
42 | tabulate (n, fn i => Array.sub (a, i)) | |
43 | end | |
44 | ||
45 | fun implodeV cs = | |
46 | tabulate (Vector.length cs, fn i => Vector.sub (cs, i)) | |
47 | ||
48 | fun existsi (s, f) = Int.exists (0, size s, fn i => f (i, sub (s, i))) | |
49 | ||
50 | fun exists (s, f) = existsi (s, f o #2) | |
51 | ||
52 | fun keepAll (s: t, f: char -> bool): t = | |
53 | implode (List.rev | |
54 | (fold (s, [], fn (c, ac) => if f c then c :: ac else ac))) | |
55 | ||
56 | fun memoizeList (init: string -> 'a, l: (t * 'a) list): t -> 'a = | |
57 | let | |
58 | val set: (word * t * 'a) HashSet.t = HashSet.new {hash = #1} | |
59 | fun lookupOrInsert (s, f) = | |
60 | let | |
61 | val hash = hash s | |
62 | in HashSet.lookupOrInsert | |
63 | (set, hash, | |
64 | fn (hash', s', _) => hash = hash' andalso s = s', | |
65 | fn () => (hash, s, f ())) | |
66 | end | |
67 | val _ = | |
68 | List.foreach (l, fn (s, a) => | |
69 | ignore (lookupOrInsert (s, fn () => a))) | |
70 | in | |
71 | fn s => #3 (lookupOrInsert (s, fn () => init s)) | |
72 | end | |
73 | ||
74 | fun memoize init = memoizeList (init, []) | |
75 | ||
76 | fun posToLineCol (s: string): int -> {line: int, col: int} = | |
77 | let | |
78 | open Int | |
79 | val lineStarts = | |
80 | Array.fromList | |
81 | (List.rev (foldi (s, [0], fn (i, c, is) => | |
82 | if c = #"\n" | |
83 | then (i + 1) :: is | |
84 | else is))) | |
85 | fun find (pos: int) = | |
86 | let | |
87 | val line = | |
88 | valOf (BinarySearch.largest (lineStarts, fn x => x <= pos)) | |
89 | (* The 1+'s are to make stuff one based *) | |
90 | in {line = 1 + line, | |
91 | col = 1 + pos - Array.sub (lineStarts, line)} | |
92 | end | |
93 | in find | |
94 | end | |
95 | ||
96 | fun substituteFirst (s, {substring, replacement}) = | |
97 | case findSubstring (s, {substring = substring}) of | |
98 | NONE => s | |
99 | | SOME i => | |
100 | let | |
101 | val n = length substring | |
102 | val prefix = Substring.substring (s, {start = 0, length = i}) | |
103 | val suffix = Substring.extract (s, i + n, NONE) | |
104 | in | |
105 | Substring.concat [prefix, Substring.full replacement, suffix] | |
106 | end | |
107 | fun substituteAll (s, {substring, replacement}) = | |
108 | case findSubstring (s, {substring = substring}) of | |
109 | NONE => s | |
110 | | SOME i => | |
111 | let | |
112 | val ls = length s | |
113 | val lss = length substring | |
114 | val prefix = dropSuffix (s, ls - i) | |
115 | val suffix = substituteAll (dropPrefix (s, i + lss), | |
116 | {substring = substring, | |
117 | replacement = replacement}) | |
118 | in | |
119 | concat [prefix, replacement, suffix] | |
120 | end | |
121 | end | |
122 | ||
123 | structure ZString = String (* CM bug ?? -- see instream.sml *) |