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