149 lines · 4.4 KB · Standard ML
RawDownload
(* String -- 1994-12-10, 1995-11-07, 1999-04-22 *) local     type char = Char.char;    prim_val sub_      : string -> int -> char         = 2 "get_nth_char";    prim_val mkstring_ : int -> string                 = 1 "create_string";    prim_val update_   : string -> int -> char -> unit = 3 "set_nth_char";    prim_val strcmp_   : string -> string -> int       = 2 "compare_strings";    prim_val blit_     : string -> int -> string -> int -> int -> unit                                                        = 5 "blit_string";     fun (f o g) x = f (g x);in type string = stringval maxSize = Strbase.maxlenval size = size fun sub(s, i) =     if i<0 orelse i >= size s then raise Subscript    else sub_ s i; fun concat strs =    let fun acc [] len       = len          | acc (v1::vr) len = acc vr (size v1 + len)        val len = acc strs 0        val newstr = if len > maxSize then raise Size else mkstring_ len         fun copyall to []       = ()          | copyall to (v1::vr) =             let val len1 = size v1            in blit_ v1 0 newstr to len1; copyall (to+len1) vr end    in copyall 0 strs; newstr end; val op ^ = op ^; fun str c =     let val newstr = mkstring_ 1    in update_ newstr 0 c; newstr end; fun implode cs =   let val n = List.length cs      val newstr = if n > maxSize then raise Size else mkstring_ n      fun init []      i = ()        | init (c::cr) i = (update_ newstr i c; init cr (i+1))  in (init cs 0; newstr) end; fun extract (s, i, slicelen) =    let val n = case slicelen of NONE => size s - i | SOME n => n	val newstr = if i<0 orelse n<0 orelse n>size s-i then raise Subscript		     else mkstring_ n    in blit_ s i newstr 0 n; newstr end; fun substring (s, i, n) = extract(s, i, SOME n); fun explode s =    let fun h j res = if j<0 then res		      else h (j-1) (sub_ s j :: res)    in h (size s - 1) [] end; fun map (f : char -> char) (a : string) : string =     let val stop = size a	val newstr = mkstring_ stop 	fun lr j = if j < stop then (update_ newstr j (f(sub_ a j)); 				     lr (j+1))		   else ()    in lr 0; newstr end fun compare (s1, s2) =     (case strcmp_ s1 s2 of         ~2 => LESS       | ~1 => LESS       |  0 => EQUAL       |  1 => GREATER       |  2 => GREATER       |  _ => raise Fail "internal error: String.compare"); fun collate cmp (s1, s2) =    let val n1 = size s1 	and n2 = size s2	val stop = if n1 < n2 then n1 else n2	fun h j = (* At this point s1[0..j-1] = s2[0..j-1] *)	    if j = stop then if      n1 < n2 then LESS                             else if n1 > n2 then GREATER                             else                 EQUAL	    else		case cmp(sub_ s1 j, sub_ s2 j) of		    LESS    => LESS		  | GREATER => GREATER		  | EQUAL   => h (j+1)    in h 0 end; fun translate f s =     Strbase.translate f (s, 0, size s); fun tokens p s =     List.map substring (Strbase.tokens p (s, 0, size s)); fun fields p s =     List.map substring (Strbase.fields p (s, 0, size s)); fun isPrefix s1 s2 =     let val n1 = size s1 	and n2 = size s2	val stop = if n1 < n2 then n1 else n2	fun h j = (* At this point s1[0..j-1] = s2[0..j-1] *)	    j = stop orelse sub_ s1 j = sub_ s2 j andalso h (j+1)    in n1 <= n2 andalso h 0 end; fun foldl f e s =     let val stop = size s	fun h j res = if j>=stop then res 		      else h (j+1) (f (sub_ s j, res))    in h 0 e end; fun foldr f e s =     let fun h j res = if j<0 then res                       else h (j-1) (f (sub_ s j, res))    in h (size s - 1) e end; fun find p s =     let val stop = size s	fun h j = if j>=stop then NONE 		  else if p (sub_ s j) then SOME j		  else h (j+1)     in h 0 end; fun fromString s =    let fun getc i = if i < size s then SOME (sub_ s i, i+1) else NONE	fun h src res = 	    case getc src of		NONE              => SOME (implode(List.rev res))	      | SOME(#"\\", src1) => 		    (case Strbase.fromMLescape getc src1 of			 NONE          => NONE		       | SOME(c, src2) => h src2 (c :: res))	      | SOME(c, src1)     => h src1 (c :: res)    in h 0 [] end;	fun toString s = Strbase.translate Strbase.toMLescape (s, 0, size s); fun fromCString s = Strbase.fromCString s fun toCString s = Strbase.translate Strbase.toCescape (s, 0, size s) val op <  = op <  : string * string -> bool;val op <= = op <= : string * string -> bool;val op >  = op >  : string * string -> bool;val op >= = op >= : string * string -> bool;end