ocaml: phase 6 Printf width specifiers %5d/%-5d/%05d/%4s (+5 tests, 538 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
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'
This commit is contained in:
@@ -512,36 +512,89 @@
|
|||||||
end ;;
|
end ;;
|
||||||
|
|
||||||
module Printf = struct
|
module Printf = struct
|
||||||
(* sprintf walks fmt, accumulating prefix. When it sees a %X
|
(* sprintf walks fmt char-by-char. On '%' it parses optional
|
||||||
spec, it returns a function of one arg that substitutes the
|
flags ('-' for left-justify, '0' for zero-pad), an optional
|
||||||
arg and recurses on the rest of fmt. With no specs, returns
|
decimal width, and a final spec letter. Specs supported:
|
||||||
the bare format string. Specs supported: %d %s %f %c %b
|
%d %i %u %s %f %c %b %x %X %o (and %% as a literal).
|
||||||
(and %% as a literal). Unknown specs are passed through. *)
|
Width pads the formatted argument to at least N characters. *)
|
||||||
let sprintf fmt =
|
let sprintf fmt =
|
||||||
let n = _string_length fmt in
|
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 =
|
let rec walk pos prefix =
|
||||||
if pos >= n then prefix
|
if pos >= n then prefix
|
||||||
else if pos + 1 < n && _string_get fmt pos = \"%\" then
|
else if pos + 1 < n && _string_get fmt pos = \"%\" then
|
||||||
let spec = _string_get fmt (pos + 1) in
|
if _string_get fmt (pos + 1) = \"%\" then
|
||||||
if spec = \"%\" then walk (pos + 2) (prefix ^ \"%\")
|
walk (pos + 2) (prefix ^ \"%\")
|
||||||
else if spec = \"d\" || spec = \"i\" || spec = \"s\"
|
else
|
||||||
|| spec = \"f\" || spec = \"c\" || spec = \"b\"
|
let left_flag = ref false in
|
||||||
|| spec = \"x\" || spec = \"X\" || spec = \"o\"
|
let zero_flag = ref false in
|
||||||
|| spec = \"u\" then
|
let after_flags = parse_flags_loop (pos + 1) left_flag zero_flag in
|
||||||
(fun arg ->
|
let packed = parse_width_loop after_flags in
|
||||||
let s =
|
let width = packed / 1000000 in
|
||||||
if spec = \"d\" || spec = \"i\" || spec = \"u\"
|
let spec_pos = packed - width * 1000000 in
|
||||||
then _string_of_int arg
|
if spec_pos < n && is_spec (_string_get fmt spec_pos) then
|
||||||
else if spec = \"f\" then _string_of_float arg
|
let spec = _string_get fmt spec_pos in
|
||||||
else if spec = \"x\" then _int_to_hex_lower arg
|
let left = !left_flag in
|
||||||
else if spec = \"X\" then _int_to_hex_upper arg
|
let zero = !zero_flag in
|
||||||
else if spec = \"o\" then _int_to_octal arg
|
(fun arg ->
|
||||||
else if spec = \"b\" then
|
let raw =
|
||||||
(if arg then \"true\" else \"false\")
|
if spec = \"d\" || spec = \"i\" || spec = \"u\"
|
||||||
else arg
|
then _string_of_int arg
|
||||||
in
|
else if spec = \"f\" then _string_of_float arg
|
||||||
walk (pos + 2) (prefix ^ s))
|
else if spec = \"x\" then _int_to_hex_lower arg
|
||||||
else walk (pos + 1) (prefix ^ _string_get fmt pos)
|
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)
|
else walk (pos + 1) (prefix ^ _string_get fmt pos)
|
||||||
in
|
in
|
||||||
walk 0 \"\"
|
walk 0 \"\"
|
||||||
|
|||||||
@@ -1330,6 +1330,18 @@ cat > "$TMPFILE" << 'EPOCHS'
|
|||||||
(epoch 5074)
|
(epoch 5074)
|
||||||
(eval "(ocaml-run \"Printf.sprintf \\\"%x %X %o\\\" 255 4096 8\")")
|
(eval "(ocaml-run \"Printf.sprintf \\\"%x %X %o\\\" 255 4096 8\")")
|
||||||
|
|
||||||
|
;; ── Printf width specifiers ─────────────────────────────────
|
||||||
|
(epoch 5080)
|
||||||
|
(eval "(ocaml-run \"Printf.sprintf \\\"%5d\\\" 42\")")
|
||||||
|
(epoch 5081)
|
||||||
|
(eval "(ocaml-run \"Printf.sprintf \\\"%-5d|\\\" 42\")")
|
||||||
|
(epoch 5082)
|
||||||
|
(eval "(ocaml-run \"Printf.sprintf \\\"%05d\\\" 42\")")
|
||||||
|
(epoch 5083)
|
||||||
|
(eval "(ocaml-run \"Printf.sprintf \\\"%4s\\\" \\\"hi\\\"\")")
|
||||||
|
(epoch 5084)
|
||||||
|
(eval "(ocaml-run \"Printf.sprintf \\\"hi=%-3d, hex=%04x\\\" 9 15\")")
|
||||||
|
|
||||||
EPOCHS
|
EPOCHS
|
||||||
|
|
||||||
OUTPUT=$(timeout 360 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
OUTPUT=$(timeout 360 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
||||||
@@ -2113,6 +2125,13 @@ check 5072 "%X 4096" '"1000"'
|
|||||||
check 5073 "%o 8" '"10"'
|
check 5073 "%o 8" '"10"'
|
||||||
check 5074 "%x %X %o multi" '"ff 1000 10"'
|
check 5074 "%x %X %o multi" '"ff 1000 10"'
|
||||||
|
|
||||||
|
# ── Printf width specifiers ─────────────────────────────────────
|
||||||
|
check 5080 "%5d 42 right-pad" '" 42"'
|
||||||
|
check 5081 "%-5d| 42 left-pad" '"42 |"'
|
||||||
|
check 5082 "%05d 42 zero-pad" '"00042"'
|
||||||
|
check 5083 "%4s hi" '" hi"'
|
||||||
|
check 5084 "%-3d %04x mixed" '"hi=9 , hex=000f"'
|
||||||
|
|
||||||
TOTAL=$((PASS + FAIL))
|
TOTAL=$((PASS + FAIL))
|
||||||
if [ $FAIL -eq 0 ]; then
|
if [ $FAIL -eq 0 ]; then
|
||||||
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"
|
||||||
|
|||||||
@@ -407,6 +407,17 @@ _Newest first._
|
|||||||
binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree *
|
binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree *
|
||||||
'a tree`) with insert + in-order traversal. Tests parametric ADT,
|
'a tree`) with insert + in-order traversal. Tests parametric ADT,
|
||||||
recursive match, List.append, List.fold_left.
|
recursive match, List.append, List.fold_left.
|
||||||
|
- 2026-05-09 Phase 6 — Printf width specifiers `%5d` / `%-5d` /
|
||||||
|
`%05d` / `%4s` etc. (+5 tests, 538 total). Walker now parses
|
||||||
|
optional `-` (left-align) and `0` (zero-pad) flags after `%`, then
|
||||||
|
optional decimal width digits, then the spec letter. After
|
||||||
|
formatting the arg into a base string, pads to the width using
|
||||||
|
spaces (or zeros if `0` flag and not `-`). Encoded width+spec_pos
|
||||||
|
return as `width * 1000000 + spec_pos` because the parser does not
|
||||||
|
yet support tuple destructuring in `let` (TODO: lift that
|
||||||
|
limitation; for now this round-trips losslessly for any practical
|
||||||
|
width). Examples: `%5d` 42 = " 42", `%-5d|` 42 = "42 |",
|
||||||
|
`%05d` 42 = "00042".
|
||||||
- 2026-05-09 Phase 6 — Printf.sprintf adds %i, %u (aliases of %d),
|
- 2026-05-09 Phase 6 — Printf.sprintf adds %i, %u (aliases of %d),
|
||||||
%x (lowercase hex), %X (uppercase hex), %o (octal) (+5 tests, 533
|
%x (lowercase hex), %X (uppercase hex), %o (octal) (+5 tests, 533
|
||||||
total). New host primitives `_int_to_hex_lower`, `_int_to_hex_upper`,
|
total). New host primitives `_int_to_hex_lower`, `_int_to_hex_upper`,
|
||||||
|
|||||||
Reference in New Issue
Block a user