diff --git a/lib/ocaml/baseline/calc.ml b/lib/ocaml/baseline/calc.ml new file mode 100644 index 00000000..375caa1f --- /dev/null +++ b/lib/ocaml/baseline/calc.ml @@ -0,0 +1,76 @@ +(* Baseline: recursive-descent calculator for "+", "*", parens, ints. *) +type expr = + | Lit of int + | Add of expr * expr + | Mul of expr * expr +;; + +let parse_input src = + let pos = ref 0 in + let peek () = if !pos < String.length src then String.get src !pos else "" in + let advance () = pos := !pos + 1 in + let skip_ws () = + while !pos < String.length src && peek () = " " do advance () done + in + + let rec parse_atom () = + skip_ws () ; + if peek () = "(" then begin + advance () ; + let e = parse_expr () in + skip_ws () ; + advance () ; (* consume ')' *) + e + end + else + let start = !pos in + let rec digits () = + if !pos < String.length src then + let c = peek () in + if c >= "0" && c <= "9" then begin advance () ; digits () end + else () + in + digits () ; + let n = Int.of_string (String.sub src start (!pos - start)) in + Lit n + + and parse_term () = + skip_ws () ; + let lhs = ref (parse_atom ()) in + let rec loop () = + skip_ws () ; + if peek () = "*" then begin + advance () ; + lhs := Mul (!lhs, parse_atom ()) ; + loop () + end + in + loop () ; + !lhs + + and parse_expr () = + skip_ws () ; + let lhs = ref (parse_term ()) in + let rec loop () = + skip_ws () ; + if peek () = "+" then begin + advance () ; + lhs := Add (!lhs, parse_term ()) ; + loop () + end + in + loop () ; + !lhs + in + parse_expr () +;; + +let rec eval e = + match e with + | Lit n -> n + | Add (a, b) -> eval a + eval b + | Mul (a, b) -> eval a * eval b +;; + +(* (1 + 2) * 3 + 4 = 9 + 4 = 13 *) +eval (parse_input "(1 + 2) * 3 + 4") diff --git a/lib/ocaml/baseline/expected.json b/lib/ocaml/baseline/expected.json index 3452637e..98764167 100644 --- a/lib/ocaml/baseline/expected.json +++ b/lib/ocaml/baseline/expected.json @@ -1,4 +1,5 @@ { + "calc.ml": 13, "closures.ml": 315, "exception_handle.ml": 4, "expr_eval.ml": 16, diff --git a/lib/ocaml/eval.sx b/lib/ocaml/eval.sx index 03a93208..d91e522b 100644 --- a/lib/ocaml/eval.sx +++ b/lib/ocaml/eval.sx @@ -619,6 +619,57 @@ (ocaml-eval rhs env) (ocaml-make-curried params rhs env)))) (ocaml-eval body (ocaml-env-extend env name rhs-val))))) + ((= tag "let-mut") + ;; (:let-mut BINDINGS BODY) — non-rec multi-binding let-in. + ;; Each rhs evaluated in the parent env, then names bound + ;; sequentially before evaluating BODY. + (let ((bindings (nth ast 1)) (body (nth ast 2)) (env-cur env)) + (begin + (define one + (fn (b) + (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2))) + (let ((v (if (= (len ps) 0) + (ocaml-eval rh env-cur) + (ocaml-make-curried ps rh env-cur)))) + (set! env-cur (ocaml-env-extend env-cur nm v)))))) + (define loop + (fn (xs) + (when (not (= xs (list))) + (begin (one (first xs)) (loop (rest xs)))))) + (loop bindings) + (ocaml-eval body env-cur)))) + ((= tag "let-rec-mut") + ;; (:let-rec-mut BINDINGS BODY) — mutually-recursive let-in. + (let ((bindings (nth ast 1)) (body (nth ast 2)) + (env2 env) (cells (list))) + (begin + (define alloc + (fn (xs) + (when (not (= xs (list))) + (let ((b (first xs))) + (let ((c (list nil)) (nm (nth b 0))) + (begin + (append! cells c) + (set! env2 (ocaml-env-extend env2 nm + (fn (a) ((nth c 0) a)))) + (alloc (rest xs)))))))) + (alloc bindings) + (let ((idx 0)) + (begin + (define fill + (fn (xs) + (when (not (= xs (list))) + (let ((b (first xs))) + (let ((nm (nth b 0)) (ps (nth b 1)) (rh (nth b 2))) + (let ((v (if (= (len ps) 0) + (ocaml-eval rh env2) + (ocaml-make-curried ps rh env2)))) + (begin + (set-nth! (nth cells idx) 0 v) + (set! idx (+ idx 1)) + (fill (rest xs))))))))) + (fill bindings) + (ocaml-eval body env2)))))) ((= tag "let-rec") ;; Tie the knot via a mutable cell when rhs is function-typed. ;; The placeholder closure dereferences the cell on each call. diff --git a/lib/ocaml/parser.sx b/lib/ocaml/parser.sx index 0ff699d7..67bedc65 100644 --- a/lib/ocaml/parser.sx +++ b/lib/ocaml/parser.sx @@ -666,36 +666,43 @@ (let ((body (parse-expr))) (list :fun params body)))))) (define parse-let - (fn - () - (let - ((reccy false)) + (fn () + (let ((reccy false) (bindings (list))) (begin - (when - (at-kw? "rec") + (when (at-kw? "rec") (begin (advance-tok!) (set! reccy true))) - (let - ((name (ocaml-tok-value (consume! "ident" nil))) - (params (list))) - (begin - (define - collect-params - (fn () - (let ((nm (try-consume-param!))) - (when (not (= nm nil)) - (begin (append! params nm) (collect-params)))))) - (collect-params) - (consume! "op" "=") - (let - ((rhs (parse-expr))) + (define parse-one! + (fn () + (let ((nm (ocaml-tok-value (consume! "ident" nil))) + (ps (list))) (begin - (consume! "keyword" "in") - (let - ((body (parse-expr))) - (if - reccy - (list :let-rec name params rhs body) - (list :let name params rhs body))))))))))) + (define collect-params + (fn () + (let ((p (try-consume-param!))) + (when (not (= p nil)) + (begin (append! ps p) (collect-params)))))) + (collect-params) + (consume! "op" "=") + (let ((rhs (parse-expr))) + (append! bindings (list nm ps rhs))))))) + (parse-one!) + (define more + (fn () + (when (at-kw? "and") + (begin (advance-tok!) (parse-one!) (more))))) + (more) + (consume! "keyword" "in") + (let ((body (parse-expr))) + (cond + ((= (len bindings) 1) + (let ((b (first bindings))) + (if reccy + (list :let-rec (nth b 0) (nth b 1) (nth b 2) body) + (list :let (nth b 0) (nth b 1) (nth b 2) body)))) + (else + (if reccy + (list :let-rec-mut bindings body) + (list :let-mut bindings body))))))))) (define parse-if (fn @@ -975,7 +982,6 @@ ((and (= tt "keyword") (= tv "exception")) (set! done true)) ((and (= tt "keyword") (= tv "open")) (set! done true)) ((and (= tt "keyword") (= tv "include")) (set! done true)) - ((and (= tt "keyword") (= tv "and")) (set! done true)) ((and (= tt "keyword") (= tv "let")) (begin (set! d (+ d 1)) (set! p (+ p 1)) (scan))) ((and (= tt "keyword") (= tv "in")) diff --git a/plans/ocaml-on-sx.md b/plans/ocaml-on-sx.md index c494ee9c..86260fea 100644 --- a/plans/ocaml-on-sx.md +++ b/plans/ocaml-on-sx.md @@ -394,6 +394,14 @@ _Newest first._ recognise `!` as the prefix-deref of an application argument, so `String.concat "" (List.rev !b)` parses as `(... (deref b))`. Buffer uses a ref holding a string list; contents reverses and concats. +- 2026-05-08 Phase 5.1+1+2 — calc.ml baseline (11/11 pass) — a + recursive-descent calculator parsing `(1 + 2) * 3 + 4` to 13. Two + parser bugs fixed along the way: parse-let now handles inline + `let rec ... and ... in body` via new `:let-rec-mut` / `:let-mut` + AST shapes (eval supports both); `has-matching-in?` no longer stops + at `and` (which is internal to a let-rec, not a decl boundary). The + baseline exercises mutually-recursive functions, while-loops, and + ref-cell-driven imperative parsing. - 2026-05-08 Phase 5.1 — word_count.ml baseline (10/10 pass). Uses Map.Make(StrOrd) + List.fold_left to count word frequencies; tests the full functor pipeline with a real OCaml idiom.