Compare commits
4 Commits
bugs/resum
...
f480eb943c
| Author | SHA1 | Date | |
|---|---|---|---|
| f480eb943c | |||
| edc7e865b4 | |||
| ca151d7ed5 | |||
| 322eb1d034 |
@@ -355,7 +355,9 @@ let vm_create_closure vm_val frame_val code_val =
|
||||
let f = unwrap_frame frame_val in
|
||||
let uv_count = match code_val with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| Some (Integer n) -> n
|
||||
| Some (Number n) -> int_of_float n
|
||||
| _ -> 0)
|
||||
| _ -> 0
|
||||
in
|
||||
let upvalues = Array.init uv_count (fun _ ->
|
||||
|
||||
@@ -715,8 +715,10 @@ let () =
|
||||
| List (Symbol "code" :: rest) ->
|
||||
let d = Hashtbl.create 8 in
|
||||
let rec parse_kv = function
|
||||
| Keyword "arity" :: Number n :: rest -> Hashtbl.replace d "arity" (Number n); parse_kv rest
|
||||
| Keyword "upvalue-count" :: Number n :: rest -> Hashtbl.replace d "upvalue-count" (Number n); parse_kv rest
|
||||
| Keyword "arity" :: (Number _ as n) :: rest -> Hashtbl.replace d "arity" n; parse_kv rest
|
||||
| Keyword "arity" :: (Integer _ as n) :: rest -> Hashtbl.replace d "arity" n; parse_kv rest
|
||||
| Keyword "upvalue-count" :: (Number _ as n) :: rest -> Hashtbl.replace d "upvalue-count" n; parse_kv rest
|
||||
| Keyword "upvalue-count" :: (Integer _ as n) :: rest -> Hashtbl.replace d "upvalue-count" n; parse_kv rest
|
||||
| Keyword "bytecode" :: List nums :: rest ->
|
||||
Hashtbl.replace d "bytecode" (List nums); parse_kv rest
|
||||
| Keyword "constants" :: List consts :: rest ->
|
||||
|
||||
@@ -642,7 +642,9 @@ and run vm =
|
||||
(* Read upvalue descriptors from bytecode *)
|
||||
let uv_count = match code_val with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| Some (Integer n) -> n
|
||||
| Some (Number n) -> int_of_float n
|
||||
| _ -> 0)
|
||||
| _ -> 0
|
||||
in
|
||||
let upvalues = Array.init uv_count (fun _ ->
|
||||
@@ -1307,7 +1309,9 @@ let trace_run src globals =
|
||||
let code_val2 = frame.closure.vm_code.vc_constants.(idx) in
|
||||
let uv_count = match code_val2 with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| Some (Integer n) -> n
|
||||
| Some (Number n) -> int_of_float n
|
||||
| _ -> 0)
|
||||
| _ -> 0 in
|
||||
let upvalues = Array.init uv_count (fun _ ->
|
||||
let is_local = read_u8 frame in
|
||||
@@ -1428,7 +1432,9 @@ let disassemble (code : vm_code) =
|
||||
if op = 51 && idx < Array.length consts then begin
|
||||
let uv_count = match consts.(idx) with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| Some (Integer n) -> n
|
||||
| Some (Number n) -> int_of_float n
|
||||
| _ -> 0)
|
||||
| _ -> 0 in
|
||||
ip := !ip + uv_count * 2
|
||||
end
|
||||
|
||||
@@ -270,7 +270,9 @@ let vm_create_closure vm_val frame_val code_val =
|
||||
let f = unwrap_frame frame_val in
|
||||
let uv_count = match code_val with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| Some (Integer n) -> n
|
||||
| Some (Number n) -> int_of_float n
|
||||
| _ -> 0)
|
||||
| _ -> 0
|
||||
in
|
||||
let upvalues = Array.init uv_count (fun _ ->
|
||||
|
||||
@@ -265,7 +265,9 @@ let vm_create_closure vm_val frame_val code_val =
|
||||
let f = unwrap_frame frame_val in
|
||||
let uv_count = match code_val with
|
||||
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
|
||||
| Some (Number n) -> int_of_float n | _ -> 0)
|
||||
| Some (Integer n) -> n
|
||||
| Some (Number n) -> int_of_float n
|
||||
| _ -> 0)
|
||||
| _ -> 0
|
||||
in
|
||||
let upvalues = Array.init uv_count (fun _ ->
|
||||
|
||||
@@ -132,6 +132,31 @@ architectural improvement worth doing when the moment is right.
|
||||
|
||||
---
|
||||
|
||||
## Phase 5 — Channel I/O (random access + non-blocking) ✓
|
||||
|
||||
Real Tcl channel commands replacing the previous stubs. SX gained 11 channel
|
||||
primitives in `sx_primitives.ml` (using `Unix.openfile` + `Unix.read`/`write`/
|
||||
`lseek`/`set_nonblock`). Tcl `open`/`close`/`read`/`gets`/`puts`/`seek`/`tell`/
|
||||
`eof`/`flush`/`fconfigure` now wrap them.
|
||||
|
||||
| Status | Work | Unlocks in Tcl |
|
||||
|---|---|---|
|
||||
| [x] | `channel-open`, `channel-close` | `open` returns "fileN", `close` actually closes |
|
||||
| [x] | `channel-read`, `channel-read-line`, `channel-write` | `read`/`gets`/`puts` to/from real files |
|
||||
| [x] | `channel-seek`, `channel-tell` | random access — `seek $c offset start\|current\|end`, `tell` |
|
||||
| [x] | `channel-eof?`, `channel-flush` | proper EOF detection, no-op flush |
|
||||
| [x] | `channel-blocking?`, `channel-set-blocking!` | `fconfigure $c -blocking 0\|1` |
|
||||
|
||||
Modes supported: `r`, `w`, `a`, `r+`, `w+`, `a+`. Whence: `start`, `current`, `end`.
|
||||
|
||||
`puts` now detects channel argument (string starting with "file") and dispatches
|
||||
to `channel-write`; otherwise writes to `interp :output` as before.
|
||||
|
||||
**Total: ~half day. 7 new idiom tests covering write+read, gets-loop, seek/tell,
|
||||
eof-after-read, append mode, seek-to-end, fconfigure-blocking.**
|
||||
|
||||
---
|
||||
|
||||
## Suggested order
|
||||
|
||||
1. **Phase 1** — immediate Tcl wins, zero risk, proves the approach
|
||||
@@ -148,6 +173,7 @@ becomes a lasting SX contribution used by every future hosted language.
|
||||
|
||||
_Newest first._
|
||||
|
||||
- 2026-05-07: Phase 5 channel I/O — 11 SX primitives (channel-open/close/read/read-line/write/flush/seek/tell/eof?/blocking?/set-blocking!) wrapping Unix.openfile/read/write/lseek/set_nonblock; tcl-cmd-open/close/read/gets-chan/seek/tell/flush rewritten + new tcl-cmd-fconfigure; tcl-cmd-puts dispatches on "fileN" arg; gets registration fixed; +7 idiom tests; 349/349 green
|
||||
- 2026-05-06: Phase 4 env-as-value — current-env (special form via Sx_ref.register_special_form), eval-in-env (primitive in setup_evaluator_bridge), env-lookup + env-extend (in setup_env_operations); 5 idiom tests; 342/342 green
|
||||
- 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
|
||||
@@ -162,7 +188,7 @@ _Newest first._
|
||||
## What stays out of scope
|
||||
|
||||
- `package require` of binary loadables
|
||||
- Full `clock format` locale support
|
||||
- Full `clock format` locale support
|
||||
- Tk / GUI
|
||||
- Threads (mapped to coroutines only, as planned)
|
||||
- Full POSIX file I/O (seek/tell/async) — stubs are fine
|
||||
- `chan event` / `fileevent` — event-driven I/O callbacks (Phase 5 covers blocking + non-blocking flag, but no event loop dispatch)
|
||||
|
||||
Reference in New Issue
Block a user