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

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

Browse Source 
Mirrors iteration 101's parse-fun change inside parse-let's
parse-one!:

  - same '(IDENT, ...)' detection on collect-params
  - same __pat_N synth name for the function param
  - same innermost-first match-wrapping

Difference: for inner-let the wrapping is applied to the rhs of the
let-binding (which is the function value), not directly to a fun
body.

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

46
lib/ocaml/parser.sx
View File

@@ -826,13 +826,33 @@
(define parse-one!
(fn ()
(let ((nm (ocaml-tok-value (consume! "ident" nil)))
(ps (list)))
(ps (list))
(tuple-binds (list)))
(begin
(define collect-params
(fn ()
(let ((p (try-consume-param!)))
(when (not (= p nil))
(begin (append! ps p) (collect-params))))))
(cond
;; `(IDENT, ...)` — tuple param.
((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)) ")")))
(cond
((= (ocaml-tok-value (peek-tok-at 2)) ":")
(let ((p (try-consume-param!)))
(when (not (= p nil))
(begin (append! ps p) (collect-params)))))
(else
(let ((pat (parse-pattern)))
(let ((sn (str "__pat_" (len tuple-binds))))
(begin
(append! tuple-binds (list sn pat))
(append! ps sn)
(collect-params)))))))
(else
(let ((p (try-consume-param!)))
(when (not (= p nil))
(begin (append! ps p) (collect-params))))))))
(collect-params)
;; Optional type annotation: skip `: TYPE` before `=`.
(when (at-op? ":")
@@ -848,7 +868,23 @@
(skip-tann)))
(consume! "op" "=")
(let ((rhs (parse-expr)))
(append! bindings (list nm ps rhs)))))))
(begin
;; Wrap rhs with `match __pat_N with PAT -> ...`
;; for each tuple-param, innermost first.
(let ((wrapped rhs))
(begin
(define wrap-binds
(fn (xs)
(when (not (= xs (list)))
(begin
(let ((sn (nth (first xs) 0))
(pat (nth (first xs) 1)))
(set! wrapped
(list :match (list :var sn)
(list (list :case pat wrapped)))))
(wrap-binds (rest xs))))))
(wrap-binds (reverse tuple-binds))
(append! bindings (list nm ps wrapped))))))))))
(parse-one!)
(define more
(fn ()