diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index 70e3ff25..cfbff29f 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -787,7 +787,7 @@ (list :try expr cases))))))) (define parse-function (fn () - ;; `function | pat -> body | …` ≡ fun x -> match x with | pat -> body + ;; `function | pat [when GUARD] -> body | …` (let () (begin (when (at-op? "|") (advance-tok!)) @@ -795,11 +795,18 @@ (begin (define one (fn () - (let ((p (parse-pattern))) + (let ((p (parse-pattern)) (guard nil)) (begin + (when (at-kw? "when") + (begin (advance-tok!) + (set! guard (parse-expr-no-seq)))) (consume! "op" "->") (let ((body (parse-expr))) - (append! cases (list :case p body))))))) + (cond + ((= guard nil) + (append! cases (list :case p body))) + (else + (append! cases (list :case-when p guard body))))))))) (one) (define loop (fn () diff --git a/lib/ocaml/test.sh b/lib/ocaml/test.sh index b86b1c14..1501d238 100755 --- a/lib/ocaml/test.sh +++ b/lib/ocaml/test.sh @@ -1140,6 +1140,14 @@ cat > "$TMPFILE" << 'EPOCHS' (epoch 4306) (eval "(ocaml-run \"Char.is_lower \\\"a\\\"\")") +;; ── function with `when` guard ──────────────────────────────── +(epoch 4400) +(eval "(ocaml-run \"(function | n when n > 0 -> 1 | _ -> 0) 5\")") +(epoch 4401) +(eval "(ocaml-run \"(function | n when n > 0 -> 1 | _ -> 0) (-3)\")") +(epoch 4402) +(eval "(ocaml-run \"(function | n when n > 0 -> 1 | n when n < 0 -> -1 | _ -> 0) 0\")") + EPOCHS OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>/dev/null) @@ -1805,6 +1813,11 @@ check 4304 "Char.is_whitespace ' '" 'true' check 4305 "Char.is_upper A" 'true' check 4306 "Char.is_lower a" 'true' +# ── function with `when` guard ───────────────────────────────── +check 4400 "function when 5" '1' +check 4401 "function when -3" '0' +check 4402 "function sign 0" '0' + 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 b1fa4cb7..7d0d292e 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -407,6 +407,9 @@ _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-08 Phase 1+3 — `function | pat when GUARD -> body | …` + guard support (+3 tests, 464 total). `parse-function` mirrors the + match-clause when-handling. - 2026-05-08 Phase 5.1 — anagrams.ml baseline (18/18 pass). Counts anagram-equivalence groups via Hashtbl + List.sort + String.get + for-loop. `["eat";"tea";"tan";"ate";"nat";"bat"]` → 3 groups.