tcl: Phase 6 — namespace, list ops, dict additions, scan/format, exec [WIP]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Phase 6a (namespace `::` prefix): - tcl-global-ref?/strip-global helpers - tcl-var-get/set route ::name to root frame - tokenizer parse-var-sub accepts `::` start so $::var works - tcl-call-proc forwards :fileevents/:timers/:procs/:commands - char-at fast-path optimization on var-get/set hot path Phase 6b (list ops): added lassign, lrepeat, lset, lmap. Phase 6c (dict additions): added dict lappend, remove, filter -key. Phase 6d (scan/format): - printf-spec SX primitive wrapping OCaml Printf via Scanf.format_from_string - scan-spec SX primitive (manual scanner for d/i/u/x/X/o/c/s/f/e/g) - Tcl format dispatches via printf-spec; tcl-cmd-scan walks fmt and dispatches Phase 6e (exec): - exec-process SX primitive wraps Unix.create_process + waitpid - Tcl `exec cmd arg...` returns trimmed stdout; raises on non-zero exit test.sh inner timeout 3600s → 7200s (post-merge JIT recursion is slow). +27 idiom tests covering ns, list ops, dict, format, scan, exec. [WIP — full suite verification still pending] Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -528,6 +528,183 @@ let () =
|
||||
| [Rational (_, d)] -> Integer d
|
||||
| [Integer _] -> Integer 1
|
||||
| _ -> raise (Eval_error "denominator: expected rational or integer"));
|
||||
(* printf-spec: apply one Tcl/printf format spec to one arg.
|
||||
spec is like "%5.2f", "%-10s", "%x", "%c", "%d". Always starts with %
|
||||
and ends with the conversion char. Supports d i u x X o c s f e g.
|
||||
Coerces arg to the right type per conversion. *)
|
||||
register "printf-spec" (fun args ->
|
||||
let spec_str, arg = match args with
|
||||
| [String s; v] -> (s, v)
|
||||
| _ -> raise (Eval_error "printf-spec: (spec arg)")
|
||||
in
|
||||
let n = String.length spec_str in
|
||||
if n < 2 || spec_str.[0] <> '%' then
|
||||
raise (Eval_error ("printf-spec: invalid spec " ^ spec_str));
|
||||
let type_char = spec_str.[n - 1] in
|
||||
let to_int v = match v with
|
||||
| Integer i -> i
|
||||
| Number f -> int_of_float f
|
||||
| String s ->
|
||||
let s = String.trim s in
|
||||
(try int_of_string s
|
||||
with _ ->
|
||||
try int_of_float (float_of_string s)
|
||||
with _ -> 0)
|
||||
| Bool true -> 1 | Bool false -> 0
|
||||
| _ -> 0
|
||||
in
|
||||
let to_float v = match v with
|
||||
| Number f -> f
|
||||
| Integer i -> float_of_int i
|
||||
| String s ->
|
||||
let s = String.trim s in
|
||||
(try float_of_string s with _ -> 0.0)
|
||||
| _ -> 0.0
|
||||
in
|
||||
let to_string v = match v with
|
||||
| String s -> s
|
||||
| Integer i -> string_of_int i
|
||||
| Number f -> Sx_types.format_number f
|
||||
| Bool true -> "1" | Bool false -> "0"
|
||||
| Nil -> ""
|
||||
| _ -> Sx_types.inspect v
|
||||
in
|
||||
try
|
||||
match type_char with
|
||||
| 'd' | 'i' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%d" in
|
||||
String (Printf.sprintf fmt (to_int arg))
|
||||
| 'u' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%u" in
|
||||
String (Printf.sprintf fmt (to_int arg))
|
||||
| 'x' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%x" in
|
||||
String (Printf.sprintf fmt (to_int arg))
|
||||
| 'X' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%X" in
|
||||
String (Printf.sprintf fmt (to_int arg))
|
||||
| 'o' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%o" in
|
||||
String (Printf.sprintf fmt (to_int arg))
|
||||
| 'c' ->
|
||||
let n_val = to_int arg in
|
||||
let body = String.sub spec_str 0 (n - 1) in
|
||||
let fmt = Scanf.format_from_string (body ^ "s") "%s" in
|
||||
String (Printf.sprintf fmt (String.make 1 (Char.chr (n_val land 0xff))))
|
||||
| 's' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%s" in
|
||||
String (Printf.sprintf fmt (to_string arg))
|
||||
| 'f' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%f" in
|
||||
String (Printf.sprintf fmt (to_float arg))
|
||||
| 'e' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%e" in
|
||||
String (Printf.sprintf fmt (to_float arg))
|
||||
| 'E' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%E" in
|
||||
String (Printf.sprintf fmt (to_float arg))
|
||||
| 'g' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%g" in
|
||||
String (Printf.sprintf fmt (to_float arg))
|
||||
| 'G' ->
|
||||
let fmt = Scanf.format_from_string spec_str "%G" in
|
||||
String (Printf.sprintf fmt (to_float arg))
|
||||
| _ -> raise (Eval_error ("printf-spec: unsupported conversion " ^ String.make 1 type_char))
|
||||
with
|
||||
| Eval_error _ as e -> raise e
|
||||
| _ -> raise (Eval_error ("printf-spec: invalid format " ^ spec_str)));
|
||||
|
||||
(* scan-spec: apply one Tcl/scanf format spec to a string.
|
||||
Returns (consumed-count . parsed-value), or nil on failure. *)
|
||||
register "scan-spec" (fun args ->
|
||||
let spec_str, str = match args with
|
||||
| [String s; String input] -> (s, input)
|
||||
| _ -> raise (Eval_error "scan-spec: (spec input)")
|
||||
in
|
||||
let n = String.length spec_str in
|
||||
if n < 2 || spec_str.[0] <> '%' then
|
||||
raise (Eval_error ("scan-spec: invalid spec " ^ spec_str));
|
||||
let type_char = spec_str.[n - 1] in
|
||||
let len = String.length str in
|
||||
(* skip leading whitespace for non-%c/%s conversions *)
|
||||
let i = ref 0 in
|
||||
if type_char <> 'c' then
|
||||
while !i < len && (str.[!i] = ' ' || str.[!i] = '\t' || str.[!i] = '\n') do incr i done;
|
||||
let start = !i in
|
||||
try
|
||||
match type_char with
|
||||
| 'd' | 'i' ->
|
||||
let j = ref !i in
|
||||
if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
|
||||
while !j < len && str.[!j] >= '0' && str.[!j] <= '9' do incr j done;
|
||||
if !j > start && (str.[start] >= '0' && str.[start] <= '9'
|
||||
|| (!j > start + 1 && (str.[start] = '-' || str.[start] = '+'))) then
|
||||
let n_val = int_of_string (String.sub str start (!j - start)) in
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "value" (Integer n_val);
|
||||
Hashtbl.replace d "consumed" (Integer !j);
|
||||
Dict d
|
||||
else Nil
|
||||
| 'x' | 'X' ->
|
||||
let j = ref !i in
|
||||
while !j < len &&
|
||||
((str.[!j] >= '0' && str.[!j] <= '9') ||
|
||||
(str.[!j] >= 'a' && str.[!j] <= 'f') ||
|
||||
(str.[!j] >= 'A' && str.[!j] <= 'F')) do incr j done;
|
||||
if !j > start then
|
||||
let n_val = int_of_string ("0x" ^ String.sub str start (!j - start)) in
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "value" (Integer n_val);
|
||||
Hashtbl.replace d "consumed" (Integer !j);
|
||||
Dict d
|
||||
else Nil
|
||||
| 'o' ->
|
||||
let j = ref !i in
|
||||
while !j < len && str.[!j] >= '0' && str.[!j] <= '7' do incr j done;
|
||||
if !j > start then
|
||||
let n_val = int_of_string ("0o" ^ String.sub str start (!j - start)) in
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "value" (Integer n_val);
|
||||
Hashtbl.replace d "consumed" (Integer !j);
|
||||
Dict d
|
||||
else Nil
|
||||
| 'f' | 'e' | 'g' ->
|
||||
let j = ref !i in
|
||||
if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
|
||||
while !j < len && ((str.[!j] >= '0' && str.[!j] <= '9') || str.[!j] = '.') do incr j done;
|
||||
if !j < len && (str.[!j] = 'e' || str.[!j] = 'E') then begin
|
||||
incr j;
|
||||
if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
|
||||
while !j < len && str.[!j] >= '0' && str.[!j] <= '9' do incr j done
|
||||
end;
|
||||
if !j > start then
|
||||
let f_val = float_of_string (String.sub str start (!j - start)) in
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "value" (Number f_val);
|
||||
Hashtbl.replace d "consumed" (Integer !j);
|
||||
Dict d
|
||||
else Nil
|
||||
| 's' ->
|
||||
let j = ref !i in
|
||||
while !j < len && str.[!j] <> ' ' && str.[!j] <> '\t' && str.[!j] <> '\n' do incr j done;
|
||||
if !j > start then
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "value" (String (String.sub str start (!j - start)));
|
||||
Hashtbl.replace d "consumed" (Integer !j);
|
||||
Dict d
|
||||
else Nil
|
||||
| 'c' ->
|
||||
if !i < len then
|
||||
let d = Hashtbl.create 2 in
|
||||
Hashtbl.replace d "value" (Integer (Char.code str.[!i]));
|
||||
Hashtbl.replace d "consumed" (Integer (!i + 1));
|
||||
Dict d
|
||||
else Nil
|
||||
| _ -> raise (Eval_error ("scan-spec: unsupported conversion " ^ String.make 1 type_char))
|
||||
with
|
||||
| Eval_error _ as e -> raise e
|
||||
| _ -> Nil);
|
||||
|
||||
register "parse-int" (fun args ->
|
||||
let parse_leading_int s =
|
||||
let len = String.length s in
|
||||
@@ -3366,6 +3543,62 @@ let () =
|
||||
Nil
|
||||
| _ -> raise (Eval_error "channel-set-blocking!: (channel bool)"));
|
||||
|
||||
(* === Exec === run an external process; capture stdout *)
|
||||
register "exec-process" (fun args ->
|
||||
let items = match args with
|
||||
| [List xs] | [ListRef { contents = xs }] -> xs
|
||||
| _ -> raise (Eval_error "exec-process: (cmd-list)")
|
||||
in
|
||||
let argv = Array.of_list (List.map (function
|
||||
| String s -> s
|
||||
| v -> Sx_types.inspect v
|
||||
) items) in
|
||||
if Array.length argv = 0 then raise (Eval_error "exec: empty command");
|
||||
let (out_r, out_w) = Unix.pipe () in
|
||||
let (err_r, err_w) = Unix.pipe () in
|
||||
let pid =
|
||||
try Unix.create_process argv.(0) argv Unix.stdin out_w err_w
|
||||
with Unix.Unix_error (e, _, _) ->
|
||||
Unix.close out_r; Unix.close out_w;
|
||||
Unix.close err_r; Unix.close err_w;
|
||||
raise (Eval_error ("exec: " ^ Unix.error_message e))
|
||||
in
|
||||
Unix.close out_w;
|
||||
Unix.close err_w;
|
||||
let buf = Buffer.create 256 in
|
||||
let errbuf = Buffer.create 64 in
|
||||
let chunk = Bytes.create 4096 in
|
||||
let read_all fd target =
|
||||
try
|
||||
let stop = ref false in
|
||||
while not !stop do
|
||||
let n = Unix.read fd chunk 0 (Bytes.length chunk) in
|
||||
if n = 0 then stop := true
|
||||
else Buffer.add_subbytes target chunk 0 n
|
||||
done
|
||||
with _ -> ()
|
||||
in
|
||||
read_all out_r buf;
|
||||
read_all err_r errbuf;
|
||||
Unix.close out_r;
|
||||
Unix.close err_r;
|
||||
let (_, status) = Unix.waitpid [] pid in
|
||||
let exit_code = match status with
|
||||
| Unix.WEXITED n -> n
|
||||
| Unix.WSIGNALED _ | Unix.WSTOPPED _ -> 1
|
||||
in
|
||||
let s = Buffer.contents buf in
|
||||
let trimmed =
|
||||
if String.length s > 0 && s.[String.length s - 1] = '\n'
|
||||
then String.sub s 0 (String.length s - 1) else s
|
||||
in
|
||||
if exit_code <> 0 then
|
||||
raise (Eval_error ("exec: child exited " ^ string_of_int exit_code
|
||||
^ (if Buffer.length errbuf > 0
|
||||
then ": " ^ Buffer.contents errbuf
|
||||
else "")))
|
||||
else String trimmed);
|
||||
|
||||
(* === Sockets === wrapping Unix.socket/connect/bind/listen/accept *)
|
||||
let resolve_inet_addr host =
|
||||
if host = "" || host = "0.0.0.0" then Unix.inet_addr_any
|
||||
|
||||
Reference in New Issue
Block a user