diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index fd7db26a..b188298a 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -718,20 +718,60 @@ (fn () (let - ((params (list))) + ((params (list)) + (tuple-binds (list))) (begin (define collect-params (fn () - (let ((nm (try-consume-param!))) - (when (not (= nm nil)) - (begin (append! params nm) (collect-params)))))) + (cond + ;; `(IDENT, ...)` — tuple-pattern param. Generate a + ;; synthetic name and remember the pattern so we + ;; can wrap the body with a match. + ((and (at-op? "(") + (= (ocaml-tok-type (peek-tok-at 1)) "ident") + (or (= (ocaml-tok-value (peek-tok-at 2)) ",") + (= (ocaml-tok-value (peek-tok-at 2)) ")") + (= (ocaml-tok-value (peek-tok-at 2)) ":"))) + (cond + ;; (x : T) is a typed simple param — let the + ;; original try-consume-param! handle that. + ((= (ocaml-tok-value (peek-tok-at 2)) ":") + (let ((nm (try-consume-param!))) + (begin (append! params nm) (collect-params)))) + (else + (let ((pat (parse-pattern))) + (let ((nm (str "__pat_" (len tuple-binds)))) + (begin + (append! tuple-binds (list nm pat)) + (append! params nm) + (collect-params))))))) + (else + (let ((nm (try-consume-param!))) + (when (not (= nm nil)) + (begin (append! params nm) (collect-params)))))))) (collect-params) (when (= (len params) 0) (error "ocaml-parse: fun expects at least one parameter")) (consume! "op" "->") - (let ((body (parse-expr))) (list :fun params body)))))) + (let ((body (parse-expr))) + ;; Wrap body with `match __pat_N with PAT -> ...` for + ;; each tuple-param, innermost first. + (let ((wrapped body)) + (begin + (define wrap-binds + (fn (xs) + (when (not (= xs (list))) + (begin + (let ((nm (nth (first xs) 0)) + (pat (nth (first xs) 1))) + (set! wrapped + (list :match (list :var nm) + (list (list :case pat wrapped))))) + (wrap-binds (rest xs)))))) + (wrap-binds (reverse tuple-binds)) + (list :fun params wrapped)))))))) (define parse-let (fn () diff --git a/lib/ocaml/runtime.sx b/lib/ocaml/runtime.sx index 548a2f92..4fab4505 100644 --- a/lib/ocaml/runtime.sx +++ b/lib/ocaml/runtime.sx @@ -804,13 +804,8 @@ the keys/values projections that are commonly useful. *) let bindings t = _hashtbl_to_list t - let keys t = - List.map (fun pair -> match pair with (k, _) -> k) - (_hashtbl_to_list t) - - let values t = - List.map (fun pair -> match pair with (_, v) -> v) - (_hashtbl_to_list t) + let keys t = List.map (fun (k, _) -> k) (_hashtbl_to_list t) + let values t = List.map (fun (_, v) -> v) (_hashtbl_to_list t) let to_seq t = _hashtbl_to_list t let to_seq_keys = keys diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index b8c5500d..557461d0 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -1370,6 +1370,16 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 5113) (eval "(ocaml-run \"Random.init 7; Random.bool ()\")") +;; ── fun (a, b) -> body — tuple param destructure ────────────── +(epoch 5120) +(eval "(ocaml-run \"(fun (a, b) -> a + b) (3, 7)\")") +(epoch 5121) +(eval "(ocaml-run \"List.map (fun (a, b) -> a * b) [(1, 2); (3, 4); (5, 6)]\")") +(epoch 5122) +(eval "(ocaml-run \"List.map (fun (k, _) -> k) [(\\\"a\\\", 1); (\\\"b\\\", 2)]\")") +(epoch 5123) +(eval "(ocaml-run \"(fun a (b, c) d -> a + b + c + d) 1 (2, 3) 4\")") + EPOCHS OUTPUT=$(timeout 360 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -2177,6 +2187,12 @@ check 5111 "Random.int x3 seed=42 sum" '152' check 5112 "Random.int 10 seed=1" '0' check 5113 "Random.bool seed=7" 'true' +# ── fun (a, b) -> body tuple param ────────────────────────────── +check 5120 "fun (a, b) -> a + b" '10' +check 5121 "List.map fun (a, b)" '(2 12 30)' +check 5122 "List.map fun (k, _)" '("a" "b")' +check 5123 "fun a (b, c) d mixed" '10' + TOTAL=$((PASS + FAIL)) if [ $FAIL -eq 0 ]; then echo "ok $PASS/$TOTAL OCaml-on-SX tests passed" diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index 7d8df6d3..445d72ca 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -407,6 +407,16 @@ _Newest first._ binary search tree (`type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree`) with insert + in-order traversal. Tests parametric ADT, recursive match, List.append, List.fold_left. +- 2026-05-09 Phase 4 — `fun (a, b) -> body` tuple-param destructuring + (+4 tests, 553 total). parse-fun's collect-params now detects + `(IDENT, ...)` (lookahead at peek-tok-at 1/2 to distinguish from + `(x : T)` and `()` cases), generates a synthetic `__pat_N` name as + the actual fun param, and remembers the pattern in tuple-binds. + After parsing the body, wraps it innermost-first with one + `match __pat_N with PAT -> ...` per tuple-param. Also retroactively + simplifies `Hashtbl.keys`/`values` from + `fun pair -> match pair with (k, _) -> k` to plain + `fun (k, _) -> k`. - 2026-05-09 Phase 6 — Random module (LCG-based, deterministic) (+4 tests, 549 total). Linear-congruential PRNG with mutable seed (`_state` ref). API: init, self_init, int, bool, float, bits.