tcl: Phase 3 OCaml primitives — file-read/write/append/exists?/glob + clock-seconds/milliseconds/format in sx_primitives.ml + unix dep; tcl-cmd-clock/file wired up; 337/337 green
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
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -1,4 +1,4 @@
|
||||
(library
|
||||
(name sx)
|
||||
(wrapped false)
|
||||
(libraries re re.pcre))
|
||||
(libraries re re.pcre unix))
|
||||
|
||||
@@ -1871,4 +1871,143 @@ let () =
|
||||
| [rx] ->
|
||||
let (_, _, flags) = regex_of_value rx in
|
||||
String flags
|
||||
| _ -> raise (Eval_error "regex-flags: (regex)"))
|
||||
| _ -> raise (Eval_error "regex-flags: (regex)"));
|
||||
|
||||
(* === File I/O === *)
|
||||
register "file-read" (fun args ->
|
||||
match args with
|
||||
| [String path] ->
|
||||
(try
|
||||
let ic = open_in path in
|
||||
let n = in_channel_length ic in
|
||||
let s = Bytes.create n in
|
||||
really_input ic s 0 n;
|
||||
close_in ic;
|
||||
String (Bytes.to_string s)
|
||||
with Sys_error msg -> raise (Eval_error ("file-read: " ^ msg)))
|
||||
| _ -> raise (Eval_error "file-read: (path)"));
|
||||
|
||||
register "file-write" (fun args ->
|
||||
match args with
|
||||
| [String path; String content] ->
|
||||
(try
|
||||
let oc = open_out path in
|
||||
output_string oc content;
|
||||
close_out oc;
|
||||
Nil
|
||||
with Sys_error msg -> raise (Eval_error ("file-write: " ^ msg)))
|
||||
| _ -> raise (Eval_error "file-write: (path content)"));
|
||||
|
||||
register "file-append" (fun args ->
|
||||
match args with
|
||||
| [String path; String content] ->
|
||||
(try
|
||||
let oc = open_out_gen [Open_append; Open_creat; Open_wronly; Open_text] 0o644 path in
|
||||
output_string oc content;
|
||||
close_out oc;
|
||||
Nil
|
||||
with Sys_error msg -> raise (Eval_error ("file-append: " ^ msg)))
|
||||
| _ -> raise (Eval_error "file-append: (path content)"));
|
||||
|
||||
register "file-exists?" (fun args ->
|
||||
match args with
|
||||
| [String path] -> Bool (Sys.file_exists path)
|
||||
| _ -> raise (Eval_error "file-exists?: (path)"));
|
||||
|
||||
register "file-glob" (fun args ->
|
||||
let glob_match pat str =
|
||||
let pn = String.length pat and sn = String.length str in
|
||||
let rec go pi si =
|
||||
if pi = pn then si = sn
|
||||
else match pat.[pi] with
|
||||
| '*' ->
|
||||
let rec try_from i = i <= sn && (go (pi+1) i || try_from (i+1)) in
|
||||
try_from si
|
||||
| '?' -> si < sn && go (pi+1) (si+1)
|
||||
| '[' ->
|
||||
let pi' = ref (pi+1) in
|
||||
let negate = !pi' < pn && pat.[!pi'] = '^' in
|
||||
if negate then incr pi';
|
||||
let matched = ref false in
|
||||
while !pi' < pn && pat.[!pi'] <> ']' do
|
||||
let c1 = pat.[!pi'] in
|
||||
incr pi';
|
||||
if !pi' + 1 < pn && pat.[!pi'] = '-' then begin
|
||||
let c2 = pat.[!pi' + 1] in
|
||||
pi' := !pi' + 2;
|
||||
if si < sn && str.[si] >= c1 && str.[si] <= c2 then matched := true
|
||||
end else if si < sn && str.[si] = c1 then matched := true
|
||||
done;
|
||||
if !pi' < pn then incr pi';
|
||||
((!matched && not negate) || (not !matched && negate)) && go !pi' (si+1)
|
||||
| c -> si < sn && str.[si] = c && go (pi+1) (si+1)
|
||||
in go 0 0
|
||||
in
|
||||
let glob_paths pat =
|
||||
let dir = Filename.dirname pat in
|
||||
let base_pat = Filename.basename pat in
|
||||
let dir' = if dir = "." && not (String.length pat > 1 && pat.[0] = '.') then "." else dir in
|
||||
(try
|
||||
let entries = Sys.readdir dir' in
|
||||
Array.fold_left (fun acc entry ->
|
||||
if glob_match base_pat entry then
|
||||
let full = if dir' = "." then entry else Filename.concat dir' entry in
|
||||
full :: acc
|
||||
else acc
|
||||
) [] entries
|
||||
|> List.sort String.compare
|
||||
with Sys_error _ -> [])
|
||||
in
|
||||
match args with
|
||||
| [String pat] -> List (List.map (fun s -> String s) (glob_paths pat))
|
||||
| _ -> raise (Eval_error "file-glob: (pattern)"));
|
||||
|
||||
(* === Clock === *)
|
||||
register "clock-seconds" (fun args ->
|
||||
match args with
|
||||
| [] -> Number (Float.round (Unix.gettimeofday ()))
|
||||
| _ -> raise (Eval_error "clock-seconds: no args"));
|
||||
|
||||
register "clock-milliseconds" (fun args ->
|
||||
match args with
|
||||
| [] -> Number (Float.round (Unix.gettimeofday () *. 1000.0))
|
||||
| _ -> raise (Eval_error "clock-milliseconds: no args"));
|
||||
|
||||
register "clock-format" (fun args ->
|
||||
match args with
|
||||
| [Number t_f] | [Number t_f; String _] ->
|
||||
let t = int_of_float t_f in
|
||||
let fmt = (match args with [_; String f] -> f | _ -> "%a %b %e %H:%M:%S %Z %Y") in
|
||||
let tm = Unix.gmtime (float_of_int t) in
|
||||
let buf = Buffer.create 32 in
|
||||
let n = String.length fmt in
|
||||
let i = ref 0 in
|
||||
while !i < n do
|
||||
if fmt.[!i] = '%' && !i + 1 < n then begin
|
||||
(match fmt.[!i + 1] with
|
||||
| 'Y' -> Buffer.add_string buf (Printf.sprintf "%04d" (1900 + tm.Unix.tm_year))
|
||||
| 'm' -> Buffer.add_string buf (Printf.sprintf "%02d" (tm.Unix.tm_mon + 1))
|
||||
| 'd' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_mday)
|
||||
| 'e' -> Buffer.add_string buf (Printf.sprintf "%2d" tm.Unix.tm_mday)
|
||||
| 'H' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_hour)
|
||||
| 'M' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_min)
|
||||
| 'S' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_sec)
|
||||
| 'j' -> Buffer.add_string buf (Printf.sprintf "%03d" (tm.Unix.tm_yday + 1))
|
||||
| 'Z' -> Buffer.add_string buf "UTC"
|
||||
| 'a' -> let days = [|"Sun";"Mon";"Tue";"Wed";"Thu";"Fri";"Sat"|] in
|
||||
Buffer.add_string buf days.(tm.Unix.tm_wday)
|
||||
| 'A' -> let days = [|"Sunday";"Monday";"Tuesday";"Wednesday";"Thursday";"Friday";"Saturday"|] in
|
||||
Buffer.add_string buf days.(tm.Unix.tm_wday)
|
||||
| 'b' | 'h' -> let mons = [|"Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"|] in
|
||||
Buffer.add_string buf mons.(tm.Unix.tm_mon)
|
||||
| 'B' -> let mons = [|"January";"February";"March";"April";"May";"June";"July";"August";"September";"October";"November";"December"|] in
|
||||
Buffer.add_string buf mons.(tm.Unix.tm_mon)
|
||||
| c -> Buffer.add_char buf '%'; Buffer.add_char buf c);
|
||||
i := !i + 2
|
||||
end else begin
|
||||
Buffer.add_char buf fmt.[!i];
|
||||
incr i
|
||||
end
|
||||
done;
|
||||
String (Buffer.contents buf)
|
||||
| _ -> raise (Eval_error "clock-format: (seconds [format])"))
|
||||
|
||||
Reference in New Issue
Block a user