coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ocaml: phase 3 pattern matching + constructors (+18 tests, 183 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Details

Browse Source 
Constructor app: (:app (:con NAME) arg) -> (NAME …args). Tuple args
flatten so Pair(a,b) -> ("Pair" a b), matching the parser's pattern
flatten. Standalone (:con NAME) -> (NAME) nullary.

Pattern matcher: :pwild, :pvar, :plit, :pcon (head + arity), :pcons
(decompose), :plist (length match), :ptuple (after tuple tag). Match
walks clauses until first success; runtime error on exhaustion.
Recursive list functions (len, sum, fact) work end-to-end.
This commit is contained in:
giles
2026-05-08 08:02:56 +00:00
parent 4dca583ee3
commit 9b833a9442
3 changed files with 237 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

135
lib/ocaml/eval.sx
View File

@@ -62,6 +62,115 @@
(define ocaml-eval (fn (ast env) nil))
;; Pattern matcher — returns the extended env on success, or :fail on
;; mismatch (using the keyword :fail so nil values don't ambiguate).
;;
;; Pattern shapes (from parser):
;; (:pwild) match anything, no binding
;; (:pvar NAME) match anything, bind NAME → val
;; (:plit LITAST) literal compare
;; (:pcon NAME PATS...) ctor: val must be (NAME ARGS...) and arity match
;; (:pcons HEAD TAIL) non-empty list: match head + tail
;; (:plist PATS...) list of exact length, item-wise match
;; (:ptuple PATS...) val must be ("tuple" ITEMS...) of same arity
(define ocaml-match-fail :fail)
(define ocaml-eval-lit
(fn (lit-ast)
(let ((tag (nth lit-ast 0)))
(cond
((= tag "int") (nth lit-ast 1))
((= tag "float") (nth lit-ast 1))
((= tag "string") (nth lit-ast 1))
((= tag "char") (nth lit-ast 1))
((= tag "bool") (nth lit-ast 1))
((= tag "unit") nil)
(else (error (str "ocaml-eval-lit: bad literal " tag)))))))
(define ocaml-match-pat (fn (pat val env) ocaml-match-fail))
(define ocaml-match-list
(fn (pats vals env)
(cond
((and (= (len pats) 0) (= (len vals) 0)) env)
((or (= (len pats) 0) (= (len vals) 0)) ocaml-match-fail)
(else
(let ((env2 (ocaml-match-pat (first pats) (first vals) env)))
(cond
((= env2 ocaml-match-fail) ocaml-match-fail)
(else (ocaml-match-list (rest pats) (rest vals) env2))))))))
(set! ocaml-match-pat
(fn (pat val env)
(let ((tag (nth pat 0)))
(cond
((= tag "pwild") env)
((= tag "pvar")
(ocaml-env-extend env (nth pat 1) val))
((= tag "plit")
(if (= (ocaml-eval-lit (nth pat 1)) val) env ocaml-match-fail))
((= tag "pcon")
;; (:pcon NAME PATS...) — val must be (NAME VALS...) with same arity.
(let ((name (nth pat 1)) (arg-pats (rest (rest pat))))
(cond
((and (list? val) (not (empty? val)) (= (first val) name)
(= (len (rest val)) (len arg-pats)))
(ocaml-match-list arg-pats (rest val) env))
(else ocaml-match-fail))))
((= tag "pcons")
;; (:pcons HEAD TAIL) — val must be a non-empty list.
(cond
((and (list? val) (not (empty? val))
(not (and (not (empty? val)) (string? (first val)))))
;; OCaml lists are SX lists (not tagged like ctors). Match
;; head pattern against (first val), tail against (rest val).
(let ((env2 (ocaml-match-pat (nth pat 1) (first val) env)))
(cond
((= env2 ocaml-match-fail) ocaml-match-fail)
(else (ocaml-match-pat (nth pat 2) (rest val) env2)))))
;; Allow lists whose first element happens to be a string —
;; ambiguous with ctors; treat them as plain lists.
((and (list? val) (not (empty? val)))
(let ((env2 (ocaml-match-pat (nth pat 1) (first val) env)))
(cond
((= env2 ocaml-match-fail) ocaml-match-fail)
(else (ocaml-match-pat (nth pat 2) (rest val) env2)))))
(else ocaml-match-fail)))
((= tag "plist")
;; (:plist PATS...) — val must be a list of exact length.
(let ((item-pats (rest pat)))
(cond
((and (list? val) (= (len val) (len item-pats)))
(ocaml-match-list item-pats val env))
(else ocaml-match-fail))))
((= tag "ptuple")
(let ((item-pats (rest pat)))
(cond
((and (list? val) (not (empty? val))
(= (first val) "tuple")
(= (len (rest val)) (len item-pats)))
(ocaml-match-list item-pats (rest val) env))
(else ocaml-match-fail))))
(else (error (str "ocaml-match-pat: unknown pattern tag " tag)))))))
(define ocaml-match-eval
(fn (scrut-ast clauses env)
(let ((val (ocaml-eval scrut-ast 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 —
;; OCaml does not have nullary functions; `()`-taking functions still
@@ -153,10 +262,30 @@
(map (fn (e) (ocaml-eval e env)) (rest ast)))
((= tag "fun")
(ocaml-make-curried (nth ast 1) (nth ast 2) env))
((= tag "con")
;; Standalone ctor — produces a nullary tagged value.
(list (nth ast 1)))
((= tag "app")
(let ((fn-val (ocaml-eval (nth ast 1) env))
(arg-val (ocaml-eval (nth ast 2) env)))
(fn-val arg-val)))
(let ((fn-ast (nth ast 1)))
(cond
;; Constructor application: build a tagged value, flattening
;; a tuple arg into multiple ctor args (so `Pair (a, b)`
;; becomes ("Pair" va vb) — matches the parser's pattern
;; flattening).
((= (ocaml-tag-of fn-ast) "con")
(let ((name (nth fn-ast 1))
(arg-val (ocaml-eval (nth ast 2) env)))
(cond
((and (list? arg-val) (not (empty? arg-val))
(= (first arg-val) "tuple"))
(cons name (rest arg-val)))
(else (list name arg-val)))))
(else
(let ((fn-val (ocaml-eval fn-ast env))
(arg-val (ocaml-eval (nth ast 2) env)))
(fn-val arg-val))))))
((= tag "match")
(ocaml-match-eval (nth ast 1) (nth ast 2) env))
((= tag "let")
(let ((name (nth ast 1)) (params (nth ast 2))
(rhs (nth ast 3)) (body (nth ast 4)))