ocaml: phase 1+3 record patterns { f = pat } (+4 tests, 386 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
Parser: { f1 = pat; f2 = pat; ... } in pattern position emits
(:precord (FIELDNAME PAT)...). Mixed with the existing { in
expression position via the at-pattern-atom? whitelist.
Eval: :precord matches against a dict; required fields must be present
and each pat must match the field's value. Can mix literal+var:
'match { x = 1; y = y } with | { x = 1; y = y } -> y' matches only
when x is 1.
This commit is contained in:
@@ -224,6 +224,33 @@
|
||||
(ocaml-env-extend env (nth pat 1) val))
|
||||
((= tag "plit")
|
||||
(if (= (ocaml-eval-lit (nth pat 1)) val) env ocaml-match-fail))
|
||||
((= tag "precord")
|
||||
;; (:precord (FIELDNAME PAT) ...) — val must be a dict with each
|
||||
;; named field; each pat must match the field's value.
|
||||
(cond
|
||||
((not (dict? val)) ocaml-match-fail)
|
||||
(else
|
||||
(let ((fields (rest pat)) (env-cur env) (failed false))
|
||||
(begin
|
||||
(define one-field
|
||||
(fn (kv)
|
||||
(let ((k (first kv)) (p (nth kv 1)))
|
||||
(cond
|
||||
((not (has-key? val k))
|
||||
(set! failed true))
|
||||
(else
|
||||
(let ((env2 (ocaml-match-pat p (get val k) env-cur)))
|
||||
(cond
|
||||
((= env2 ocaml-match-fail) (set! failed true))
|
||||
(else (set! env-cur env2)))))))))
|
||||
(define loop
|
||||
(fn (xs)
|
||||
(when (and (not failed) (not (= xs (list))))
|
||||
(begin (one-field (first xs)) (loop (rest xs))))))
|
||||
(loop fields)
|
||||
(cond
|
||||
(failed ocaml-match-fail)
|
||||
(else env-cur)))))))
|
||||
((= tag "pcon")
|
||||
;; (:pcon NAME PATS...) — val must be (NAME VALS...) with same arity.
|
||||
(let ((name (nth pat 1)) (arg-pats (rest (rest pat))))
|
||||
|
||||
Reference in New Issue
Block a user