ocaml: phase 2 function | pat -> body (+4 tests, 198 total)

Sugar for fun + match. AST (:function CLAUSES) -> unary closure that
runs ocaml-match-clauses on its arg. let rec recognises :function as a
recursive rhs and ties the knot via cell, so

  let rec map f = function | [] -> [] | h::t -> f h :: map f t

works. ocaml-match-eval refactored to share clause-walk with function.

lib/ocaml/eval.sx

@@ -156,23 +156,26 @@
               (else ocaml-match-fail))))
         (else (error (str "ocaml-match-pat: unknown pattern tag " tag)))))))
 
+(define ocaml-match-clauses
+  (fn (val clauses env)
+    (begin
+      (define try-clauses
+        (fn (cs)
+          (cond
+            ((empty? cs)
+              (error (str "ocaml-eval: match failure on " val)))
+            (else
+              (let ((clause (first cs)))
+                (let ((pat (nth clause 1)) (body (nth clause 2)))
+                  (let ((env2 (ocaml-match-pat pat val env)))
+                    (cond
+                      ((= env2 ocaml-match-fail) (try-clauses (rest cs)))
+                      (else (ocaml-eval body env2))))))))))
+      (try-clauses clauses))))
+
 (define ocaml-match-eval
   (fn (scrut-ast clauses env)
-    (let ((val (ocaml-eval scrut-ast env)))
+    (ocaml-match-clauses (ocaml-eval scrut-ast env) clauses env)))
-      (begin
-        (define try-clauses
-          (fn (cs)
-            (cond
-              ((empty? cs)
-                (error (str "ocaml-eval: match failure on " val)))
-              (else
-                (let ((clause (first cs)))
-                  (let ((pat (nth clause 1)) (body (nth clause 2)))
-                    (let ((env2 (ocaml-match-pat pat val env)))
-                      (cond
-                        ((= env2 ocaml-match-fail) (try-clauses (rest cs)))
-                        (else (ocaml-eval body env2))))))))))
-        (try-clauses clauses)))))
 
 ;; Auto-curry: (:fun ("x" "y" "z") body) → (fn (x) (fn (y) (fn (z) body))).
 ;; A zero-param lambda evaluates the body immediately on first call —
@@ -300,6 +303,11 @@
                   (fn-val arg-val))))))
         ((= tag "match")
           (ocaml-match-eval (nth ast 1) (nth ast 2) env))
+        ((= tag "function")
+          ;; `function | pat -> body | …` — produces a unary closure that
+          ;; matches its argument against the clauses.
+          (let ((clauses (nth ast 1)) (captured env))
+            (fn (arg) (ocaml-match-clauses arg clauses captured))))
         ((= tag "for")
           ;; (:for NAME LO HI DIR BODY) — DIR is "ascend" or "descend".
           (let ((name (nth ast 1))
@@ -354,30 +362,30 @@
                         (ocaml-make-curried params rhs env))))
               (ocaml-eval body (ocaml-env-extend env name rhs-val)))))
         ((= tag "let-rec")
-          ;; For function bindings: tie the knot via a mutable cell. The
+          ;; Tie the knot via a mutable cell when rhs is function-typed.
-          ;; placeholder closure that's bound first dereferences the cell
+          ;; The placeholder closure dereferences the cell on each call.
-          ;; on each call, so the function can call itself once the cell
-          ;; is set to the real closure.
           (let ((name (nth ast 1)) (params (nth ast 2))
                 (rhs (nth ast 3)) (body (nth ast 4)))
-            (cond
+            (let ((rhs-fn?
-              ((= (len params) 0)
+                    (or (> (len params) 0)
-                ;; Non-functional let-rec — OCaml only allows this when the
+                        (= (ocaml-tag-of rhs) "fun")
-                ;; rhs is "syntactically a function or constructor". For the
+                        (= (ocaml-tag-of rhs) "function"))))
-                ;; common case of a value, evaluate non-recursively.
+              (cond
-                (let ((rhs-val (ocaml-eval rhs env)))
+                (rhs-fn?
-                  (ocaml-eval body (ocaml-env-extend env name rhs-val))))
+                  (let ((cell (list nil)))
-              (else
+                    (let ((env2 (ocaml-env-extend env name
-                ;; Use a one-element list as a mutable cell to tie the
+                                  (fn (arg) ((nth cell 0) arg)))))
-                ;; recursive knot. The placeholder closure dereferences
+                      (let ((rhs-val
-                ;; the cell on each call.
+                              (if (= (len params) 0)
-                (let ((cell (list nil)))
+                                  (ocaml-eval rhs env2)
-                  (let ((env2 (ocaml-env-extend env name
+                                  (ocaml-make-curried params rhs env2))))
-                                (fn (arg) ((nth cell 0) arg)))))
+                        (begin
-                    (let ((rhs-val (ocaml-make-curried params rhs env2)))
+                          (set-nth! cell 0 rhs-val)
-                      (begin
+                          (ocaml-eval body env2))))))
-                        (set-nth! cell 0 rhs-val)
+                (else
-                        (ocaml-eval body env2)))))))))
+                  (let ((rhs-val (ocaml-eval rhs env)))
+                    (ocaml-eval body
+                      (ocaml-env-extend env name rhs-val))))))))
         (else (error
           (str "ocaml-eval: unknown AST tag " tag)))))))
 
