ocaml: phase 6 Printf width specifiers %5d/%-5d/%05d/%4s (+5 tests, 538 total)

The Printf walker now parses optional flags + width digits between
'%' and the spec letter:

  -  left-align (default is right-align)
  0  zero-pad (default is space-pad; only honoured when not left-aligned)
  Nd... decimal width digits (any number)

After formatting the argument into a base string with the existing
spec dispatch (%d/%i/%u/%s/%f/%c/%b/%x/%X/%o), the result is padded
to the requested width.

Workaround: width and spec_pos are returned packed as
  width * 1000000 + spec_pos
because the parser does not yet support tuple destructuring in let
('let (a, b) = expr in body' fails with 'expected ident'). TODO: lift
that limitation; for now the encoding round-trips losslessly for any
practical width.

  Printf.sprintf '%5d'  42      = '   42'
  Printf.sprintf '%-5d|' 42     = '42   |'
  Printf.sprintf '%05d' 42      = '00042'
  Printf.sprintf '%4s' 'hi'     = '  hi'
  Printf.sprintf 'hi=%-3d, hex=%04x' 9 15 = 'hi=9  , hex=000f'

lib/ocaml/runtime.sx

@@ -512,36 +512,89 @@
    end ;;
 
    module Printf = struct
-     (* sprintf walks fmt, accumulating prefix. When it sees a %X
-        spec, it returns a function of one arg that substitutes the
-        arg and recurses on the rest of fmt. With no specs, returns
-        the bare format string. Specs supported: %d %s %f %c %b
-        (and %% as a literal). Unknown specs are passed through. *)
+     (* sprintf walks fmt char-by-char. On '%' it parses optional
+        flags ('-' for left-justify, '0' for zero-pad), an optional
+        decimal width, and a final spec letter. Specs supported:
+        %d %i %u %s %f %c %b %x %X %o (and %% as a literal).
+        Width pads the formatted argument to at least N characters. *)
      let sprintf fmt =
        let n = _string_length fmt in
+       let is_spec c =
+         c = \"d\" || c = \"i\" || c = \"u\" || c = \"s\" || c = \"f\"
+         || c = \"c\" || c = \"b\" || c = \"x\" || c = \"X\" || c = \"o\"
+       in
+       let is_digit c =
+         let k = _char_code c in k >= 48 && k <= 57
+       in
+       let pad s width left zero =
+         let pad_len = width - _string_length s in
+         if pad_len <= 0 then s
+         else
+           let ch = if zero && (not left) then \"0\" else \" \" in
+           let rec mk k acc = if k = 0 then acc else mk (k - 1) (acc ^ ch) in
+           let padding = mk pad_len \"\" in
+           if left then s ^ padding else padding ^ s
+       in
+       (* Skip flag chars from p, returning new pos. Records flags in
+          shared refs (set above each call). *)
+       let parse_flags_loop p left_flag zero_flag =
+         let i = ref p in
+         let cont = ref true in
+         while !cont do
+           if !i < n then
+             let c = _string_get fmt !i in
+             if c = \"-\" then (left_flag := true; i := !i + 1)
+             else if c = \"0\" then (zero_flag := true; i := !i + 1)
+             else cont := false
+           else cont := false
+         done;
+         !i
+       in
+       let parse_width_loop p =
+         let i = ref p in
+         let w = ref 0 in
+         let cont = ref true in
+         while !cont do
+           if !i < n then
+             let c = _string_get fmt !i in
+             if is_digit c then
+               (w := !w * 10 + (_char_code c - 48); i := !i + 1)
+             else cont := false
+           else cont := false
+         done;
+         (!w) * 1000000 + (!i)
+       in
        let rec walk pos prefix =
          if pos >= n then prefix
          else if pos + 1 < n && _string_get fmt pos = \"%\" then
-           let spec = _string_get fmt (pos + 1) in
-           if spec = \"%\" then walk (pos + 2) (prefix ^ \"%\")
-           else if spec = \"d\" || spec = \"i\" || spec = \"s\"
-                || spec = \"f\" || spec = \"c\" || spec = \"b\"
-                || spec = \"x\" || spec = \"X\" || spec = \"o\"
-                || spec = \"u\" then
-             (fun arg ->
-                let s =
-                  if spec = \"d\" || spec = \"i\" || spec = \"u\"
-                    then _string_of_int arg
-                  else if spec = \"f\" then _string_of_float arg
-                  else if spec = \"x\" then _int_to_hex_lower arg
-                  else if spec = \"X\" then _int_to_hex_upper arg
-                  else if spec = \"o\" then _int_to_octal arg
-                  else if spec = \"b\" then
-                    (if arg then \"true\" else \"false\")
-                  else arg
-                in
-                walk (pos + 2) (prefix ^ s))
-           else walk (pos + 1) (prefix ^ _string_get fmt pos)
+           if _string_get fmt (pos + 1) = \"%\" then
+             walk (pos + 2) (prefix ^ \"%\")
+           else
+             let left_flag = ref false in
+             let zero_flag = ref false in
+             let after_flags = parse_flags_loop (pos + 1) left_flag zero_flag in
+             let packed = parse_width_loop after_flags in
+             let width = packed / 1000000 in
+             let spec_pos = packed - width * 1000000 in
+             if spec_pos < n && is_spec (_string_get fmt spec_pos) then
+               let spec = _string_get fmt spec_pos in
+               let left = !left_flag in
+               let zero = !zero_flag in
+               (fun arg ->
+                  let raw =
+                    if spec = \"d\" || spec = \"i\" || spec = \"u\"
+                      then _string_of_int arg
+                    else if spec = \"f\" then _string_of_float arg
+                    else if spec = \"x\" then _int_to_hex_lower arg
+                    else if spec = \"X\" then _int_to_hex_upper arg
+                    else if spec = \"o\" then _int_to_octal arg
+                    else if spec = \"b\" then
+                      (if arg then \"true\" else \"false\")
+                    else arg
+                  in
+                  let s = pad raw width left zero in
+                  walk (spec_pos + 1) (prefix ^ s))
+             else walk (pos + 1) (prefix ^ _string_get fmt pos)
          else walk (pos + 1) (prefix ^ _string_get fmt pos)
        in
        walk 0 \"\"