ocaml/stdlib/printf.ml

external format_int: string -> int -> string = "format_int"
external format_float: string -> float -> string = "format_float"

let fprintf outchan format =
  let format = (Obj.magic format : string) in
  let rec doprn i =
    if i >= String.length format then
      Obj.magic ()
    else begin
      let c = String.unsafe_get format i in
      if c <> '%' then begin
        output_char outchan c;
        doprn (succ i)
      end else begin
        let j = skip_args (succ i) in
        match String.unsafe_get format j with
          '%' ->
            output_char outchan '%';
            doprn (succ j)
        | 's' ->
            Obj.magic(fun s ->
              if j <= i+1 then
                output_string outchan s
              else begin
                let p =
                  try
                    int_of_string (String.sub format (i+1) (j-i-1))
                  with _ ->
                    invalid_arg "fprintf: bad %s format" in
                if p > 0 & String.length s < p then begin
                  output_string outchan
                                (String.make (p - String.length s) ' ');
                  output_string outchan s
                end else if p < 0 & String.length s < -p then begin
                  output_string outchan s;
                  output_string outchan
                                (String.make (-p - String.length s) ' ')
                end else
                  output_string outchan s
              end;
              doprn (succ j))
        | 'c' ->
            Obj.magic(fun c ->
              output_char outchan c;
              doprn (succ j))
        | 'd' | 'o' | 'x' | 'X' | 'u' ->
            Obj.magic(fun n ->
              output_string outchan
                            (format_int (String.sub format i (j-i+1)) n);
              doprn (succ j))
        | 'f' | 'e' | 'E' | 'g' | 'G' ->
            Obj.magic(fun f ->
              output_string outchan
                            (format_float (String.sub format i (j-i+1)) f);
              doprn (succ j))
        | 'b' ->
            Obj.magic(fun b ->
              output_string outchan (string_of_bool b);
              doprn (succ j))
        | 'a' ->
            Obj.magic(fun printer arg ->
              printer outchan arg;
              doprn(succ j))
        | 't' ->
            Obj.magic(fun printer ->
              printer outchan;
              doprn(succ j))
        | c ->
            invalid_arg ("fprintf: unknown format")
      end
    end

  and skip_args j =
    match String.unsafe_get format j with
      '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
    | c -> j

  in doprn 0

let printf fmt = fprintf stdout fmt
and eprintf fmt = fprintf stderr fmt

let sprintf format =
  let format = (Obj.magic format : string) in
  let res = ref [] in
  let rec doprn start i =
    if i >= String.length format then begin
      if i > start then res := String.sub format start (i-start) :: !res;
      Obj.magic(String.concat "" (List.rev !res))
    end else
      if String.unsafe_get format i <> '%' then
        doprn start (i+1)
      else begin
        if i > start then res := String.sub format start (i-start) :: !res;
        let j = skip_args (succ i) in
        match String.unsafe_get format j with
          '%' ->
            doprn j (succ j)
        | 's' ->
            Obj.magic(fun s ->
              if j <= i+1 then
                res := s :: !res
              else begin
                let p =
                  try
                    int_of_string (String.sub format (i+1) (j-i-1))
                  with _ ->
                    invalid_arg "fprintf: bad %s format" in
                if p > 0 & String.length s < p then begin
                  res := String.make (p - String.length s) ' ' :: !res;
                  res := s :: !res
                end else if p < 0 & String.length s < -p then begin
                  res := s :: !res;
                  res := String.make (-p - String.length s) ' ' :: !res
                end else
                  res := s :: !res
              end;
              doprn (succ j) (succ j))
        | 'c' ->
            Obj.magic(fun c ->
              res := String.make 1 c :: !res;
              doprn (succ j) (succ j))
        | 'd' | 'o' | 'x' | 'X' | 'u' ->
            Obj.magic(fun n ->
              res := format_int (String.sub format i (j-i+1)) n :: !res;
              doprn (succ j) (succ j))
        | 'f' | 'e' | 'E' | 'g' | 'G' ->
            Obj.magic(fun f ->
              res := format_float (String.sub format i (j-i+1)) f :: !res;
              doprn (succ j) (succ j))
        | 'b' ->
            Obj.magic(fun b ->
              res := string_of_bool b :: !res;
              doprn (succ j) (succ j))
        | 'a' ->
            Obj.magic(fun printer arg ->
              res := printer () arg :: !res;
              doprn (succ j) (succ j))
        | 't' ->
            Obj.magic(fun printer ->
              res := printer () :: !res;
              doprn (succ j) (succ j))
        | c ->
            invalid_arg ("sprintf: unknown format")
      end

  and skip_args j =
    match String.unsafe_get format j with
      '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
    | c -> j

  in doprn 0 0