coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ocaml: phase 4 top-level 'let f (a, b) = body' tuple-param decl (+3 tests, 559 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 46s
Details

Browse Source 
parse-decl-let lives in the outer ocaml-parse-program scope and does
not have access to parse-pattern (which is local to ocaml-parse).
Source-slicing approach instead:

  1. detect '(IDENT, ...)' in collect-params
  2. scan tokens to the matching ')' (tracking nested parens)
  3. slice the pattern source string from src
  4. push (synth_name, pat_src) onto tuple-srcs

Then after collecting params, the rhs source string gets wrapped with
'match SN with PAT_SRC -> (RHS_SRC)' for each tuple-param,
innermost-first, and the final string is fed through ocaml-parse.

End result is the same AST shape as the iteration-102 inner-let
case: a function whose body destructures a synthetic name.

  let f (a, b) = a + b ;; f (3, 7)            = 10
  let g x (a, b) = x + a + b ;; g 1 (2, 3)    = 6
  let h (a, b) (c, d) = a * b + c * d
  ;; h (1, 2) (3, 4)                          = 14
This commit is contained in:
giles
2026-05-09 04:51:11 +00:00
parent b526d81a4c
commit 82ffc695a5
3 changed files with 78 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
lib/ocaml/parser.sx
View File

@@ -1288,7 +1288,8 @@
(str "__unit_" idx)))
(else
(ocaml-tok-value (consume! "ident" nil)))))
(ps (list)))
(ps (list))
(tuple-srcs (list)))
(begin
(define collect-params
(fn ()
@@ -1307,6 +1308,39 @@
(advance-tok!) (advance-tok!)
(append! ps (str "__unit_" idx))
(collect-params)))
;; `(IDENT, ...)` — tuple pattern. Slice the
;; source from `(` through matching `)` and
;; remember it; substitute synth-name.
((and (at-op? "(")
(< (+ idx 2) tok-len)
(= (ocaml-tok-type (nth tokens (+ idx 1)))
"ident")
(= (ocaml-tok-value (nth tokens (+ idx 2)))
","))
(let ((pat-start (cur-pos)) (depth 1))
(begin
(advance-tok!) ;; consume `(`
(define skip
(fn ()
(cond
((>= idx tok-len) nil)
((at-op? "(")
(begin (set! depth (+ depth 1))
(advance-tok!) (skip)))
((at-op? ")")
(cond
((= depth 1) (advance-tok!))
(else (begin
(set! depth (- depth 1))
(advance-tok!) (skip)))))
(else (begin (advance-tok!) (skip))))))
(skip)
(let ((sn (str "__pat_" (len tuple-srcs)))
(pat-src (slice src pat-start (cur-pos))))
(begin
(append! tuple-srcs (list sn pat-src))
(append! ps sn)
(collect-params))))))
(else nil))))
(collect-params)
;; Optional type annotation: skip `: TYPE` before `=`.
@@ -1326,8 +1360,26 @@
(begin
(skip-let-rhs-boundary!)
(let ((expr-src (slice src expr-start (cur-pos))))
(let ((expr (ocaml-parse expr-src)))
(append! bindings (list nm ps expr))))))))))
(begin
;; Wrap rhs src with `match __pat_N with PAT
;; -> ...` for each tuple-param, innermost
;; first, then re-parse.
(let ((wrapped expr-src))
(begin
(define wrap-binds
(fn (xs)
(when (not (= xs (list)))
(begin
(let ((sn (nth (first xs) 0))
(pat-src (nth (first xs) 1)))
(set! wrapped
(str "match " sn " with "
pat-src " -> ("
wrapped ")")))
(wrap-binds (rest xs))))))
(wrap-binds (reverse tuple-srcs))
(let ((expr (ocaml-parse wrapped)))
(append! bindings (list nm ps expr)))))))))))))
(parse-one!)
(define more
(fn ()

13
lib/ocaml/test.sh
View File

@@ -1388,6 +1388,14 @@ cat > "$TMPFILE" << 'EPOCHS'
(epoch 5132)
(eval "(ocaml-run \"let h (a, b) (c, d) = a * b + c * d in h (1, 2) (3, 4)\")")
;; ── top-level let f (a, b) = body — tuple param decl ──────────
(epoch 5140)
(eval "(ocaml-run-program \"let f (a, b) = a + b ;; f (3, 7)\")")
(epoch 5141)
(eval "(ocaml-run-program \"let g x (a, b) = x + a + b ;; g 1 (2, 3)\")")
(epoch 5142)
(eval "(ocaml-run-program \"let h (a, b) (c, d) = a * b + c * d ;; h (1, 2) (3, 4)\")")
EPOCHS
OUTPUT=$(timeout 360 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -2206,6 +2214,11 @@ check 5130 "let f (a, b) = a + b" '10'
check 5131 "let g x (a, b) mixed" '6'
check 5132 "let h (a, b) (c, d) curried" '14'
# ── top-level let f (a, b) = body — tuple param decl ────────────
check 5140 "top let f (a, b) = a+b" '10'
check 5141 "top let g x (a, b) mixed" '6'
check 5142 "top let h (a, b) (c, d)" '14'
TOTAL=$((PASS + FAIL))
if [ $FAIL -eq 0 ]; then
echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"

10
plans/ocaml-on-sx.md
View File

@@ -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 — top-level `let f (a, b) = body` tuple-param
decl (+3 tests, 559 total). parse-decl-let (which lives outside
the ocaml-parse scope and lacks parse-pattern access) uses a
source-slicing approach: detect `(IDENT, ...)`, scan tokens to
matching `)`, slice the pattern source string, store as
(synth_name, pat_src). After collecting params, wrap the rhs
source string with `match SN with PAT_SRC -> (RHS_SRC)` for each
tuple-param, innermost first, then ocaml-parse the wrapped
string. End result is the same shape as the inner-let case: a
function whose body destructures a synthetic name.
- 2026-05-09 Phase 4 — `let f (a, b) = body in body2` tuple-param on
inner-let bindings (+3 tests, 556 total). Mirrors iteration 101's
parse-fun change inside parse-let's parse-one!: same `(IDENT, ...)`