ocaml: phase 5.1 baseline OCaml programs (5/5 pass) + lookahead boundary
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
lib/ocaml/baseline/{factorial,list_ops,option_match,module_use,sum_squares}.ml
exercised through ocaml-run-program (file-read F). lib/ocaml/baseline/
run.sh runs them and compares against expected.json — all 5 pass.
To make module_use.ml (with nested let-in) parse, parser's
skip-let-rhs-boundary! now uses has-matching-in? lookahead: a let at
depth 0 in a let-decl rhs opens a nested block IFF a matching in
exists before any decl-keyword. Without that in, the let is a new
top-level decl (preserves test 274 'let x = 1 let y = 2').
This is the first piece of Phase 5.1 'vendor a slice of OCaml
testsuite' — handcrafted fixtures for now, real testsuite TBD.
This commit is contained in:
@@ -895,12 +895,88 @@
|
||||
(fn
|
||||
()
|
||||
(let ((t (peek-tok))) (if (= t nil) (len src) (get t :pos)))))
|
||||
;; skip-to-boundary! advances `idx` to the next top-level decl
|
||||
;; boundary, tracking `let`/`begin`/`struct` etc. nesting so that
|
||||
;; an inner `let ... in ...` doesn't terminate a top-level decl
|
||||
;; body. Boundary tokens (when at depth 0):
|
||||
;; ;; let module open include and type exception
|
||||
;; Boundary at any depth: eof.
|
||||
;; Two flavors of boundary skipping:
|
||||
;;
|
||||
;; * `skip-to-decl-boundary!` — used by parse-decl-expr. Stops
|
||||
;; at the start of the next top-level decl: ;;, let, module,
|
||||
;; open, include, and, type, exception, or eof.
|
||||
;;
|
||||
;; * `skip-let-rhs-boundary!` — used inside parse-decl-let after
|
||||
;; the `=`. Treats `let` as the opener of a nested let..in
|
||||
;; block (NOT a decl boundary), so `let f x = let y = 0 in y`
|
||||
;; parses correctly. Boundary tokens (depth 0): ;;, module,
|
||||
;; open, include, and, type, exception, or eof.
|
||||
;; Lookahead: starting just past a `let` at the cursor, scan
|
||||
;; for a matching `in` before the next decl boundary. Returns
|
||||
;; true iff such an `in` exists — meaning the let is nested,
|
||||
;; not a new decl.
|
||||
(define has-matching-in?
|
||||
(fn ()
|
||||
(let ((p (+ idx 1)) (d 1) (result false) (done false))
|
||||
(begin
|
||||
(define scan
|
||||
(fn ()
|
||||
(when (not done)
|
||||
(cond
|
||||
((>= p tok-len) (set! done true))
|
||||
(else
|
||||
(let ((t (nth tokens p)))
|
||||
(let ((tt (ocaml-tok-type t)) (tv (ocaml-tok-value t)))
|
||||
(cond
|
||||
((= tt "eof") (set! done true))
|
||||
((and (= tt "op") (= tv ";;")) (set! done true))
|
||||
((and (= tt "keyword") (= tv "module")) (set! done true))
|
||||
((and (= tt "keyword") (= tv "type")) (set! done true))
|
||||
((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"))
|
||||
(cond
|
||||
((= d 1) (begin (set! result true) (set! done true)))
|
||||
(else
|
||||
(begin (set! d (- d 1)) (set! p (+ p 1)) (scan)))))
|
||||
(else (begin (set! p (+ p 1)) (scan)))))))))))
|
||||
(scan)
|
||||
result))))
|
||||
|
||||
;; Same as skip-to-boundary but treats inner `let` as the start
|
||||
;; of a nested let..in (open depth) IF a matching `in` exists
|
||||
;; before any decl boundary; otherwise stops.
|
||||
(define
|
||||
skip-let-rhs-boundary!
|
||||
(fn ()
|
||||
(let ((depth 0))
|
||||
(begin
|
||||
(define step
|
||||
(fn ()
|
||||
(cond
|
||||
((>= idx tok-len) nil)
|
||||
((= (ocaml-tok-type (peek-tok)) "eof") nil)
|
||||
((and (= depth 0) (at-op? ";;")) nil)
|
||||
((and (= depth 0) (at-kw? "module")) nil)
|
||||
((and (= depth 0) (at-kw? "open")) nil)
|
||||
((and (= depth 0) (at-kw? "include")) nil)
|
||||
((and (= depth 0) (at-kw? "and")) nil)
|
||||
((and (= depth 0) (at-kw? "type")) nil)
|
||||
((and (= depth 0) (at-kw? "exception")) nil)
|
||||
((and (= depth 0) (at-kw? "let"))
|
||||
(cond
|
||||
((has-matching-in?)
|
||||
(begin (set! depth (+ depth 1)) (advance-tok!) (step)))
|
||||
(else nil)))
|
||||
((or (at-kw? "let") (at-kw? "begin") (at-kw? "struct")
|
||||
(at-kw? "sig") (at-kw? "for") (at-kw? "while"))
|
||||
(begin (set! depth (+ depth 1)) (advance-tok!) (step)))
|
||||
((or (at-kw? "in") (at-kw? "end") (at-kw? "done"))
|
||||
(begin
|
||||
(when (> depth 0) (set! depth (- depth 1)))
|
||||
(advance-tok!) (step)))
|
||||
(else (begin (advance-tok!) (step))))))
|
||||
(step)))))
|
||||
|
||||
(define
|
||||
skip-to-boundary!
|
||||
(fn ()
|
||||
@@ -919,12 +995,6 @@
|
||||
((and (= depth 0) (at-kw? "and")) nil)
|
||||
((and (= depth 0) (at-kw? "type")) nil)
|
||||
((and (= depth 0) (at-kw? "exception")) nil)
|
||||
;; Track nested blocks that have explicit closing
|
||||
;; tokens. let..in / begin..end / struct..end /
|
||||
;; sig..end / for..done / while..done. `if`/`match`/
|
||||
;; `try` don't have hard close tokens so we don't
|
||||
;; track them — their bodies are bounded by the
|
||||
;; surrounding expression structure.
|
||||
((or (at-kw? "let") (at-kw? "begin") (at-kw? "struct")
|
||||
(at-kw? "sig") (at-kw? "for") (at-kw? "while"))
|
||||
(begin (set! depth (+ depth 1)) (advance-tok!) (step)))
|
||||
@@ -968,7 +1038,7 @@
|
||||
(consume! "op" "=")
|
||||
(let ((expr-start (cur-pos)))
|
||||
(begin
|
||||
(skip-to-boundary!)
|
||||
(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))))))))))
|
||||
|
||||
Reference in New Issue
Block a user