Step 7b complete: rich destructuring (dict patterns, &rest, let-match)
Three new pattern matching features in evaluator.sx:
1. Dict patterns in match:
(match {:name "Alice" :age 30}
({:name n :age a} (list n a))) ;; => ("Alice" 30)
2. &rest in list patterns:
(match (list 1 2 3 4 5)
((a b &rest tail) tail)) ;; => (3 4 5)
3. let-match form (sugar for match):
(let-match {:x x :y y} {:x 3 :y 4}
(+ (* x x) (* y y))) ;; => 25
Also: transpiler fix — "extra" key added to CekFrame cf_extra mapping
(was the root cause of thread-last mode not being stored).
2644 tests pass, zero regressions.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -1371,6 +1371,21 @@
|
|||||||
;; Match a syntax-rules pattern against a form.
|
;; Match a syntax-rules pattern against a form.
|
||||||
;; Returns a dict of bindings on success, nil on failure.
|
;; Returns a dict of bindings on success, nil on failure.
|
||||||
;; literals is a list of symbol name strings that must match exactly.
|
;; literals is a list of symbol name strings that must match exactly.
|
||||||
|
(define
|
||||||
|
step-sf-let-match
|
||||||
|
(fn
|
||||||
|
(args env kont)
|
||||||
|
(let
|
||||||
|
((pattern (first args))
|
||||||
|
(expr (nth args 1))
|
||||||
|
(body (rest (rest args))))
|
||||||
|
(step-sf-match
|
||||||
|
(list expr (list pattern (cons (quote begin) body)))
|
||||||
|
env
|
||||||
|
kont))))
|
||||||
|
|
||||||
|
;; Match a list pattern against a form list, handling ellipsis at any position.
|
||||||
|
;; pi = pattern index, fi = form index.
|
||||||
(define
|
(define
|
||||||
step-eval-list
|
step-eval-list
|
||||||
(fn
|
(fn
|
||||||
@@ -1488,6 +1503,7 @@
|
|||||||
("signal-condition" (step-sf-signal args env kont))
|
("signal-condition" (step-sf-signal args env kont))
|
||||||
("invoke-restart" (step-sf-invoke-restart args env kont))
|
("invoke-restart" (step-sf-invoke-restart args env kont))
|
||||||
("match" (step-sf-match args env kont))
|
("match" (step-sf-match args env kont))
|
||||||
|
("let-match" (step-sf-let-match args env kont))
|
||||||
("dynamic-wind"
|
("dynamic-wind"
|
||||||
(make-cek-value (sf-dynamic-wind args env) env kont))
|
(make-cek-value (sf-dynamic-wind args env) env kont))
|
||||||
("map" (step-ho-map args env kont))
|
("map" (step-ho-map args env kont))
|
||||||
@@ -1531,8 +1547,8 @@
|
|||||||
:else (step-eval-call head args env kont)))))
|
:else (step-eval-call head args env kont)))))
|
||||||
(step-eval-call head args env kont))))))
|
(step-eval-call head args env kont))))))
|
||||||
|
|
||||||
;; Match a list pattern against a form list, handling ellipsis at any position.
|
;; Find which pattern variable in a template drives an ellipsis.
|
||||||
;; pi = pattern index, fi = form index.
|
;; Returns the variable name (string) whose binding is a list, or nil.
|
||||||
(define
|
(define
|
||||||
step-sf-parameterize
|
step-sf-parameterize
|
||||||
(fn
|
(fn
|
||||||
@@ -1551,8 +1567,8 @@
|
|||||||
(make-parameterize-frame bindings nil (list) body env)
|
(make-parameterize-frame bindings nil (list) body env)
|
||||||
kont)))))))
|
kont)))))))
|
||||||
|
|
||||||
;; Find which pattern variable in a template drives an ellipsis.
|
;; Find ALL ellipsis-bound pattern variables in a template.
|
||||||
;; Returns the variable name (string) whose binding is a list, or nil.
|
;; Returns a list of variable name strings.
|
||||||
(define
|
(define
|
||||||
syntax-rules-match
|
syntax-rules-match
|
||||||
(fn
|
(fn
|
||||||
@@ -1573,8 +1589,8 @@
|
|||||||
(syntax-rules-match-list pattern 0 form 0 literals)
|
(syntax-rules-match-list pattern 0 form 0 literals)
|
||||||
:else (if (= pattern form) (dict) nil))))
|
:else (if (= pattern form) (dict) nil))))
|
||||||
|
|
||||||
;; Find ALL ellipsis-bound pattern variables in a template.
|
;; Instantiate a template with pattern variable bindings.
|
||||||
;; Returns a list of variable name strings.
|
;; Handles ellipsis repetition and recursive substitution.
|
||||||
(define
|
(define
|
||||||
syntax-rules-match-list
|
syntax-rules-match-list
|
||||||
(fn
|
(fn
|
||||||
@@ -1657,8 +1673,9 @@
|
|||||||
(keys sub-result))
|
(keys sub-result))
|
||||||
rest-result)))))))))
|
rest-result)))))))))
|
||||||
|
|
||||||
;; Instantiate a template with pattern variable bindings.
|
;; Walk a template list, handling ellipsis at any position.
|
||||||
;; Handles ellipsis repetition and recursive substitution.
|
;; When element at i is followed by ... at i+1, expand the element
|
||||||
|
;; for each value of its ellipsis variables (all cycled in parallel).
|
||||||
(define
|
(define
|
||||||
syntax-rules-find-var
|
syntax-rules-find-var
|
||||||
(fn
|
(fn
|
||||||
@@ -1678,9 +1695,10 @@
|
|||||||
template)
|
template)
|
||||||
:else nil)))
|
:else nil)))
|
||||||
|
|
||||||
;; Walk a template list, handling ellipsis at any position.
|
;; Try each syntax-rules clause against a form.
|
||||||
;; When element at i is followed by ... at i+1, expand the element
|
;; Returns the instantiated template for the first matching rule, or errors.
|
||||||
;; for each value of its ellipsis variables (all cycled in parallel).
|
;; form is the raw args (without macro name). We prepend a dummy _ symbol
|
||||||
|
;; because syntax-rules patterns include the keyword as the first element.
|
||||||
(define
|
(define
|
||||||
syntax-rules-find-all-vars
|
syntax-rules-find-all-vars
|
||||||
(fn
|
(fn
|
||||||
@@ -1698,10 +1716,6 @@
|
|||||||
template)
|
template)
|
||||||
:else (list))))
|
:else (list))))
|
||||||
|
|
||||||
;; Try each syntax-rules clause against a form.
|
|
||||||
;; Returns the instantiated template for the first matching rule, or errors.
|
|
||||||
;; form is the raw args (without macro name). We prepend a dummy _ symbol
|
|
||||||
;; because syntax-rules patterns include the keyword as the first element.
|
|
||||||
(define
|
(define
|
||||||
syntax-rules-instantiate
|
syntax-rules-instantiate
|
||||||
(fn
|
(fn
|
||||||
@@ -1715,6 +1729,10 @@
|
|||||||
template
|
template
|
||||||
:else (syntax-rules-instantiate-list template 0 bindings))))
|
:else (syntax-rules-instantiate-list template 0 bindings))))
|
||||||
|
|
||||||
|
;; Special form: (syntax-rules (literal ...) (pattern template) ...)
|
||||||
|
;; Creates a Macro with rules/literals stored in closure env.
|
||||||
|
;; Body is a marker symbol; expand-macro detects it and calls
|
||||||
|
;; the pattern matcher directly.
|
||||||
(define
|
(define
|
||||||
syntax-rules-instantiate-list
|
syntax-rules-instantiate-list
|
||||||
(fn
|
(fn
|
||||||
@@ -1764,10 +1782,6 @@
|
|||||||
(syntax-rules-instantiate elem bindings)
|
(syntax-rules-instantiate elem bindings)
|
||||||
(syntax-rules-instantiate-list template (+ i 1) bindings)))))))
|
(syntax-rules-instantiate-list template (+ i 1) bindings)))))))
|
||||||
|
|
||||||
;; Special form: (syntax-rules (literal ...) (pattern template) ...)
|
|
||||||
;; Creates a Macro with rules/literals stored in closure env.
|
|
||||||
;; Body is a marker symbol; expand-macro detects it and calls
|
|
||||||
;; the pattern matcher directly.
|
|
||||||
(define
|
(define
|
||||||
syntax-rules-expand
|
syntax-rules-expand
|
||||||
(fn
|
(fn
|
||||||
@@ -1776,6 +1790,17 @@
|
|||||||
((full-form (cons (make-symbol "_") form)))
|
((full-form (cons (make-symbol "_") form)))
|
||||||
(syntax-rules-try-rules literals rules full-form))))
|
(syntax-rules-try-rules literals rules full-form))))
|
||||||
|
|
||||||
|
;; R7RS records (SRFI-9)
|
||||||
|
;;
|
||||||
|
;; (define-record-type <point>
|
||||||
|
;; (make-point x y)
|
||||||
|
;; point?
|
||||||
|
;; (x point-x)
|
||||||
|
;; (y point-y set-point-y!))
|
||||||
|
;;
|
||||||
|
;; Creates: constructor, predicate, accessors, optional mutators.
|
||||||
|
;; Opaque — only accessible through generated functions.
|
||||||
|
;; Generative — each call creates a unique type.
|
||||||
(define
|
(define
|
||||||
syntax-rules-try-rules
|
syntax-rules-try-rules
|
||||||
(fn
|
(fn
|
||||||
@@ -1795,17 +1820,7 @@
|
|||||||
(syntax-rules-instantiate template bindings)
|
(syntax-rules-instantiate template bindings)
|
||||||
(syntax-rules-try-rules literals (rest rules) full-form)))))))
|
(syntax-rules-try-rules literals (rest rules) full-form)))))))
|
||||||
|
|
||||||
;; R7RS records (SRFI-9)
|
;; Delimited continuations
|
||||||
;;
|
|
||||||
;; (define-record-type <point>
|
|
||||||
;; (make-point x y)
|
|
||||||
;; point?
|
|
||||||
;; (x point-x)
|
|
||||||
;; (y point-y set-point-y!))
|
|
||||||
;;
|
|
||||||
;; Creates: constructor, predicate, accessors, optional mutators.
|
|
||||||
;; Opaque — only accessible through generated functions.
|
|
||||||
;; Generative — each call creates a unique type.
|
|
||||||
(define
|
(define
|
||||||
sf-syntax-rules
|
sf-syntax-rules
|
||||||
(fn
|
(fn
|
||||||
@@ -1824,7 +1839,6 @@
|
|||||||
closure
|
closure
|
||||||
"syntax-rules")))))
|
"syntax-rules")))))
|
||||||
|
|
||||||
;; Delimited continuations
|
|
||||||
(define
|
(define
|
||||||
step-sf-define-library
|
step-sf-define-library
|
||||||
(fn
|
(fn
|
||||||
@@ -1869,6 +1883,7 @@
|
|||||||
(register-library lib-spec export-dict)
|
(register-library lib-spec export-dict)
|
||||||
(make-cek-value nil env kont))))))
|
(make-cek-value nil env kont))))))
|
||||||
|
|
||||||
|
;; Signal dereferencing with reactive dependency tracking
|
||||||
(define
|
(define
|
||||||
bind-import-set
|
bind-import-set
|
||||||
(fn
|
(fn
|
||||||
@@ -1900,7 +1915,13 @@
|
|||||||
(fn (key) (env-bind! env key (get exports key)))
|
(fn (key) (env-bind! env key (get exports key)))
|
||||||
(keys exports))))))))
|
(keys exports))))))))
|
||||||
|
|
||||||
;; Signal dereferencing with reactive dependency tracking
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
|
;; Part 8: Call Dispatch
|
||||||
|
;;
|
||||||
|
;; cek-call: invoke a function from native code (runs a nested
|
||||||
|
;; trampoline). step-eval-call: CEK-native call dispatch for
|
||||||
|
;; lambda, component, native fn, and continuations.
|
||||||
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
(define
|
(define
|
||||||
step-sf-import
|
step-sf-import
|
||||||
(fn
|
(fn
|
||||||
@@ -1925,13 +1946,7 @@
|
|||||||
env
|
env
|
||||||
(kont-push (make-import-frame import-set rest-sets env) kont))))))))
|
(kont-push (make-import-frame import-set rest-sets env) kont))))))))
|
||||||
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
;; Reactive signal tracking — captures dependency continuation for re-render
|
||||||
;; Part 8: Call Dispatch
|
|
||||||
;;
|
|
||||||
;; cek-call: invoke a function from native code (runs a nested
|
|
||||||
;; trampoline). step-eval-call: CEK-native call dispatch for
|
|
||||||
;; lambda, component, native fn, and continuations.
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
|
||||||
(define
|
(define
|
||||||
step-sf-perform
|
step-sf-perform
|
||||||
(fn
|
(fn
|
||||||
@@ -1944,7 +1959,6 @@
|
|||||||
env
|
env
|
||||||
(kont-push (make-perform-frame env) kont)))))
|
(kont-push (make-perform-frame env) kont)))))
|
||||||
|
|
||||||
;; Reactive signal tracking — captures dependency continuation for re-render
|
|
||||||
(define
|
(define
|
||||||
sf-define-record-type
|
sf-define-record-type
|
||||||
(fn
|
(fn
|
||||||
@@ -1981,6 +1995,13 @@
|
|||||||
field-specs)
|
field-specs)
|
||||||
nil))))))
|
nil))))))
|
||||||
|
|
||||||
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
|
;; Part 9: Higher-Order Form Machinery
|
||||||
|
;;
|
||||||
|
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
|
||||||
|
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
|
||||||
|
;; argument evaluation, then dispatches to the appropriate step-ho-*.
|
||||||
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
(define
|
(define
|
||||||
step-sf-callcc
|
step-sf-callcc
|
||||||
(fn
|
(fn
|
||||||
@@ -1990,13 +2011,6 @@
|
|||||||
env
|
env
|
||||||
(kont-push (make-callcc-frame env) kont))))
|
(kont-push (make-callcc-frame env) kont))))
|
||||||
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
|
||||||
;; Part 9: Higher-Order Form Machinery
|
|
||||||
;;
|
|
||||||
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
|
|
||||||
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
|
|
||||||
;; argument evaluation, then dispatches to the appropriate step-ho-*.
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
|
||||||
(define
|
(define
|
||||||
match-find-clause
|
match-find-clause
|
||||||
(fn
|
(fn
|
||||||
@@ -2026,7 +2040,7 @@
|
|||||||
(= (len pattern) 2)
|
(= (len pattern) 2)
|
||||||
(= (first pattern) (quote ?)))
|
(= (first pattern) (quote ?)))
|
||||||
(let
|
(let
|
||||||
((pred (trampoline (eval-expr (nth pattern 1) env))))
|
((pred (eval-expr (nth pattern 1) env)))
|
||||||
(cek-call pred (list value)))
|
(cek-call pred (list value)))
|
||||||
(and
|
(and
|
||||||
(list? pattern)
|
(list? pattern)
|
||||||
@@ -2035,6 +2049,22 @@
|
|||||||
(= value (nth pattern 1))
|
(= value (nth pattern 1))
|
||||||
(symbol? pattern)
|
(symbol? pattern)
|
||||||
(do (env-bind! env (symbol-name pattern) value) true)
|
(do (env-bind! env (symbol-name pattern) value) true)
|
||||||
|
(and (dict? pattern) (dict? value))
|
||||||
|
(every?
|
||||||
|
(fn (k) (match-pattern (get pattern k) (get value k) env))
|
||||||
|
(keys pattern))
|
||||||
|
(and (list? pattern) (list? value) (contains? pattern (quote &rest)))
|
||||||
|
(let
|
||||||
|
((rest-idx (index-of pattern (quote &rest))))
|
||||||
|
(and
|
||||||
|
(>= (len value) rest-idx)
|
||||||
|
(every?
|
||||||
|
(fn (pair) (match-pattern (first pair) (nth pair 1) env))
|
||||||
|
(zip (slice pattern 0 rest-idx) (slice value 0 rest-idx)))
|
||||||
|
(let
|
||||||
|
((rest-name (nth pattern (+ rest-idx 1))))
|
||||||
|
(env-bind! env (symbol-name rest-name) (slice value rest-idx))
|
||||||
|
true)))
|
||||||
(and (list? pattern) (list? value))
|
(and (list? pattern) (list? value))
|
||||||
(if
|
(if
|
||||||
(not (= (len pattern) (len value)))
|
(not (= (len pattern) (len value)))
|
||||||
@@ -2190,6 +2220,14 @@
|
|||||||
env
|
env
|
||||||
(kont-push (make-begin-frame (rest args) env) kont))))))
|
(kont-push (make-begin-frame (rest args) env) kont))))))
|
||||||
|
|
||||||
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
|
;; Part 10: Continue Phase — Frame Dispatch
|
||||||
|
;;
|
||||||
|
;; When phase="continue", pop the top frame and process the value.
|
||||||
|
;; Each frame type has its own handling: if frames check truthiness,
|
||||||
|
;; let frames bind the value, arg frames accumulate it, etc.
|
||||||
|
;; continue-with-call handles the final function/component dispatch.
|
||||||
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
(define
|
(define
|
||||||
step-sf-let
|
step-sf-let
|
||||||
(fn
|
(fn
|
||||||
@@ -2234,14 +2272,9 @@
|
|||||||
(make-let-frame vname rest-bindings body local)
|
(make-let-frame vname rest-bindings body local)
|
||||||
kont)))))))))
|
kont)))))))))
|
||||||
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
;; Final call dispatch from arg frame — all args evaluated, invoke function.
|
||||||
;; Part 10: Continue Phase — Frame Dispatch
|
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
|
||||||
;;
|
;; native fn (direct call), continuation (resume), callcc continuation (escape).
|
||||||
;; When phase="continue", pop the top frame and process the value.
|
|
||||||
;; Each frame type has its own handling: if frames check truthiness,
|
|
||||||
;; let frames bind the value, arg frames accumulate it, etc.
|
|
||||||
;; continue-with-call handles the final function/component dispatch.
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
|
||||||
(define
|
(define
|
||||||
step-sf-define
|
step-sf-define
|
||||||
(fn
|
(fn
|
||||||
@@ -2280,9 +2313,6 @@
|
|||||||
effect-list)
|
effect-list)
|
||||||
kont)))))
|
kont)))))
|
||||||
|
|
||||||
;; Final call dispatch from arg frame — all args evaluated, invoke function.
|
|
||||||
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
|
|
||||||
;; native fn (direct call), continuation (resume), callcc continuation (escape).
|
|
||||||
(define
|
(define
|
||||||
step-sf-set!
|
step-sf-set!
|
||||||
(fn
|
(fn
|
||||||
@@ -2292,6 +2322,13 @@
|
|||||||
env
|
env
|
||||||
(kont-push (make-set-frame (symbol-name (first args)) env) kont))))
|
(kont-push (make-set-frame (symbol-name (first args)) env) kont))))
|
||||||
|
|
||||||
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
|
;; Part 11: Entry Points
|
||||||
|
;;
|
||||||
|
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
|
||||||
|
;; eval-expr / trampoline: top-level bindings that override the
|
||||||
|
;; forward declarations from Part 5.
|
||||||
|
;; ═══════════════════════════════════════════════════════════════
|
||||||
(define
|
(define
|
||||||
step-sf-and
|
step-sf-and
|
||||||
(fn
|
(fn
|
||||||
@@ -2304,13 +2341,6 @@
|
|||||||
env
|
env
|
||||||
(kont-push (make-and-frame (rest args) env) kont)))))
|
(kont-push (make-and-frame (rest args) env) kont)))))
|
||||||
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
|
||||||
;; Part 11: Entry Points
|
|
||||||
;;
|
|
||||||
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
|
|
||||||
;; eval-expr / trampoline: top-level bindings that override the
|
|
||||||
;; forward declarations from Part 5.
|
|
||||||
;; ═══════════════════════════════════════════════════════════════
|
|
||||||
(define
|
(define
|
||||||
step-sf-or
|
step-sf-or
|
||||||
(fn
|
(fn
|
||||||
|
|||||||
Reference in New Issue
Block a user