diff --git a/hosts/ocaml/lib/dune b/hosts/ocaml/lib/dune index 4dd17fc1..0a5bf1a7 100644 --- a/hosts/ocaml/lib/dune +++ b/hosts/ocaml/lib/dune @@ -1,4 +1,4 @@ (library (name sx) (wrapped false) - (libraries re re.pcre)) + (libraries re re.pcre unix)) diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index ac03e182..0c4fcb3b 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -3000,4 +3000,142 @@ let () = List.iteri (fun i c -> Bytes.set b i c) bytes_list; SxBytevector b | [Nil] -> SxBytevector (Bytes.create 0) - | _ -> raise (Eval_error "list->bytevector: expected list")) + | _ -> raise (Eval_error "list->bytevector: expected list")); + + (* === 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 + | [] -> Integer (int_of_float (Unix.gettimeofday ())) + | _ -> raise (Eval_error "clock-seconds: no args")); + + register "clock-milliseconds" (fun args -> + match args with + | [] -> Integer (int_of_float (Unix.gettimeofday () *. 1000.0)) + | _ -> raise (Eval_error "clock-milliseconds: no args")); + + register "clock-format" (fun args -> + match args with + | [Integer t] | [Integer t; String _] -> + 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])")) diff --git a/lib/prolog/scoreboard.json b/lib/prolog/scoreboard.json index dfd36f21..ced1e7fb 100644 --- a/lib/prolog/scoreboard.json +++ b/lib/prolog/scoreboard.json @@ -3,5 +3,5 @@ "total_failed": 0, "total": 590, "suites": {"parse":{"passed":25,"total":25,"failed":0},"unify":{"passed":47,"total":47,"failed":0},"clausedb":{"passed":14,"total":14,"failed":0},"solve":{"passed":62,"total":62,"failed":0},"operators":{"passed":19,"total":19,"failed":0},"dynamic":{"passed":11,"total":11,"failed":0},"findall":{"passed":11,"total":11,"failed":0},"term_inspect":{"passed":14,"total":14,"failed":0},"append":{"passed":6,"total":6,"failed":0},"reverse":{"passed":6,"total":6,"failed":0},"member":{"passed":7,"total":7,"failed":0},"nqueens":{"passed":6,"total":6,"failed":0},"family":{"passed":10,"total":10,"failed":0},"atoms":{"passed":34,"total":34,"failed":0},"query_api":{"passed":16,"total":16,"failed":0},"iso_predicates":{"passed":29,"total":29,"failed":0},"meta_predicates":{"passed":25,"total":25,"failed":0},"list_predicates":{"passed":33,"total":33,"failed":0},"meta_call":{"passed":15,"total":15,"failed":0},"set_predicates":{"passed":15,"total":15,"failed":0},"char_predicates":{"passed":27,"total":27,"failed":0},"io_predicates":{"passed":24,"total":24,"failed":0},"assert_rules":{"passed":15,"total":15,"failed":0},"string_agg":{"passed":25,"total":25,"failed":0},"advanced":{"passed":21,"total":21,"failed":0},"compiler":{"passed":17,"total":17,"failed":0},"cross_validate":{"passed":17,"total":17,"failed":0},"integration":{"passed":20,"total":20,"failed":0},"hs_bridge":{"passed":19,"total":19,"failed":0}}, - "generated": "2026-05-06T08:29:09+00:00" + "generated": "2026-05-06T12:17:46+00:00" } diff --git a/lib/prolog/scoreboard.md b/lib/prolog/scoreboard.md index edd774a3..bacd6299 100644 --- a/lib/prolog/scoreboard.md +++ b/lib/prolog/scoreboard.md @@ -1,7 +1,7 @@ # Prolog scoreboard **590 / 590 passing** (0 failure(s)). -Generated 2026-05-06T08:29:09+00:00. +Generated 2026-05-06T12:17:46+00:00. | Suite | Passed | Total | Status | |-------|--------|-------|--------| diff --git a/plans/tcl-sx-completion.md b/plans/tcl-sx-completion.md index 67352326..7fb70a5c 100644 --- a/plans/tcl-sx-completion.md +++ b/plans/tcl-sx-completion.md @@ -34,7 +34,7 @@ Everything here is pure Tcl implementation work. | [x] | Float in `expr` — detect `.` in number tokens, route through float ops instead of `parse-int` | half day | `expr {3.14 * 2}`, `expr {sqrt(2.0)}`, float comparisons | | [x] | `regexp pattern str` and `regsub pattern str repl` wrapping existing SX primitives | few hours | pattern matching, text processing | | [x] | `apply {args body} ?arg…?` — anonymous proc call | 1 hour | higher-order functions, `lmap` idiom | -| [ ] | `array get/set/names/size/exists/unset` commands | half day | array variables (tokenizer already parses `$arr(key)`) | +| [x] | `array get/set/names/size/exists/unset` commands | half day | array variables (tokenizer already parses `$arr(key)`) | **Total: ~2 days. Zero SX changes.** @@ -42,6 +42,11 @@ Everything here is pure Tcl implementation work. ## Phase 2 — `lib/fiber.sx` (pure SX library, no OCaml) +| Status | Work | +|---|---| +| [x] | Create `lib/fiber.sx` — `make-fiber` / `fiber-resume` / `fiber-done?` | +| [x] | Rewrite `tcl-cmd-coroutine` to use `make-fiber` (true suspension) | + `call/cc` is multi-shot and `set!` on closed-over vars both work. Fibers are implementable as a pure SX library using symmetric continuation swapping: @@ -87,14 +92,14 @@ Tcl coroutines then rewrite using `make-fiber` for true suspension. Each is ~10–20 lines of OCaml. All are useful across the whole platform, not just Tcl. -| Primitive | OCaml effort | Unlocks | -|---|---|---| -| `(file-read path)` → string | tiny | Tcl `open`/`read`, SX scripts reading files | -| `(file-write path str)` → nil | tiny | Tcl `open`/`puts` to files | -| `(file-exists? path)` → bool | tiny | Tcl `file exists` | -| `(file-glob pattern)` → list | small | Tcl `glob` | -| `(clock-seconds)` → int | tiny | Tcl `clock seconds` | -| `(clock-format n fmt)` → string | small (wraps `strftime`) | Tcl `clock format` | +| Status | Primitive | OCaml effort | Unlocks | +|---|---|---|---| +| [x] | `(file-read path)` → string | tiny | Tcl `open`/`read`, SX scripts reading files | +| [x] | `(file-write path str)` → nil | tiny | Tcl `open`/`puts` to files | +| [x] | `(file-exists? path)` → bool | tiny | Tcl `file exists` | +| [x] | `(file-glob pattern)` → list | small | Tcl `glob` | +| [x] | `(clock-seconds)` → int | tiny | Tcl `clock seconds` | +| [x] | `(clock-format n fmt)` → string | small (wraps `strftime`) | Tcl `clock format` | **Total: 1 day. One focused afternoon of OCaml.** @@ -141,6 +146,10 @@ becomes a lasting SX contribution used by every future hosted language. _Newest first._ +- 2026-05-06: 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 +- 2026-05-06: Phase 2 coroutine rewrite — `tcl-cmd-coroutine` now creates a `make-fiber`; `tcl-cmd-yield` calls `:coro-yield-fn` (threaded through interp); true suspension; 337/337 green +- 2026-05-06: Phase 2 fiber.sx — `make-fiber`/`fiber-resume`/`fiber-done?` using call/cc + set!; bidirectional value passing; generator and echo tests pass +- 2026-05-06: Phase 1 array — `tcl-cmd-array` get/set/names/size/exists/unset; frame-local key scanning with prefix `arrname(`; 337/337 tests green - 2026-05-06: Phase 1 apply — `tcl-cmd-apply` wraps `tcl-call-proc`, parses `{args body}` funcList, full frame isolation; 329/329 tests green - 2026-05-06: Phase 1 regexp/regsub — `tcl-cmd-regexp`/`tcl-cmd-regsub` wrapping `make-regexp`/`regexp-match`/`regexp-match-all`/`regexp-replace`/`regexp-replace-all`; -nocase/-all/-inline/-all flags; matchVar + subgroup capture; 329/329 tests green - 2026-05-06: Phase 1 float expr — `tcl-num-float?`, `tcl-parse-num`, float-aware `tcl-apply-binop`/`tcl-apply-func`/unary-minus/`**`; `sqrt`/`floor`/`ceil`/`round`/`sin`/`cos`/`tan`/`pow`/`exp`/`log` all float-native; 329/329 tests green