1signature LIST_PAIR =
2sig
3  exception UnequalLengths
4  val zip   : 'a list * 'b list -> ('a * 'b) list
5  val zipEq : 'a list * 'b list -> ('a * 'b) list
6  val unzip : ('a * 'b) list -> 'a list * 'b list
7  val app   : ('a * 'b -> unit) -> 'a list * 'b list -> unit
8  val appEq : ('a * 'b -> unit) -> 'a list * 'b list -> unit
9  val map   : ('a * 'b -> 'c) -> 'a list * 'b list -> 'c list
10  val mapEq : ('a * 'b -> 'c) -> 'a list * 'b list -> 'c list
11  val foldl   : ('a * 'b * 'c -> 'c)
12                  -> 'c -> 'a list * 'b list -> 'c
13  val foldr   : ('a * 'b * 'c -> 'c)
14                  -> 'c -> 'a list * 'b list -> 'c
15  val foldlEq : ('a * 'b * 'c -> 'c)
16                  -> 'c -> 'a list * 'b list -> 'c
17  val foldrEq : ('a * 'b * 'c -> 'c)
18                  -> 'c -> 'a list * 'b list -> 'c
19  val all    : ('a * 'b -> bool) -> 'a list * 'b list -> bool
20  val exists : ('a * 'b -> bool) -> 'a list * 'b list -> bool
21  val allEq : ('a * 'b -> bool) -> 'a list * 'b list -> bool
22end
23
24structure ListPair :> LIST_PAIR =
25struct
26  open ListPair
27  exception UnequalLengths
28  fun zipEq (xs, ys) =
29    let fun h (x::xr) (y::yr) res = h xr yr ((x, y) :: res)
30          | h []      []      res = List.rev res
31          | h _       _       res = raise UnequalLengths
32    in h xs ys [] end
33
34  fun mapEq f (xs, ys) =
35    let fun h (x::xr) (y::yr) res = h xr yr (f(x, y) :: res)
36          | h []      []      res = List.rev res
37          | h _       _       res = raise UnequalLengths
38    in h xs ys [] end
39
40  fun appEq f (xs, ys) =
41    let fun h (x::xr) (y::yr) = (f (x, y); h xr yr)
42          | h []      []      = ()
43          | h _       _       = raise UnequalLengths
44    in h xs ys end
45
46  fun allEq p (xs, ys) =
47    let fun h (x::xr) (y::yr) = p(x, y) andalso h xr yr
48          | h []      []      = true
49          | h _       _       = false
50    in h xs ys end
51
52
53  fun foldlEq f e (xs, ys) =
54    let fun h e (x::xr) (y::yr) = h (f(x, y, e)) xr yr
55          | h e []      []      = e
56          | h e _       _       = raise UnequalLengths
57    in h e xs ys end
58
59  fun foldrEq f e (xs, ys) = foldlEq f e (List.rev xs, List.rev ys)
60end
61
62signature VECTOR =
63sig
64  type 'a vector = 'a Vector.vector
65  val maxLen : int
66  val fromList : 'a list -> 'a vector
67  val tabulate : int * (int -> 'a) -> 'a vector
68  val length : 'a vector -> int
69  val sub : 'a vector * int -> 'a
70  val update : 'a vector * int * 'a -> 'a vector
71  val concat : 'a vector list -> 'a vector
72  val appi : (int * 'a -> unit) -> 'a vector -> unit
73  val app  : ('a -> unit) -> 'a vector -> unit
74  val mapi : (int * 'a -> 'b) -> 'a vector -> 'b vector
75  val map  : ('a -> 'b) -> 'a vector -> 'b vector
76  val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b
77  val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b
78  val foldl  : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
79  val foldr  : ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
80  val findi : (int * 'a -> bool)
81                -> 'a vector -> (int * 'a) option
82  val find  : ('a -> bool) -> 'a vector -> 'a option
83  val exists : ('a -> bool) -> 'a vector -> bool
84  val all : ('a -> bool) -> 'a vector -> bool
85  val collate : ('a * 'a -> order) -> 'a vector * 'a vector -> order
86end
87
88structure MosmlVector = Vector
89structure MosmlArray = Array
90
91structure Vector :> VECTOR =
92struct
93  structure V = MosmlVector
94  open V
95  fun update (v,i,e) =
96      tabulate (length v, (fn j => if j = i then e else sub(v,j)))
97  fun appi f v = V.appi f (v,0,NONE)
98  fun mapi f v = V.mapi f (v,0,NONE)
99  fun foldli f b v = V.foldli f b (v,0,NONE)
100  fun foldri f b v = V.foldri f b (v,0,NONE)
101  fun findi P v = let
102    val sz = length v
103    fun recurse i =
104        if i < sz then let
105            val pr = (i,sub(v,i))
106          in
107            if P pr then SOME pr else recurse (i + 1)
108          end
109        else NONE
110  in
111    recurse 0
112  end
113  fun find P v = Option.map #2 (findi (P o #2) v)
114  fun exists P v = isSome (find P v)
115  fun all P v = not (exists (not o P) v)
116  fun collate cmp (a1, a2) = let
117    val sz1 = length a1 and sz2 = length a2
118    fun recurse i =
119        if i < sz1 then
120          if i < sz2 then
121            case cmp(sub(a1,i), sub(a2,i)) of
122              EQUAL => recurse (i + 1)
123            | x => x
124          else GREATER
125        else if i < sz2 then LESS
126        else EQUAL
127  in
128    recurse 0
129  end
130
131end
132
133signature VECTOR_SLICE = sig
134  type 'a slice
135  val length : 'a slice -> int
136  val sub : 'a slice * int -> 'a
137  val full : 'a Vector.vector -> 'a slice
138  val slice : 'a Vector.vector * int * int option -> 'a slice
139  val subslice : 'a slice * int * int option -> 'a slice
140  val base : 'a slice -> 'a Vector.vector * int * int
141  val vector : 'a slice -> 'a Vector.vector
142  val concat : 'a slice list -> 'a Vector.vector
143  val isEmpty : 'a slice -> bool
144  val getItem : 'a slice -> ('a * 'a slice) option
145  val appi : (int * 'a -> unit) -> 'a slice -> unit
146  val app  : ('a -> unit) -> 'a slice -> unit
147  val mapi : (int * 'a -> 'b) -> 'a slice -> 'b Vector.vector
148  val map  : ('a -> 'b) -> 'a slice -> 'b Vector.vector
149  val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
150  val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
151  val foldl  : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
152  val foldr  : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
153  val findi : (int * 'a -> bool)
154                -> 'a slice -> (int * 'a) option
155  val find  : ('a -> bool) -> 'a slice -> 'a option
156  val exists : ('a -> bool) -> 'a slice -> bool
157  val all : ('a -> bool) -> 'a slice -> bool
158  val collate : ('a * 'a -> order)
159                  -> 'a slice * 'a slice -> order
160end
161
162structure VectorSlice :> VECTOR_SLICE =
163struct
164  type 'a slice = ('a Vector.vector * int * int)
165  val vlen = Vector.length
166  val vsub = Vector.sub
167  fun length (v,i,sz) = sz
168  fun isEmpty (v,i,sz) = sz = 0
169  fun sub ((v,i,sz), j) = if j < 0 orelse sz <= j then raise Subscript
170                          else vsub(v, i + j)
171  fun getItem (v,i,sz) = if sz = 0 then NONE
172                         else SOME (vsub(v,i), (v,i+1,sz-1))
173  fun full v = (v,0,vlen v)
174  fun slice (v,i,NONE) = if i < 0 orelse vlen v < i then raise Subscript
175                         else (v,i,vlen v - i)
176    | slice (v,i,SOME sz) = if i < 0 orelse sz < 0 orelse vlen v < i + sz then
177                              raise Subscript
178                            else (v,i,sz)
179  fun subslice ((v,i,sz), j, NONE) = if j < 0 orelse sz < j then raise Subscript
180                                     else (v,i+j,sz - j)
181    | subslice ((v,i,sz), j, SOME sz') =
182      if j < 0 orelse sz' < 0 orelse sz < j + sz' then raise Subscript
183      else (v,i+j,sz')
184  fun base v : 'a slice = v
185  fun vector (sl as (v,i,sz)) = Vector.tabulate(sz, (fn i => sub(sl, i)))
186  fun concat sls =
187      case sls of
188        [] => Vector.fromList []
189      | [sl] => vector sl
190      | _ => let
191          val combinedsz = List.foldl (fn (sl,a) => a + length sl) 0 sls
192                           handle Overflow => raise Size
193          val _ = if combinedsz > Vector.maxLen then raise Size else ()
194          val sls_r = ref sls
195          val i_r = ref 0
196          fun tabthis i = let
197            val sl = hd (!sls_r)
198          in
199            if i - !i_r >= length sl then
200              (i_r := !i_r + length sl;
201               sls_r := tl (!sls_r);
202               tabthis i)
203            else sub(sl, i - !i_r)
204          end
205        in
206          Vector.tabulate(combinedsz, tabthis)
207        end
208
209  fun appi f sl = let
210    fun recurse i = if i < length sl then (f(i, sub(sl,i)); recurse (i + 1))
211                    else ()
212  in
213    recurse 0
214  end
215  fun app f = appi (f o #2)
216
217  fun mapi f sl = Vector.tabulate(length sl, (fn i => f(i,sub(sl,i))))
218  fun map f = mapi (f o #2)
219  fun foldli f b sl = let
220    val sz = length sl
221    fun recurse acc i = if i < sz then recurse (f(i,sub(sl,i),acc)) (i + 1)
222                        else acc
223  in
224    recurse b 0
225  end
226  fun foldri f b sl = let
227    fun recurse acc i = if i < 0 then acc
228                        else recurse (f(i,sub(sl,i),acc)) (i - 1)
229  in
230    recurse b (length sl - 1)
231  end
232  fun foldl f = foldli (fn (_,e,b) => f (e,b))
233  fun foldr f = foldri (fn (_,e,b) => f (e,b))
234  fun findi P v = let
235    val sz = length v
236    fun recurse i =
237        if i < sz then let
238            val pr = (i,sub(v,i))
239          in
240            if P pr then SOME pr else recurse (i + 1)
241          end
242        else NONE
243  in
244    recurse 0
245  end
246  fun find P v = Option.map #2 (findi (P o #2) v)
247  fun exists P v = isSome (find P v)
248  fun all P v = not (exists (not o P) v)
249  fun collate cmp (a1, a2) = let
250    val sz1 = length a1 and sz2 = length a2
251    fun recurse i =
252        if i < sz1 then
253          if i < sz2 then
254            case cmp(sub(a1,i), sub(a2,i)) of
255              EQUAL => recurse (i + 1)
256            | x => x
257          else GREATER
258        else if i < sz2 then LESS
259        else EQUAL
260  in
261    recurse 0
262  end
263
264end
265
266
267signature ARRAY =
268sig
269  type 'a array = 'a Array.array
270  type 'a vector = 'a Vector.vector
271  val maxLen : int
272  val array : int * 'a -> 'a array
273  val fromList : 'a list -> 'a array
274  val tabulate : int * (int -> 'a) -> 'a array
275  val length : 'a array -> int
276  val sub : 'a array * int -> 'a
277  val update : 'a array * int * 'a -> unit
278  val vector : 'a array -> 'a vector
279  val copy    : {src : 'a array, dst : 'a array, di : int} -> unit
280  val copyVec : {src : 'a vector, dst : 'a array, di : int} -> unit
281  val appi : (int * 'a -> unit) -> 'a array -> unit
282  val app  : ('a -> unit) -> 'a array -> unit
283  val modifyi : (int * 'a -> 'a) -> 'a array -> unit
284  val modify  : ('a -> 'a) -> 'a array -> unit
285  val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
286  val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
287  val foldl  : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
288  val foldr  : ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
289  val findi : (int * 'a -> bool)
290              -> 'a array -> (int * 'a) option
291  val find  : ('a -> bool) -> 'a array -> 'a option
292  val exists : ('a -> bool) -> 'a array -> bool
293  val all : ('a -> bool) -> 'a array -> bool
294  val collate : ('a * 'a -> order)
295                -> 'a array * 'a array -> order
296end
297
298structure Array :> ARRAY =
299struct
300  type 'a vector = 'a Vector.vector
301  structure A = MosmlArray
302  open A
303
304  fun vector a = extract(a, 0, NONE)
305  fun copy {di,dst,src} =
306      A.copy {src = src, si = 0, len = NONE, dst = dst, di = di}
307  fun copyVec {di,dst,src} =
308      A.copyVec {src = src, si = 0, len = NONE, dst = dst, di = di}
309  fun appi f a = A.appi f (a, 0, NONE)
310  fun modifyi f a = A.modifyi f (a, 0, NONE)
311  fun foldli f b a = A.foldli f b (a, 0, NONE)
312  fun foldri f b a = A.foldri f b (a, 0, NONE)
313  fun findi P a = let
314    val sz = length a
315    fun recurse i =
316        if i < sz then let val pr = (i, sub(a,i))
317                       in
318                         if P pr then SOME pr else recurse (i + 1)
319                       end
320        else NONE
321  in
322    recurse 0
323  end
324  fun find P a = Option.map #2 (findi (P o #2) a)
325  fun exists P a = isSome (find P a)
326  fun all P a = not (exists (not o P) a)
327  fun collate cmp (a1, a2) = let
328    val sz1 = length a1 and sz2 = length a2
329    fun recurse i =
330        if i < sz1 then
331          if i < sz2 then
332            case cmp(sub(a1,i), sub(a2,i)) of
333              EQUAL => recurse (i + 1)
334            | x => x
335          else GREATER
336        else if i < sz2 then LESS
337        else EQUAL
338  in
339    recurse 0
340  end
341end
342
343signature ARRAY_SLICE =
344sig
345    type 'a slice
346    val length : 'a slice -> int
347    val sub : 'a slice * int -> 'a
348    val update : 'a slice * int * 'a -> unit
349    val full : 'a Array.array -> 'a slice
350    val slice : 'a Array.array * int * int option -> 'a slice
351    val subslice : 'a slice * int * int option -> 'a slice
352    val base : 'a slice -> 'a Array.array * int * int
353    val vector : 'a slice -> 'a Vector.vector
354    val copy    : {
355                      src : 'a slice,
356                      dst : 'a Array.array,
357                      di : int
358                    } -> unit
359    val copyVec : {
360                      src : 'a VectorSlice.slice,
361                      dst : 'a Array.array,
362                      di : int
363                    } -> unit
364    val isEmpty : 'a slice -> bool
365    val getItem : 'a slice -> ('a * 'a slice) option
366    val appi : (int * 'a -> unit) -> 'a slice -> unit
367    val app  : ('a -> unit) -> 'a slice -> unit
368    val modifyi : (int * 'a -> 'a) -> 'a slice -> unit
369    val modify  : ('a -> 'a) -> 'a slice -> unit
370    val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
371    val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
372    val foldl  : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
373    val foldr  : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
374    val findi : (int * 'a -> bool)
375                  -> 'a slice -> (int * 'a) option
376    val find  : ('a -> bool) -> 'a slice -> 'a option
377    val exists : ('a -> bool) -> 'a slice -> bool
378    val all : ('a -> bool) -> 'a slice -> bool
379    val collate : ('a * 'a -> order)
380                    -> 'a slice * 'a slice -> order
381end
382
383structure ArraySlice :> ARRAY_SLICE =
384struct
385
386  type 'a slice = ('a Array.array * int * int)
387
388  val vlen = Array.length
389  val vsub = Array.sub
390  fun length (v,i,sz) = sz
391  fun isEmpty (v,i,sz) = sz = 0
392  fun sub ((v,i,sz), j) = if j < 0 orelse sz <= j then raise Subscript
393                          else vsub(v, i + j)
394  fun update((a,i,sz),j,e) = Array.update(a,i + j,e)
395
396  fun getItem (v,i,sz) = if sz = 0 then NONE
397                         else SOME (vsub(v,i), (v,i+1,sz-1))
398  fun full v = (v,0,vlen v)
399  fun slice (v,i,NONE) = if i < 0 orelse vlen v < i then raise Subscript
400                         else (v,i,vlen v - i)
401    | slice (v,i,SOME sz) = if i < 0 orelse sz < 0 orelse vlen v < i + sz then
402                              raise Subscript
403                            else (v,i,sz)
404  fun subslice ((v,i,sz), j, NONE) = if j < 0 orelse sz < j then raise Subscript
405                                     else (v,i+j,sz - j)
406    | subslice ((v,i,sz), j, SOME sz') =
407      if j < 0 orelse sz' < 0 orelse sz < j + sz' then raise Subscript
408      else (v,i+j,sz')
409  fun base v : 'a slice = v
410  fun vector (sl as (v,i,sz)) = Vector.tabulate(sz, (fn i => sub(sl, i)))
411
412  fun copy {di,dst,src = src as (a,i,sz)} =
413      if di < 0 orelse vlen dst < di + sz then raise Subscript
414      else let
415          fun back2front j = if j < 0 then ()
416                             else (Array.update(dst,j + di,sub(src,j));
417                                   back2front (j - 1))
418          fun front2back j = if j < sz then (Array.update(dst,j+di,sub(src,j));
419                                             front2back (j + 1))
420                             else ()
421        in
422          if a = dst then
423            if i = di then ()
424            else if i < di then back2front (sz - 1)
425            else (* di < i *) front2back 0
426          else front2back 0
427        end
428
429  fun copyVec {di,dst,src} =
430      if di < 0 orelse vlen dst < di + VectorSlice.length src then
431        raise Subscript
432      else let
433          val sub = VectorSlice.sub
434          val sz = VectorSlice.length src
435          fun front2back j = if j < sz then (Array.update(dst,j+di,sub(src,j));
436                                             front2back (j + 1))
437                             else ()
438        in
439          front2back 0
440        end
441
442
443
444  fun appi f sl = let
445    fun recurse i = if i < length sl then (f(i, sub(sl,i)); recurse (i + 1))
446                    else ()
447  in
448    recurse 0
449  end
450  fun app f = appi (f o #2)
451
452  fun modifyi f sl = let
453    val sz = length sl
454    fun recurse i = if i < sz then
455                      (update(sl,i,f(i,sub(sl,i))); recurse (i + 1))
456                    else ()
457  in
458    recurse 0
459  end
460  fun modify f = modifyi (f o #2)
461
462  fun foldli f b sl = let
463    val sz = length sl
464    fun recurse acc i = if i < sz then recurse (f(i,sub(sl,i),acc)) (i + 1)
465                        else acc
466  in
467    recurse b 0
468  end
469  fun foldri f b sl = let
470    fun recurse acc i = if i < 0 then acc
471                        else recurse (f(i,sub(sl,i),acc)) (i - 1)
472  in
473    recurse b (length sl - 1)
474  end
475  fun foldl f = foldli (fn (_,e,b) => f (e,b))
476  fun foldr f = foldri (fn (_,e,b) => f (e,b))
477  fun findi P v = let
478    val sz = length v
479    fun recurse i =
480        if i < sz then let
481            val pr = (i,sub(v,i))
482          in
483            if P pr then SOME pr else recurse (i + 1)
484          end
485        else NONE
486  in
487    recurse 0
488  end
489  fun find P v = Option.map #2 (findi (P o #2) v)
490  fun exists P v = isSome (find P v)
491  fun all P v = not (exists (not o P) v)
492  fun collate cmp (a1, a2) = let
493    val sz1 = length a1 and sz2 = length a2
494    fun recurse i =
495        if i < sz1 then
496          if i < sz2 then
497            case cmp(sub(a1,i), sub(a2,i)) of
498              EQUAL => recurse (i + 1)
499            | x => x
500          else GREATER
501        else if i < sz2 then LESS
502        else EQUAL
503  in
504    recurse 0
505  end
506
507
508
509end
510
511
512
513signature OS_PROCESS =
514sig
515    type status
516    val success : status
517    val failure : status
518    val isSuccess : status -> bool
519    val system : string -> status
520    val atExit : (unit -> unit) -> unit
521    val exit : status -> 'a
522    val terminate : status -> 'a
523    val getEnv : string -> string option
524    val sleep : Time.time -> unit
525end
526
527signature OS_FILESYS =
528sig
529  type dirstream
530
531  val openDir : string -> dirstream
532  val readDir : dirstream -> string option
533  val rewindDir : dirstream -> unit
534  val closeDir : dirstream -> unit
535
536  val chDir : string -> unit
537  val getDir : unit -> string
538  val mkDir : string -> unit
539  val rmDir : string -> unit
540  val isDir : string -> bool
541  val isLink : string -> bool
542  val readLink : string -> string
543  val fullPath : string -> string
544  val realPath : string -> string
545  val modTime : string -> Time.time
546  val fileSize : string -> int
547  val setTime : string * Time.time option -> unit
548  val remove : string -> unit
549  val rename : {old : string, new : string} -> unit
550
551  datatype access_mode = A_READ | A_WRITE | A_EXEC
552
553  val access : string * access_mode list -> bool
554
555  val tmpName : unit -> string
556
557  eqtype file_id
558
559  val fileId : string -> file_id
560  val hash : file_id -> word
561  val compare : file_id * file_id -> order
562
563end
564
565signature OS_PATH =
566sig
567
568exception Path
569exception InvalidArc
570
571val parentArc : string
572val currentArc : string
573
574val fromString : string -> {isAbs : bool, vol : string, arcs : string list}
575val toString : {isAbs : bool, vol : string, arcs : string list} -> string
576
577val validVolume : {isAbs : bool, vol : string} -> bool
578
579val getVolume : string -> string
580val getParent : string -> string
581
582val splitDirFile : string -> {dir : string, file : string}
583val joinDirFile : {dir : string, file : string} -> string
584val dir  : string -> string
585val file : string -> string
586
587val splitBaseExt : string -> {base : string, ext : string option}
588val joinBaseExt : {base : string, ext : string option} -> string
589val base : string -> string
590val ext  : string -> string option
591
592val mkCanonical : string -> string
593val isCanonical : string -> bool
594val mkAbsolute : {path : string, relativeTo : string}
595                   -> string
596val mkRelative : {path : string, relativeTo : string}
597                   -> string
598val isAbsolute : string -> bool
599val isRelative : string -> bool
600val isRoot : string -> bool
601
602val concat : string * string -> string
603
604val fromUnixPath : string -> string
605val toUnixPath : string -> string
606
607end
608
609
610
611structure String = struct
612  open String
613  fun concatWith sep l = let
614    fun clist l acc =
615        case l of
616          h1 :: (t as _::_) => clist t (sep :: h1 :: acc)
617        | x => x @ acc
618  in
619    concat (List.rev (clist l []))
620  end
621  fun isSubstring p t = let
622    (* following
623         http://www.iti.fh-flensburg.de/lang/algorithmen/pattern/bmen.htm
624    *)
625    open Int
626    val m = size p
627    val n = size t
628
629    val occ = let
630      val occarray = Array.array (Char.ord Char.maxChar + 1, ~1)
631      fun recurse i =
632          if i >= m then ()
633          else let
634              val c = String.sub(p,i)
635            in
636              Array.update(occarray, Char.ord c, i);
637              recurse (i + 1)
638            end
639      val _ = recurse 0
640    in
641      fn c => Array.sub(occarray, Char.ord c)
642    end
643    val f = Array.array(m+1,0)
644    val s = Array.array(m+1,0)
645    val bmPreprocess1 as () = let
646      val i = ref m and j = ref (m + 1)
647      val _ = Array.update(f,!i,!j)
648    in
649      while (!i > 0) do
650        (while !j <= m andalso String.sub(p,!i-1) <> String.sub(p,!j-1) do
651           (if Array.sub(s,!j) = 0 then Array.update(s,!j,(!j) - !i) else ();
652            j := Array.sub(f,!j));
653         i := !i - 1;
654         j := !j - 1;
655         Array.update(f,!i,!j))
656    end
657    val bmPreprocess2 as () = let
658      val i = ref 0 and j = ref (Array.sub(f,0))
659    in
660      while (!i <= m) do
661        (if Array.sub(s,!i) = 0 then Array.update(s,!i,!j) else ();
662         if !i = !j then j := Array.sub(f,!j) else ();
663         i := !i + 1)
664    end
665    exception Done of int
666    val i = ref 0 and j = ref 0
667  in
668    (while !i <= n - m do
669       (j := m - 1;
670        while (!j >= 0 andalso String.sub(p,!j) = String.sub(t,!i + !j)) do
671          j := !j - 1;
672        if !j < 0 then raise Done (!i)
673        else i := !i + Int.max(Array.sub(s,!j + 1),
674                               !j - occ (String.sub(t,!i + !j))));
675     false) handle Done _ => true
676  end
677
678  fun isSuffix small big = let
679    open Int
680    fun check i j =
681        i < 0 orelse
682        (0 <= j andalso
683         String.sub(small,i) = String.sub(big,j) andalso
684         check (i - 1) (j - 1))
685  in
686    check (size small - 1) (size big - 1)
687  end
688
689end
690
691signature SUBSTRING =
692sig
693  type substring
694  eqtype char
695  eqtype string
696
697  val sub : substring * int -> char
698  val size : substring -> int
699  val base : substring -> string * int * int
700  val extract   : string * int * int option -> substring
701  val substring : string * int * int -> substring
702  val full : string -> substring
703  val string : substring -> string
704  val isEmpty : substring -> bool
705  val getc : substring -> (char * substring) option
706  val first : substring -> char option
707  val triml : int -> substring -> substring
708  val trimr : int -> substring -> substring
709  val slice : substring * int * int option -> substring
710  val concat : substring list -> string
711  val concatWith : string -> substring list -> string
712  val explode : substring -> char list
713  val isPrefix    : string -> substring -> bool
714  val isSubstring : string -> substring -> bool
715  val isSuffix    : string -> substring -> bool
716  val compare : substring * substring -> order
717  val collate : (char * char -> order) -> substring * substring -> order
718  val splitl : (char -> bool) -> substring -> substring * substring
719  val splitr : (char -> bool) -> substring -> substring * substring
720  val splitAt : substring * int -> substring * substring
721  val dropl : (char -> bool) -> substring -> substring
722  val dropr : (char -> bool) -> substring -> substring
723  val takel : (char -> bool) -> substring -> substring
724  val taker : (char -> bool) -> substring -> substring
725  val position : string -> substring -> substring * substring
726  val span : substring * substring -> substring
727  val translate : (char -> string) -> substring -> string
728  val tokens : (char -> bool) -> substring -> substring list
729  val fields : (char -> bool) -> substring -> substring list
730  val app : (char -> unit) -> substring -> unit
731  val foldl : (char * 'a -> 'a) -> 'a -> substring -> 'a
732  val foldr : (char * 'a -> 'a) -> 'a -> substring -> 'a
733end
734
735structure Substring :> SUBSTRING
736            where type substring = Substring.substring
737            and type string = String.string
738            and type char = Char.char =
739struct
740  open Substring
741  type char = Char.char
742  type string = String.string
743  val full = all
744  fun concatWith sep sslist = let
745    fun clist l =
746        case l of
747          h1 :: (t as _ :: _) => h1 :: full sep :: clist t
748        | x => x
749  in
750    concat (clist sslist)
751  end
752
753  fun isSubstring s ss = String.isSubstring s (string ss)
754  fun isSuffix s ss = String.isSuffix s (string ss)
755
756end
757
758structure TextIO = struct
759  open TextIO
760  val inputLine = fn is => case inputLine is of
761                             "" => NONE
762                           | s => SOME s
763end
764
765signature MONO_VECTOR =
766sig
767  type vector
768  type elem
769  val maxLen : int
770  val fromList : elem list -> vector
771  val tabulate : int * (int -> elem) -> vector
772  val length : vector -> int
773  val sub : vector * int -> elem
774  val update : vector * int * elem -> vector
775  val concat : vector list -> vector
776  val appi : (int * elem -> unit) -> vector -> unit
777  val app  : (elem -> unit) -> vector -> unit
778  val mapi : (int * elem -> elem) -> vector -> vector
779  val map  : (elem -> elem) -> vector -> vector
780  val foldli : (int * elem * 'a -> 'a) -> 'a -> vector -> 'a
781  val foldri : (int * elem * 'a -> 'a) -> 'a -> vector -> 'a
782  val foldl  : (elem * 'a -> 'a) -> 'a -> vector -> 'a
783  val foldr  : (elem * 'a -> 'a) -> 'a -> vector -> 'a
784  val findi : (int * elem -> bool)
785              -> vector -> (int * elem) option
786  val find  : (elem -> bool) -> vector -> elem option
787  val exists : (elem -> bool) -> vector -> bool
788  val all : (elem -> bool) -> vector -> bool
789  val collate : (elem * elem -> order)
790                -> vector * vector -> order
791end
792
793structure CharVector :> MONO_VECTOR
794                          where type vector = String.string
795                          and type elem = char =
796struct
797  open CharVector
798  fun update(s,i,c) = if i < 0 orelse i >= size s then raise Subscript
799                      else String.extract(s,0,SOME i) ^ str c ^
800                           (if i = size s - 1 then ""
801                            else String.extract(s,i+1,NONE))
802  fun appi f s = CharVector.appi f (s,0,NONE)
803  fun mapi f s = CharVector.mapi f (s,0,NONE)
804  fun foldli f acc s = CharVector.foldli f acc (s,0,NONE)
805  fun foldri f acc s = CharVector.foldri f acc (s,0,NONE)
806  fun findi P s = let
807    val sz = size s
808    fun recurse i =
809        if i = sz then NONE
810        else let
811            val c = String.sub (s, i)
812            val pair = (i,c)
813          in
814            if P pair then SOME pair
815            else recurse (i + 1)
816          end
817  in
818    recurse 0
819  end
820  fun find P s = let
821    val sz = size s
822    fun recurse i =
823        if i = sz then NONE
824        else let
825            val c = String.sub(s,i)
826          in
827            if P c then SOME c else recurse (i + 1)
828          end
829  in
830    recurse 0
831  end
832  fun exists P s = isSome (find P s)
833  fun all P = not o exists (not o P)
834  val collate = String.collate
835end
836
837signature MONO_VECTOR_SLICE =
838sig
839  type elem
840  type vector
841  type slice
842  val length : slice -> int
843  val sub : slice * int -> elem
844  val full : vector -> slice
845  val slice : vector * int * int option -> slice
846  val subslice : slice * int * int option -> slice
847  val base : slice -> vector * int * int
848  val vector : slice -> vector
849  val concat : slice list -> vector
850  val isEmpty : slice -> bool
851  val getItem : slice -> (elem * slice) option
852  val appi : (int * elem -> unit) -> slice -> unit
853  val app  : (elem -> unit) -> slice -> unit
854  val mapi : (int * elem -> elem) -> slice -> vector
855  val map  : (elem -> elem) -> slice -> vector
856  val foldli : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
857  val foldr  : (elem * 'b -> 'b) -> 'b -> slice -> 'b
858  val foldl  : (elem * 'b -> 'b) -> 'b -> slice -> 'b
859  val foldri : (int * elem * 'b -> 'b) -> 'b -> slice -> 'b
860  val findi : (int * elem -> bool) -> slice -> (int * elem) option
861  val find  : (elem -> bool) -> slice -> elem option
862  val exists : (elem -> bool) -> slice -> bool
863  val all : (elem -> bool) -> slice -> bool
864  val collate : (elem * elem -> order) -> slice * slice -> order
865end
866
867structure CharVectorSlice :> MONO_VECTOR_SLICE
868                               where type slice = Substring.substring
869                                 and type vector = String.string
870                                 and type elem = char =
871struct
872  type elem = char
873  type slice = Substring.substring
874  type vector = String.string
875  open Substring
876  val length = size
877  val subslice = slice
878  val slice = extract
879  val vector = string
880  val getItem = getc
881  fun appi f ss = let
882    val sz = size ss
883    fun recurse i =
884        if i = sz then ()
885        else (f (i,sub(ss,i)); recurse (i + 1))
886  in
887    recurse 0
888  end
889  fun mapi f ss = let
890    val sz = size ss
891    fun recurse acc i =
892        if i = sz then acc
893        else recurse (f(i,sub(ss,i)) :: acc) (i + 1)
894  in
895    String.implode (List.rev (recurse [] 0))
896  end
897  fun map f ss = mapi (fn (i,c) => f c) ss
898  fun foldli f acc ss = let
899    val sz = size ss
900    fun recurse i acc =
901        if i = sz then acc
902        else recurse (i + 1) (f(i,sub(ss,i),acc))
903  in
904    recurse 0 acc
905  end
906  fun foldri f init seq = let
907    val len = length seq
908    fun loop (i, b) =
909        if i = ~1 then b
910        else loop(i-1,f(i,sub(seq,i),b))
911  in
912    loop(len-1,init)
913  end
914  fun findi P ss = let
915    val sz = length ss
916    fun loop i =
917        if i = sz then NONE
918        else let
919            val c = sub(ss,i)
920            val pr = (i,c)
921          in
922            if P pr then SOME pr else loop (i + 1)
923          end
924  in
925    loop 0
926  end
927  fun find P ss = Option.map #2 (findi (fn (i,c) => P c) ss)
928  fun exists P ss = isSome (find P ss)
929  fun all P = not o (exists (not o P))
930
931end;
932
933structure Word8Vector :> MONO_VECTOR
934                           where type elem = Word8.word
935                             and type vector = Word8Vector.vector =
936struct
937  open Word8Vector
938  type vector = Word8Vector.vector
939  fun update (v,i,e) =
940      tabulate (length v, (fn j => if j = i then e else sub(v,j)))
941  fun appi f v = Word8Vector.appi f (v, 0, NONE)
942  fun mapi f v = Word8Vector.mapi f (v, 0, NONE)
943  fun foldli f a v = Word8Vector.foldli f a (v, 0, NONE)
944  fun foldri f a v = Word8Vector.foldri f a (v, 0, NONE)
945
946  fun findi P v = let
947    val sz = length v
948    fun loop i =
949        if i = sz then NONE
950        else let
951            val c = sub(v,i)
952            val pr = (i,c)
953          in
954            if P pr then SOME pr else loop (i + 1)
955          end
956  in
957    loop 0
958  end
959  fun find P v = Option.map #2 (findi (fn (i,c) => P c) v)
960  fun exists P v = isSome (find P v)
961  fun all P = not o (exists (not o P))
962
963  fun collate wcmp (v1, v2) = let
964    val sz1 = length v1 and sz2 = length v2
965    fun loop i =
966        if i = sz1 then if i = sz2 then EQUAL else LESS
967        else if i = sz2 then GREATER
968        else
969          case wcmp (sub(v1,i), sub(v2,i)) of
970            EQUAL => loop (i + 1)
971          | x => x
972  in
973    loop 0
974  end
975end
976
977structure OS =
978struct
979  open OS
980
981  structure Process : OS_PROCESS =
982  struct
983    open Process
984    fun isSuccess x = (x = success)
985    fun unixSleep t = ignore (system ("sleep "^Time.toString t))
986    fun winSleep delay = let
987      fun start_timer() = let
988        val timer = Timer.startRealTimer()
989      in
990        (fn () => Timer.checkRealTimer timer
991            handle Time.Time => Time.zeroTime)
992      end
993      val t = start_timer()
994      fun loop () = if Time.>= (t(), delay) then ()
995                    else loop()
996    in
997      loop()
998    end
999    val isUnix = #vol (Path.fromString (FileSys.getDir())) = ""
1000    val sleep = if isUnix then unixSleep else winSleep
1001  end
1002
1003  structure Path : OS_PATH = struct
1004    structure MP = Path
1005    open Path
1006
1007    (* inspired by the mlton 20070826 approach *)
1008    val isWindows = MP.validVolume {isAbs = true, vol = "c:"}
1009    val slash = if isWindows then "\\" else "/"
1010    infix 9 sub
1011    val op sub = String.sub
1012
1013    exception InvalidArc
1014    fun mkAbsolute{relativeTo, path} = MP.mkAbsolute(path,relativeTo)
1015    fun mkRelative{relativeTo, path} = MP.mkRelative(path,relativeTo)
1016    fun isRoot path =
1017        case fromString path of
1018          {isAbs = true, arcs = [""], ...} => true
1019        | _ => false
1020
1021    fun fromUnixPath s =
1022        if not isWindows then s
1023        else if Char.contains s (slash sub 0) then raise InvalidArc
1024        else String.translate (fn c => if c = #"/" then slash else str c) s
1025
1026    fun toUnixPath s =
1027        if not isWindows then s
1028        else
1029          let
1030            val {arcs, isAbs, vol} = fromString s
1031          in
1032            if vol <> "" then raise Path
1033            else (if isAbs then "/" else "") ^ String.concatWith "/" arcs
1034          end
1035
1036  end (* structure Path *)
1037  structure FileSys : OS_FILESYS =
1038  struct
1039    structure MFS = FileSys
1040    open MFS
1041    datatype access_mode = datatype access
1042    fun fullPath s = let
1043      val p = MFS.fullPath s
1044    in
1045      if access(p, []) then p
1046      else raise SysErr ("No such file or directory", NONE)
1047    end
1048    fun realPath p =
1049        if Path.isAbsolute p then fullPath p
1050	else Path.mkRelative{
1051               path=fullPath p, relativeTo=fullPath(getDir())
1052             }
1053  end
1054
1055end
1056
1057signature TIMER =
1058sig
1059  type cpu_timer
1060  type real_timer
1061  val startCPUTimer : unit -> cpu_timer
1062  val checkCPUTimes : cpu_timer
1063                      -> {nongc : {usr : Time.time, sys : Time.time},
1064                          gc : {usr : Time.time, sys : Time.time}}
1065  val checkCPUTimer : cpu_timer -> {usr : Time.time, sys : Time.time}
1066  val checkGCTime : cpu_timer -> Time.time
1067  val totalCPUTimer : unit -> cpu_timer
1068  val startRealTimer : unit -> real_timer
1069  val checkRealTimer : real_timer -> Time.time
1070  val totalRealTimer : unit -> real_timer
1071end
1072
1073structure Timer : TIMER =
1074struct
1075
1076  open Timer
1077  fun checkCPUTimes timer = let
1078    val times as {usr,sys,gc} = Timer.checkCPUTimer timer
1079  in
1080    {nongc = {usr = usr, sys = sys}, gc = {usr = gc, sys = Time.zeroTime}}
1081  end
1082  fun checkCPUTimer timer = let
1083    val times as {usr,sys,gc} = Timer.checkCPUTimer timer
1084  in
1085    {usr = usr, sys = sys}
1086  end
1087  fun checkGCTime timer = #gc (Timer.checkCPUTimer timer)
1088
1089end
1090
1091
1092structure Real =
1093struct
1094  open Real
1095  structure Math = Math
1096end
1097
1098exception Option = Option.Option
1099