1structure stringfindreplace :> stringfindreplace = 2struct 3 4datatype 'a trie = Nd of 'a option * (char, 'a trie) Binarymap.dict 5 6fun dictOf (Nd(_, d)) = d 7fun valueOf (Nd(v,_)) = v 8 9fun empty() = Nd (NONE, Binarymap.mkDict Char.compare) 10 11fun insert (t, s, v) = 12 let 13 fun recurse t ss = 14 let 15 val Nd (val0, dict) = t 16 in 17 case Substring.getc ss of 18 NONE => Nd(SOME v, dict) 19 | SOME (c, ss') => 20 let 21 val subt = case Binarymap.peek(dict, c) of 22 NONE => empty() 23 | SOME t => t 24 in 25 Nd(val0, Binarymap.insert(dict,c,recurse subt ss')) 26 end 27 end 28 in 29 recurse t (Substring.full s) 30 end 31 32fun foldl f acc t = 33 let 34 fun recurse k acc0 t = 35 let 36 val acc = case valueOf t of 37 NONE => acc0 38 | SOME v => f(k,v,acc0) 39 in 40 Binarymap.foldl (fn (c,t,a) => recurse (k ^ str c) a t) acc (dictOf t) 41 end 42 in 43 recurse "" acc t 44 end 45 46fun final_replacement s imaps = 47 case imaps of 48 [] => s 49 | (i, (repl, numtoremove)) :: rest => 50 let 51 val _ = i >= 0 orelse raise Fail "Negative index in alist" 52 val resti = i + numtoremove 53 in 54 String.extract(s,0, SOME i) ^ repl ^ 55 final_replacement (String.extract(s, resti, NONE)) 56 (map (fn (i,v) => (i - resti, v)) rest) 57 end 58 59fun foldcheck trie0 s = 60 let 61 val sz = size s 62 fun onestep i done cont k = 63 (* 64 cont is a map (alist) from indexes into the string to a pair of 65 a trie and an optional "best value to date" coupled with the number 66 of characters that best value is replacing. done is similar. 67 *) 68 if i >= sz then 69 let 70 fun updcurrent (i, (t, NONE)) = NONE 71 | updcurrent (i, (t, SOME v)) = SOME (i, v) 72 in 73 k (List.revAppend (done, List.mapPartial updcurrent cont)) 74 end 75 else 76 let 77 val c = String.sub(s,i) 78 fun newcellf inv old = 79 if inv then old 80 else 81 case Binarymap.peek(dictOf trie0, c) of 82 NONE => old 83 | SOME t => 84 (i, (t, Option.map (fn v => (v,1)) (valueOf t)))::old 85 fun updcells doneA continuingA cells invalidate k = 86 case cells of 87 [] => k doneA (List.rev (newcellf invalidate continuingA)) 88 | ((cell as (starti, (t, bestopt)))::rest) => 89 let 90 in 91 case Binarymap.peek(dictOf t, c) of 92 NONE => 93 (case bestopt of 94 NONE => updcells doneA continuingA 95 rest invalidate k 96 | SOME (v,c) => 97 updcells ((starti,(v,c)) :: doneA) continuingA 98 rest invalidate k) 99 | SOME t' => 100 (case valueOf t' of 101 NONE => updcells 102 doneA 103 ((starti,(t',bestopt)) :: continuingA) 104 rest 105 invalidate k 106 | SOME v' => 107 let 108 val cnt = i - starti + 1 109 in 110 updcells 111 doneA 112 ((starti, (t', SOME (v',cnt))) :: continuingA) 113 (List.filter (fn (j, _) => j > i) rest) 114 true 115 k 116 end) 117 end 118 in 119 updcells done [] cont false 120 (fn done => fn cont => onestep (i + 1) done cont k) 121 end 122 in 123 onestep 0 [] [] (fn m => final_replacement s m) 124 end 125 126fun subst theta = 127 let 128 fun foldthis ({redex,residue}, t) = 129 if size redex <> 0 then 130 insert(t, redex, residue) 131 else raise Fail "stringfindreplace.subst : redex is empty string" 132 val t = List.foldl foldthis (empty()) theta 133 in 134 foldcheck t 135 end 136 137end 138