
(* String utilities by Tom 7. 
   See stringutil-sig for documentation. *)

structure StringUtil :> STRINGUTIL =
struct

  (* workaround for andb bug in MLton 20010706 *)
  fun mkbyte w = Word.mod (w, 0w256)

  exception StringUtil of string

  fun K x y = x
  
  fun unformatted_table sll =
    (foldl (fn (sl, rest) =>
            rest ^ "\n" ^
            (foldl (fn (s, b) => b ^ " " ^ s) "" sl)) "" sll) ^ "\n"


  (* if s is longer than n chars, split it as best as possible
     to a list of strings less than or equal to n chars in length. *)
  fun wrapto n s =
    if size s <= n then [s] else
      String.substring (s, 0, n) :: wrapto n (substring (s, n, size s - n))

  fun pad' n s =
    if (size s >= n) then (s, "")
      else (s, (implode (List.tabulate (n - size s, K #" "))))

  fun delimit s nil = ""
    | delimit s (h::t) =
	foldl (fn (a, b) => b ^ s ^ a) h t

  fun pad n s = 
    if n < 0 then
	let val (a, b) = pad' (~ n) s
	in b ^ a
	end
    else
	let val (a, b) = pad' n s
	in a ^ b
	end

  (* this one takes a hard width for each column (as il) *)
  fun hardtable il sll =
    let 
      fun f nil = ""
        | f (sl::rest) =
        let 
          (* split up each string at its corresponding length *)
          val psl : string list list =
                let fun g (nil, nil) = nil
                      | g (s::r, n::t) = (wrapto (abs n) s) :: g(r, t)
                      | g _ = raise StringUtil "inconsistent hardtables(1)"
                in
                  g (sl, il)
                end
 
          fun maybetl nil = nil
            | maybetl (_::t) = t
        
          fun j (sll : string list list) =
                if (List.all List.null sll) then ""
                else let
                       fun k (nil : string list list, nil : int list) = "\n"
                         | k (nil::r, n::t) = (pad n "") ^ " " ^ k (r,t)
                         | k ((s::_)::r, n::t) = (pad n s) ^ " " ^ k (r,t)
                         | k _ = raise StringUtil "inconsistent hardtables(2)"
                     in
                         k (sll, il) ^ j (map maybetl sll)
                     end

          val block = j psl

        in
          block ^ (f rest)
        end
    in
      f sll
    end


  fun max (a, b) = if a < b then b else a

  fun make_square (x : string list list) : string list list * int =
    let
        val cols = foldl (fn (l, b) => max(length l, b)) 0 x
    in
        (foldr (fn (l, b) =>
                let val n = length l
                in
                if n < cols then
                   l @ (List.tabulate (cols - n, K ""))
                else l
                end :: b) nil x, cols)
    end


(* XXX: this method sucks when lines are long 
   (and especially when they don't appear near the end.) *)
  fun table n sll =
    let
        val (sll, cols) = make_square sll
        
        val sizes = 
            foldl (ListPair.map (fn (a,b) => max (size a, b))) 
                     (List.tabulate (cols, K 0)) sll

        fun fixsizes (h::t, l, surplus) = 
              if h < surplus then fixsizes(t, h::l, surplus - h)
              else fixsizes(t, max(surplus, 4) :: l, 0)
          | fixsizes (nil, l, surplus) = (rev l, surplus)
    in
        hardtable sizes sll
    end

  fun ucase s =
      let fun uc nil = nil
	    | uc (h::t) =
	  (if h >= #"a" andalso h <= #"z" then chr(ord h - 32)
	   else h) :: uc t
      in
	  implode (uc (explode s))
      end

  fun lcase s =
      let fun lc nil = nil
	    | lc (h::t) =
	  (if h >= #"A" andalso h <= #"Z" then chr(ord h + 32)
	   else h) :: lc t
      in
	  implode (lc (explode s))
      end

  fun filter f = implode o (List.filter f) o explode

  fun readfile f = 
    let
      val l = TextIO.openIn f
      val s = TextIO.inputAll l
    in
      TextIO.closeIn l; s
    end

  fun truncate l s = 
      if size s > l then String.substring(s, 0, l)
      else s

  val digits = "0123456789ABCDEF"

  fun hexdig i = implode [CharVector.sub (digits, i div 16),
                          CharVector.sub (digits, i mod 16)]

  fun inlist nil c = false
    | inlist (h::t) (c : char) = c = h orelse inlist t c

  fun ischar c d = c = d

  fun harden f esc l s =
      let
	  (* will need at most this many chars, but don't bother
             translating any more... *)
	  val ss = truncate l s
            
	  fun ff c = if (c <> esc andalso f c)
                     orelse Char.isAlphaNum c then str c
                     else str esc ^ hexdig (ord c)
      in
	  truncate l (String.translate ff ss)
      end

  fun wordtohex_be w = 
    let
      val a = mkbyte (Word.>> (w, 0w24))
      val b = mkbyte (Word.>> (w, 0w16))
      val c = mkbyte (Word.>> (w, 0w8))
      val d = mkbyte w
    in
      hexdig (Word.toInt a) ^
      hexdig (Word.toInt b) ^
      hexdig (Word.toInt c) ^
      hexdig (Word.toInt d)
    end

  fun wordtohex_le w =
    let
      val a = mkbyte(Word.>> (w, 0w24))
      val b = mkbyte(Word.>> (w, 0w16))
      val c = mkbyte(Word.>> (w, 0w8))
      val d = mkbyte w
    in
      hexdig (Word.toInt d) ^
      hexdig (Word.toInt c) ^
      hexdig (Word.toInt b) ^
      hexdig (Word.toInt a)
    end

  fun word16tohex w =
    let
      val c = mkbyte (Word.>> (w, 0w8))
      val d = mkbyte w
    in
      hexdig (Word.toInt c) ^
      hexdig (Word.toInt d)
    end

  fun all f s =
      let
	  fun ff ~1 = true
	    | ff n = f (CharVector.sub(s, n)) andalso ff (n - 1)
      in
	  ff (size s - 1)
      end

  fun charspec s =
      let
	  fun none _ = false
	  fun r (f, nil) = f
	    | r (f, (#"\\" :: c :: t)) = r ((fn d => d = c orelse f d), t)
	    | r (f, (c :: #"-" :: d :: t)) = 
	      let val (c, d) = if c > d then (c, d) else (d, c)
	      in r ((fn e => (e <= c andalso e >= d) orelse f e), t)
	      end
	    | r (f, (c :: t)) = r ((fn d => d = c orelse f d), t)
      in
	  case explode s of
	      #"^" :: rest => let val f = r (none, rest)
	                      in fn c => not (f c)
			      end
	    | chars => r (none, chars)
      end

  fun indexof s c =
      let
	  fun ff n nil = ~1
	    | ff n (h::t) = if c = h then n else ff (n+1) t
      in
	  ff 0 (explode s)
      end
      
end