@@ -406,21 +414,28 @@
                         (set! last v)))))
                 ((= tag "def-rec")
                   (let ((name (nth decl 1)) (params (nth decl 2)) (rhs (nth decl 3)))
-                    (cond
+                    (let ((rhs-fn?
-                      ((= (len params) 0)
+                            (or (> (len params) 0)
-                        (let ((v (ocaml-eval rhs env)))
+                                (= (ocaml-tag-of rhs) "fun")
-                          (begin
+                                (= (ocaml-tag-of rhs) "function"))))
-                            (set! env (ocaml-env-extend env name v))
+                      (cond
-                            (set! last v))))
+                        (rhs-fn?
-                      (else
+                          (let ((cell (list nil)))
-                        (let ((cell (list nil)))
+                            (let ((env2 (ocaml-env-extend env name
-                          (let ((env2 (ocaml-env-extend env name
+                                          (fn (arg) ((nth cell 0) arg)))))
-                                        (fn (arg) ((nth cell 0) arg)))))
+                              (let ((v
-                            (let ((v (ocaml-make-curried params rhs env2)))
+                                      (if (= (len params) 0)
-                              (begin
+                                          (ocaml-eval rhs env2)
-                                (set-nth! cell 0 v)
+                                          (ocaml-make-curried params rhs env2))))
-                                (set! env env2)
+                                (begin
-                                (set! last v)))))))))
+                                  (set-nth! cell 0 v)
+                                  (set! env env2)
+                                  (set! last v))))))
+                        (else
+                          (let ((v (ocaml-eval rhs env)))
+                            (begin
+                              (set! env (ocaml-env-extend env name v))
+                              (set! last v))))))))
                 ((= tag "expr")
                   (set! last (ocaml-eval (nth decl 1) env)))
                 (else (error (str "ocaml-run-program: bad decl " tag)))))))

lib/ocaml/parser.sx

@@ -573,6 +573,28 @@
                           (begin (advance-tok!) (one) (loop)))))
                     (loop)
                     (cons :match (cons scrut (list cases)))))))))
