ocaml: phase 1 top-level decls (+9 tests, 104 total)

ocaml-parse-program: program = decls + bare exprs, ;;-separated. Each decl is (:def …), (:def-rec …), or (:expr …). Body parsing re-feeds the source slice through ocaml-parse — shared-state refactor deferred.
2026-05-08 07:25:11 +00:00
parent 9a090c6e42
commit 9648dac88d
3 changed files with 166 additions and 4 deletions
--- a/lib/ocaml/parser.sx
+++ b/lib/ocaml/parser.sx
@@ -416,3 +416,127 @@
                  " "
                  (ocaml-tok-value (peek-tok)))))
            result))))))
+
+(define
+  ocaml-parse-program
+  (fn
+    (src)
+    (let
+      ((tokens (ocaml-tokenize src)) (idx 0) (tok-len 0) (decls (list)))
+      (begin
+        (set! tok-len (len tokens))
+        (define peek-tok (fn () (nth tokens idx)))
+        (define advance-tok! (fn () (set! idx (+ idx 1))))
+        (define
+          check-tok?
+          (fn
+            (type value)
+            (let
+              ((t (peek-tok)))
+              (and
+                (= (ocaml-tok-type t) type)
+                (or (= value nil) (= (ocaml-tok-value t) value))))))
+        (define
+          consume!
+          (fn
+            (type value)
+            (if
+              (check-tok? type value)
+              (let ((t (peek-tok))) (begin (advance-tok!) t))
+              (error
+                (str
+                  "ocaml-parse-program: expected "
+                  type
+                  " "
+                  value
+                  " got "
+                  (ocaml-tok-type (peek-tok))
+                  " "
+                  (ocaml-tok-value (peek-tok)))))))
+        (define at-kw? (fn (kw) (check-tok? "keyword" kw)))
+        (define at-op? (fn (op) (check-tok? "op" op)))
+        (define
+          skip-double-semi!
+          (fn
+            ()
+            (when (at-op? ";;") (begin (advance-tok!) (skip-double-semi!)))))
+        (define
+          cur-pos
+          (fn
+            ()
+            (let ((t (peek-tok))) (if (= t nil) (len src) (get t :pos)))))
+        (define
+          skip-to-boundary!
+          (fn
+            ()
+            (cond
+              ((>= idx tok-len) nil)
+              ((= (ocaml-tok-type (peek-tok)) "eof") nil)
+              ((at-op? ";;") nil)
+              ((at-kw? "let") nil)
+              (else (begin (advance-tok!) (skip-to-boundary!))))))
+        (define
+          parse-decl-let
+          (fn
+            ()
+            (advance-tok!)
+            (let
+              ((reccy false))
+              (begin
+                (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
+                        ()
+                        (when
+                          (check-tok? "ident" nil)
+                          (begin
+                            (append! params (ocaml-tok-value (peek-tok)))
+                            (advance-tok!)
+                            (collect-params)))))
+                    (collect-params)
+                    (consume! "op" "=")
+                    (let
+                      ((expr-start (cur-pos)))
+                      (begin
+                        (skip-to-boundary!)
+                        (let
+                          ((expr-src (slice src expr-start (cur-pos))))
+                          (let
+                            ((expr (ocaml-parse expr-src)))
+                            (if
+                              reccy
+                              (list :def-rec name params expr)
+                              (list :def name params expr))))))))))))
+        (define
+          parse-decl-expr
+          (fn
+            ()
+            (let
+              ((expr-start (cur-pos)))
+              (begin
+                (skip-to-boundary!)
+                (let
+                  ((expr-src (slice src expr-start (cur-pos))))
+                  (let ((expr (ocaml-parse expr-src))) (list :expr expr)))))))
+        (define
+          loop
+          (fn
+            ()
+            (begin
+              (skip-double-semi!)
+              (when
+                (< idx tok-len)
+                (cond
+                  ((= (ocaml-tok-type (peek-tok)) "eof") nil)
+                  ((at-kw? "let")
+                    (begin (append! decls (parse-decl-let)) (loop)))
+                  (else (begin (append! decls (parse-decl-expr)) (loop))))))))
+        (loop)
+        (cons :program decls)))))