+        (define parse-function
+          (fn ()
+            ;; `function | pat -> body | …` ≡ fun x -> match x with | pat -> body
+            (let ()
+              (begin
+                (when (at-op? "|") (advance-tok!))
+                (let ((cases (list)))
+                  (begin
+                    (define one
+                      (fn ()
+                        (let ((p (parse-pattern)))
+                          (begin
+                            (consume! "op" "->")
+                            (let ((body (parse-expr)))
+                              (append! cases (list :case p body)))))))
+                    (one)
+                    (define loop
+                      (fn ()
+                        (when (at-op? "|")
+                          (begin (advance-tok!) (one) (loop)))))
+                    (loop)
+                    (list :function cases)))))))
         (define parse-for
           (fn ()
             (let ((name (ocaml-tok-value (consume! "ident" nil))))
@@ -609,6 +631,7 @@
               ((at-kw? "let") (begin (advance-tok!) (parse-let)))
               ((at-kw? "if") (begin (advance-tok!) (parse-if)))
               ((at-kw? "match") (begin (advance-tok!) (parse-match)))
+              ((at-kw? "function") (begin (advance-tok!) (parse-function)))
               ((at-kw? "for") (begin (advance-tok!) (parse-for)))
               ((at-kw? "while") (begin (advance-tok!) (parse-while)))
               (else (parse-tuple)))))

lib/ocaml/test.sh

@@ -507,6 +507,16 @@ cat > "$TMPFILE" << 'EPOCHS'
 (epoch 624)
 (eval "(ocaml-run \"let p = ref 1 in for i = 1 to 5 do p := !p * i done; !p\")")
 
+;; ── function (sugar for fun + match) ───────────────────────────
+(epoch 640)
+(eval "(ocaml-run \"(function | None -> 0 | Some x -> x) (Some 7)\")")
+(epoch 641)
+(eval "(ocaml-run \"let f = function | None -> 0 | Some x -> x in f None\")")
+(epoch 642)
+(eval "(ocaml-run \"let rec len = function | [] -> 0 | _ :: t -> 1 + len t in len [1; 2; 3]\")")
+(epoch 643)
+(eval "(ocaml-run-program \"let rec map f = function | [] -> [] | h :: t -> f h :: map f t;; map (fun x -> x * x) [1; 2; 3; 4]\")")
+
 EPOCHS
 
 OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
@@ -808,6 +818,12 @@ check 622 "while loop"                   '15'
 check 623 "for 1..100 sum"               '5050'
 check 624 "for 1..5 product = 120"       '120'
 
+# ── function ────────────────────────────────────────────────────
+check 640 "function None|Some Some 7"    '7'
+check 641 "function None=0"              '0'
+check 642 "rec function len"             '3'
+check 643 "rec function map x*x"         '(1 4 9 16)'
+
 TOTAL=$((PASS + FAIL))
 if [ $FAIL -eq 0 ]; then
   echo "ok $PASS/$TOTAL OCaml-on-SX tests passed"

plans/ocaml-on-sx.md

@@ -148,8 +148,7 @@ SX CEK evaluator (both JS and OCaml hosts)
 - [~] `let`/`let rec`/`let ... in` (single-binding done; mutually recursive
       `and` deferred).
 - [x] Lambda + application (curried by default — auto-curry multi-param defs).
-- [ ] `fun`/`function` (single-arg lambda with immediate match on arg). _(`fun`
+- [x] `fun`/`function` (single-arg lambda with immediate match on arg).
-      done; `function` blocked on parser support.)_
 - [x] `if`/`then`/`else`, `begin`/`end`, sequence `;`.
 - [x] Arithmetic, comparison, boolean ops, string `^`, `mod`.
 - [x] Unit `()` value; `ignore`.
@@ -321,6 +320,13 @@ the "mother tongue" closure: OCaml → SX → OCaml. This means:
 
 _Newest first._
 
+- 2026-05-08 Phase 2 — `function | pat -> body | …` parser + eval.
+  Sugar for `fun x -> match x with | …`. AST: `(:function CLAUSES)`
+  evaluated to a unary closure that runs `ocaml-match-clauses` on the
+  argument. `let rec` knot also triggers when rhs is `:function`, so
+  `let rec map f = function | [] -> [] | h::t -> f h :: map f t` works.
+  ocaml-match-eval refactored to share `ocaml-match-clauses` with the
+  function form. 198/198 (+4).
 - 2026-05-08 Phase 2 — `for`/`while` loops. `(:for NAME LO HI DIR BODY)`
   with `:ascend`/`:descend` direction (`to`/`downto`); `(:while COND BODY)`.
   Both eval to unit and re-bind the loop var per iteration. 194/194 (+5).