Commitbcb6948dRecorded31 Mar 2026Repositorysigil-match

Initial standalone package for sigil-match

Message

Extract (sigil match) pattern matching library from sigil-stdlib into a standalone package with from-git dependencies, dev-redirects, and usage documentation.

Changed
 .gitignore          |   1 +
 README.md           | 177 +++++++++++++++++++++++++++++++++++++++++++++++++++
 dev-redirects.sgl   |   6 ++
 package.sgl         |  38 +++++++++++
 src/sigil/match.sgl | 599 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 821 insertions(+)
Diff
.gitignoreadded
@@ -0,0 +1 @@
+1
build/
README.mdadded
@@ -0,0 +1,177 @@
+1
# sigil-match
+2
+3
Pattern matching library for [Sigil](https://codeberg.org/sigil/sigil). Destructure and dispatch on data using patterns. Match values against shapes, bind variables, and combine patterns with guards, boolean logic, and transformations.
+4
+5
## Usage
+6
+7
```scheme
+8
(import (sigil match))
+9
+10
;; Destructure a list
+11
(match '(1 2 3)
+12
((a b c) (+ a b c))) ; => 6
+13
+14
;; Type dispatch
+15
(match value
+16
((? number?) "it's a number")
+17
((? string?) "it's a string")
+18
(_ "something else"))
+19
+20
;; Literal matching
+21
(match cmd
+22
('quit (exit))
+23
('help (show-help))
+24
(('load file) (load-file file))
+25
(_ (unknown-command)))
+26
```
+27
+28
## Pattern Types
+29
+30
| Pattern | Description |
+31
|---------|-------------|
+32
| `_` | Wildcard, matches anything |
+33
| `()` | Empty list |
+34
| `'datum` | Literal value (uses `equal?`) |
+35
| `#t` / `#f` | Boolean literals |
+36
| `(p1 . p2)` | Pair: `p1` matches car, `p2` matches cdr |
+37
| `(p1 p2 ...)` | List: each element matched positionally |
+38
| `var` | Variable binding |
+39
| `(? pred)` | Guard: matches if `(pred val)` is true |
+40
| `(? pred pat)` | Guarded pattern: pred and pattern must both match |
+41
| `(and p ...)` | All patterns must match |
+42
| `(or p ...)` | Any pattern matches (first wins) |
+43
| `(not pat)` | Negation: matches if pattern doesn't |
+44
| `(= proc pat)` | Transform: apply proc, then match result |
+45
| `($ type p ...)` | SRFI-9 record: match type tag and fields positionally |
+46
| `(: type k: ...)` | Sigil struct: match by keyword fields |
+47
| `#{ k: p ... }` | Dict: match by keyword fields |
+48
| `#(p ...)` | Vector: match elements positionally |
+49
+50
## Guard Patterns
+51
+52
Use `(? predicate)` to match values satisfying a condition:
+53
+54
```scheme
+55
(match x
+56
((? positive? n) (format "positive: ~a" n))
+57
((? negative? n) (format "negative: ~a" n))
+58
(_ "zero"))
+59
```
+60
+61
## Combining Patterns
+62
+63
Use `and`, `or`, and `not` to combine patterns:
+64
+65
```scheme
+66
;; All conditions must match
+67
(match n
+68
((and (? integer?) (? positive?)) "positive integer")
+69
(_ "other"))
+70
+71
;; Any condition can match
+72
(match color
+73
((or 'red 'green 'blue) "primary")
+74
(_ "other"))
+75
+76
;; Negation
+77
(match lst
+78
((not ()) "non-empty")
+79
(() "empty"))
+80
```
+81
+82
## Transform Patterns
+83
+84
Use `(= proc pat)` to transform a value before matching:
+85
+86
```scheme
+87
(match str
+88
((= string-length 0) "empty")
+89
((= string-length 1) "single char")
+90
(_ "multiple chars"))
+91
```
+92
+93
## Record Patterns (SRFI-9)
+94
+95
Use `($ type fields ...)` to match SRFI-9 record types positionally:
+96
+97
```scheme
+98
(define-record-type <point>
+99
(make-point x y) point?
+100
(x point-x) (y point-y))
+101
+102
(match p
+103
(($ <point> x y) (+ x y)))
+104
```
+105
+106
## Struct Patterns (Sigil)
+107
+108
Use `(: type field: ...)` to match Sigil structs by field name:
+109
+110
```scheme
+111
(define-struct point (x) (y))
+112
+113
(match p
+114
((: point x: y:) (+ x y)) ; shorthand: binds x and y
+115
((: point x: px y: py) ...)) ; explicit binding names
+116
+117
;; Match only specific fields
+118
(match p
+119
((: point y:) y)) ; only match y field
+120
```
+121
+122
## Dict Patterns
+123
+124
Use `#{ key: pat ... }` or `(dict key: ...)` to match dicts by key:
+125
+126
```scheme
+127
(match config
+128
(#{ host: port: } (connect host port))
+129
((dict debug:) debug))
+130
+131
;; Type check only
+132
(match val
+133
((dict) 'is-dict)
+134
(_ 'other))
+135
```
+136
+137
## Convenience Forms
+138
+139
```scheme
+140
;; match-lambda: anonymous function with pattern matching
+141
(define get-x (match-lambda ((x . _) x)))
+142
(get-x '(1 2 3)) ; => 1
+143
+144
;; match-lambda*: match all arguments as a list
+145
(define add-pair
+146
(match-lambda* ((a b) (+ a b))))
+147
(add-pair 3 4) ; => 7
+148
+149
;; match-let: destructuring let
+150
(match-let (((x y) '(1 2))
+151
((a . b) '(3 4 5)))
+152
(list x y a b))
+153
; => (1 2 3 (4 5))
+154
```
+155
+156
## Exports
+157
+158
- `match` - Main matching macro
+159
- `match-lambda` - Single-argument matching lambda
+160
- `match-lambda*` - Multi-argument matching lambda
+161
- `match-let` - Destructuring let with patterns
+162
- `match-pattern` - Low-level pattern matching (used internally)
+163
+164
## Dependencies
+165
+166
- sigil-stdlib
+167
+168
## Build
+169
+170
```sh
+171
sigil build
+172
sigil test
+173
```
+174
+175
## License
+176
+177
BSD-3-Clause
dev-redirects.sgladded
@@ -0,0 +1,6 @@
+1
;; Development redirects — point dependencies at local checkouts
+2
(redirects
+3
repos: (list
+4
(for-repo
+5
url: "codeberg:sigil/sigil"
+6
use: (from-path dir: "../sigil"))))
package.sgladded
@@ -0,0 +1,38 @@
+1
;;; sigil-match - Pattern matching library
+2
;;;
+3
;;; Destructure and dispatch on data using patterns. Match values against
+4
;;; shapes, bind variables, and combine patterns with guards, boolean logic,
+5
;;; and transformations.
+6
+7
(define sigil-repo "codeberg:sigil/sigil")
+8
+9
(package
+10
name: "sigil-match"
+11
version: "0.9.0"
+12
description: "Pattern matching library for Sigil"
+13
url: "https://codeberg.org/sigil/sigil-match"
+14
license: "BSD-3-Clause"
+15
authors: (list "David Wilson <[email protected]>")
+16
+17
configs: (list
+18
(config
+19
name: 'dev
+20
output-dir: "build/dev"
+21
debug?: #t
+22
optimize: 0)
+23
(config
+24
name: 'release
+25
output-dir: "build/release"
+26
debug?: #f
+27
optimize: 2))
+28
+29
dependencies: (list
+30
(from-git url: sigil-repo package: "sigil-stdlib"))
+31
+32
tasks: (list
+33
(task
+34
name: 'build
+35
description: "Compile sigil-match modules"
+36
steps: (list
+37
(compile-sigil-modules sources: "src/**/*.sgl"
+38
output-dir: (config-output-subdir "lib"))))))
src/sigil/match.sgladded
@@ -0,0 +1,599 @@
+1
;;; (sigil match) - Pattern Matching
+2
;;;
+3
;;; Destructure and dispatch on data using patterns. Match values against
+4
;;; shapes, bind variables, and combine patterns with guards, boolean logic,
+5
;;; and transformations.
+6
;;;
+7
;;; ## Basic Usage
+8
;;;
+9
;;; ```scheme
+10
;;; (import (sigil match))
+11
;;;
+12
;;; ;; Destructure a list
+13
;;; (match '(1 2 3)
+14
;;; ((a b c) (+ a b c))) ; => 6
+15
;;;
+16
;;; ;; Type dispatch
+17
;;; (match value
+18
;;; ((? number?) "it's a number")
+19
;;; ((? string?) "it's a string")
+20
;;; (_ "something else"))
+21
;;; ```
+22
;;;
+23
;;; ## Pattern Types
+24
;;;
+25
;;; | Pattern | Description |
+26
;;; |---------|-------------|
+27
;;; | `_` | Wildcard, matches anything |
+28
;;; | `()` | Empty list |
+29
;;; | `'datum` | Literal value (uses `equal?`) |
+30
;;; | `#t` / `#f` | Boolean literals |
+31
;;; | `(p1 . p2)` | Pair: `p1` matches car, `p2` matches cdr |
+32
;;; | `(p1 p2 ...)` | List: each element matched positionally |
+33
;;; | `var` | Variable binding |
+34
;;; | `(? pred)` | Guard: matches if `(pred val)` is true |
+35
;;; | `(? pred pat)` | Guarded pattern: pred and pattern must both match |
+36
;;; | `(and p ...)` | All patterns must match |
+37
;;; | `(or p ...)` | Any pattern matches (first wins) |
+38
;;; | `(not pat)` | Negation: matches if pattern doesn't |
+39
;;; | `(= proc pat)` | Transform: apply proc, then match result |
+40
;;; | `($ type p ...)` | SRFI-9 record: match type tag and fields positionally |
+41
;;; | `(: type k: ...)` | Sigil struct: match by keyword fields |
+42
;;; | `#{ k: p ... }` | Dict: match by keyword fields |
+43
;;; | `#(p ...)` | Vector: match elements positionally |
+44
;;;
+45
;;; ## Guard Patterns
+46
;;;
+47
;;; Use `(? predicate)` to match values satisfying a condition:
+48
;;;
+49
;;; ```scheme
+50
;;; (match x
+51
;;; ((? positive? n) (format "positive: ~a" n))
+52
;;; ((? negative? n) (format "negative: ~a" n))
+53
;;; (_ "zero"))
+54
;;; ```
+55
;;;
+56
;;; ## Combining Patterns
+57
;;;
+58
;;; Use `and`, `or`, and `not` to combine patterns:
+59
;;;
+60
;;; ```scheme
+61
;;; ;; All conditions must match
+62
;;; (match n
+63
;;; ((and (? integer?) (? positive?)) "positive integer")
+64
;;; (_ "other"))
+65
;;;
+66
;;; ;; Any condition can match
+67
;;; (match color
+68
;;; ((or 'red 'green 'blue) "primary")
+69
;;; (_ "other"))
+70
;;;
+71
;;; ;; Negation
+72
;;; (match lst
+73
;;; ((not ()) "non-empty")
+74
;;; (() "empty"))
+75
;;; ```
+76
;;;
+77
;;; ## Transform Patterns
+78
;;;
+79
;;; Use `(= proc pat)` to transform a value before matching:
+80
;;;
+81
;;; ```scheme
+82
;;; (match str
+83
;;; ((= string-length 0) "empty")
+84
;;; ((= string-length 1) "single char")
+85
;;; (_ "multiple chars"))
+86
;;; ```
+87
;;;
+88
;;; ## Record Patterns (SRFI-9)
+89
;;;
+90
;;; Use `($ type fields ...)` to match SRFI-9 record types positionally:
+91
;;;
+92
;;; ```scheme
+93
;;; (define-record-type <point>
+94
;;; (make-point x y) point?
+95
;;; (x point-x) (y point-y))
+96
;;;
+97
;;; (match p
+98
;;; (($ <point> x y) (+ x y)))
+99
;;; ```
+100
;;;
+101
;;; ## Struct Patterns (Sigil)
+102
;;;
+103
;;; Use `(: type field: ...)` to match Sigil structs by field name:
+104
;;;
+105
;;; ```scheme
+106
;;; (define-struct point (x) (y))
+107
;;;
+108
;;; (match p
+109
;;; ((: point x: y:) (+ x y)) ; shorthand: binds x and y
+110
;;; ((: point x: px y: py) ...)) ; explicit binding names
+111
;;;
+112
;;; ;; Match only specific fields
+113
;;; (match p
+114
;;; ((: point y:) y)) ; only match y field
+115
;;; ```
+116
;;;
+117
;;; ## Dict Patterns
+118
;;;
+119
;;; Use `#{ key: pat ... }` or `(dict key: ...)` to match dicts by key:
+120
;;;
+121
;;; ```scheme
+122
;;; (match config
+123
;;; (#{ host: port: } (connect host port)) ; explicit bindings required
+124
;;; ((dict debug:) debug)) ; shorthand with (dict ...)
+125
;;;
+126
;;; ;; Type check only
+127
;;; (match val
+128
;;; ((dict) 'is-dict)
+129
;;; (_ 'other))
+130
;;; ```
+131
+132
(define-library (sigil match)
+133
(export match match-lambda match-lambda* match-let
+134
match-pattern match-record-fields
+135
%match-vector-elements %count-patterns
+136
%match-struct-fields %match-struct %match-dict)
+137
+138
(begin
+139
+140
;; Helper for matching record fields by index
+141
(define-syntax match-record-fields
+142
(syntax-rules ()
+143
;; Base case - no more patterns
+144
((match-record-fields val idx () sk fk)
+145
sk)
+146
+147
;; Single pattern remaining
+148
((match-record-fields val idx (pat) sk fk)
+149
(match-pattern (vector-ref val idx) pat sk fk))
+150
+151
;; Multiple patterns - match first at current index, recurse with next index
+152
((match-record-fields val idx (pat rest ...) sk fk)
+153
(match-pattern (vector-ref val idx) pat
+154
(match-record-fields val (+ idx 1) (rest ...) sk fk)
+155
fk))))
+156
+157
;; Helper for matching vector elements by index (starting at 0)
+158
(define-syntax %match-vector-elements
+159
(syntax-rules ()
+160
;; Base case - no more patterns
+161
((%match-vector-elements val idx () sk fk)
+162
sk)
+163
+164
;; Single pattern remaining
+165
((%match-vector-elements val idx (pat) sk fk)
+166
(match-pattern (vector-ref val idx) pat sk fk))
+167
+168
;; Multiple patterns
+169
((%match-vector-elements val idx (pat rest ...) sk fk)
+170
(match-pattern (vector-ref val idx) pat
+171
(%match-vector-elements val (+ idx 1) (rest ...) sk fk)
+172
fk))))
+173
+174
;; Helper for counting patterns (returns a number)
+175
(define-syntax %count-patterns
+176
(syntax-rules ()
+177
((%count-patterns) 0)
+178
((%count-patterns p) 1)
+179
((%count-patterns p rest ...) (+ 1 (%count-patterns rest ...)))))
+180
+181
;; Helper for matching Sigil struct fields by index (starting at 0)
+182
(define-syntax %match-struct-fields
+183
(syntax-rules ()
+184
;; Base case - no more patterns
+185
((%match-struct-fields val idx () sk fk)
+186
sk)
+187
+188
;; Single pattern remaining
+189
((%match-struct-fields val idx (pat) sk fk)
+190
(match-pattern (%struct-ref val idx) pat sk fk))
+191
+192
;; Multiple patterns
+193
((%match-struct-fields val idx (pat rest ...) sk fk)
+194
(match-pattern (%struct-ref val idx) pat
+195
(%match-struct-fields val (+ idx 1) (rest ...) sk fk)
+196
fk))))
+197
+198
;; ============================================================
+199
;; : Pattern - Sigil Struct Matching (keyword-based)
+200
;; ============================================================
+201
;;
+202
;; Matches Sigil structs using keyword field patterns.
+203
;; (: point x: y:) - bind x and y fields
+204
;; (: point x: px y: py) - bind with explicit names
+205
;; (: point x:) - bind only x field
+206
+207
;; Helper: unwrap syntax
+208
(define (%match-struct-unwrap v)
+209
(if (syntax? v) (syntax-datum v) v))
+210
+211
;; Helper: parse keyword args into ((field-name . pattern) ...)
+212
;; Handles both (field:) shorthand and (field: pattern) forms
+213
(define (%match-struct-parse-args args)
+214
(if (null? args)
+215
'()
+216
(let* ((kw (%match-struct-unwrap (car args)))
+217
(field-name (keyword->symbol kw))
+218
(rest (cdr args)))
+219
(if (or (null? rest)
+220
(keyword? (%match-struct-unwrap (car rest))))
+221
;; Shorthand: x: means x: x
+222
(cons (cons field-name field-name)
+223
(%match-struct-parse-args rest))
+224
;; Explicit: x: pattern
+225
(cons (cons field-name (car rest))
+226
(%match-struct-parse-args (cdr rest)))))))
+227
+228
;; Helper: generate struct field matching code for one field
+229
(define (%match-struct-gen-field val-sym type-sym field-name pattern sk fk)
+230
(let ((idx-expr `(struct-field-index
+231
(cdr (assq 'struct-type (procedure-metadata ,type-sym)))
+232
',field-name)))
+233
(if (symbol? (%match-struct-unwrap pattern))
+234
;; Simple binding
+235
`(let ((,(%match-struct-unwrap pattern) (%struct-ref ,val-sym ,idx-expr)))
+236
,sk)
+237
;; Complex pattern - need to call match-pattern
+238
`(match-pattern (%struct-ref ,val-sym ,idx-expr) ,pattern ,sk ,fk))))
+239
+240
;; Helper: generate struct matching code for all fields
+241
(define (%match-struct-gen-fields val-sym type-sym field-specs sk fk)
+242
(if (null? field-specs)
+243
sk
+244
(let* ((spec (car field-specs))
+245
(field-name (car spec))
+246
(pattern (cdr spec))
+247
(rest-sk (%match-struct-gen-fields val-sym type-sym (cdr field-specs) sk fk)))
+248
(%match-struct-gen-field val-sym type-sym field-name pattern rest-sk fk))))
+249
+250
;; The procedural macro transformer for : patterns
+251
;; Form: (%match-struct val type (field-args ...) sk fk)
+252
(define (%match-struct-transform form)
+253
(let* ((args (%match-struct-unwrap form))
+254
(val-expr (list-ref args 1))
+255
(type-sym (%match-struct-unwrap (list-ref args 2)))
+256
(field-args (%match-struct-unwrap (list-ref args 3)))
+257
(sk (list-ref args 4))
+258
(fk (list-ref args 5))
+259
(val-sym (gensym "val"))
+260
(field-specs (%match-struct-parse-args field-args)))
+261
(if (null? field-specs)
+262
;; Type check only - no field patterns
+263
`(let ((,val-sym ,val-expr))
+264
(if (and (struct? ,val-sym)
+265
(%struct-instance? ,val-sym
+266
(cdr (assq 'struct-type (procedure-metadata ,type-sym)))))
+267
,sk
+268
,fk))
+269
;; With field patterns
+270
`(let ((,val-sym ,val-expr))
+271
(if (and (struct? ,val-sym)
+272
(%struct-instance? ,val-sym
+273
(cdr (assq 'struct-type (procedure-metadata ,type-sym)))))
+274
,(%match-struct-gen-fields val-sym type-sym field-specs sk fk)
+275
,fk)))))
+276
+277
(define-syntax %match-struct
+278
(lambda (form) (%match-struct-transform form)))
+279
+280
;; ============================================================
+281
;; dict Pattern - Dict Matching (keyword-based)
+282
;; ============================================================
+283
;;
+284
;; Matches dicts using keyword field patterns.
+285
;; (dict a: b:) - bind values for keys a: and b:
+286
;; (dict a: x b: y) - bind with explicit names
+287
+288
;; Helper: unwrap syntax for dict matching
+289
(define (%match-dict-unwrap v)
+290
(if (syntax? v) (syntax-datum v) v))
+291
+292
;; Helper: parse keyword args into ((key . pattern) ...)
+293
(define (%match-dict-parse-args args)
+294
(if (null? args)
+295
'()
+296
(let* ((kw (%match-dict-unwrap (car args)))
+297
(key-sym (keyword->symbol kw))
+298
(rest (cdr args)))
+299
(if (or (null? rest)
+300
(keyword? (%match-dict-unwrap (car rest))))
+301
;; Shorthand: a: means a: a
+302
(cons (cons kw key-sym)
+303
(%match-dict-parse-args rest))
+304
;; Explicit: a: pattern
+305
(cons (cons kw (car rest))
+306
(%match-dict-parse-args (cdr rest)))))))
+307
+308
;; Helper: generate dict field matching code for one key
+309
(define (%match-dict-gen-field val-sym key pattern sk fk)
+310
(let ((ref-expr `(dict-ref ,val-sym ,key #f)))
+311
(if (symbol? (%match-dict-unwrap pattern))
+312
;; Simple binding - check key exists first
+313
`(let ((%tmp ,ref-expr))
+314
(if %tmp
+315
(let ((,(%match-dict-unwrap pattern) %tmp))
+316
,sk)
+317
,fk))
+318
;; Complex pattern
+319
`(let ((%tmp ,ref-expr))
+320
(if %tmp
+321
(match-pattern %tmp ,pattern ,sk ,fk)
+322
,fk)))))
+323
+324
;; Helper: generate dict matching code for all keys
+325
(define (%match-dict-gen-fields val-sym field-specs sk fk)
+326
(if (null? field-specs)
+327
sk
+328
(let* ((spec (car field-specs))
+329
(key (car spec))
+330
(pattern (cdr spec))
+331
(rest-sk (%match-dict-gen-fields val-sym (cdr field-specs) sk fk)))
+332
(%match-dict-gen-field val-sym key pattern rest-sk fk))))
+333
+334
;; The procedural macro transformer for dict patterns
+335
;; Form: (%match-dict val (field-args ...) sk fk)
+336
(define (%match-dict-transform form)
+337
(let* ((args (%match-dict-unwrap form))
+338
(val-expr (list-ref args 1))
+339
(field-args (%match-dict-unwrap (list-ref args 2)))
+340
(sk (list-ref args 3))
+341
(fk (list-ref args 4))
+342
(val-sym (gensym "val"))
+343
(field-specs (%match-dict-parse-args field-args)))
+344
(if (null? field-specs)
+345
;; Type check only - no field patterns
+346
`(let ((,val-sym ,val-expr))
+347
(if (dict? ,val-sym)
+348
,sk
+349
,fk))
+350
;; With field patterns
+351
`(let ((,val-sym ,val-expr))
+352
(if (dict? ,val-sym)
+353
,(%match-dict-gen-fields val-sym field-specs sk fk)
+354
,fk)))))
+355
+356
(define-syntax %match-dict
+357
(lambda (form) (%match-dict-transform form)))
+358
+359
(define-syntax match-pattern
+360
(syntax-rules (_ quote ? and or not = $ vector : dict)
+361
;; Wildcard pattern - always matches, no binding
+362
((match-pattern val _ sk fk)
+363
sk)
+364
+365
;; Empty list pattern
+366
((match-pattern val () sk fk)
+367
(if (null? val) sk fk))
+368
+369
;; Quoted literal pattern - match with equal?
+370
((match-pattern val (quote datum) sk fk)
+371
(if (equal? val 'datum) sk fk))
+372
+373
;; Boolean literals
+374
((match-pattern val #t sk fk)
+375
(if (eq? val #t) sk fk))
+376
+377
((match-pattern val #f sk fk)
+378
(if (eq? val #f) sk fk))
+379
+380
;; Guard pattern - just predicate, no sub-pattern
+381
((match-pattern val (? pred) sk fk)
+382
(if (pred val) sk fk))
+383
+384
;; Guard pattern with sub-pattern
+385
((match-pattern val (? pred pat) sk fk)
+386
(if (pred val)
+387
(match-pattern val pat sk fk)
+388
fk))
+389
+390
;; And pattern - base case (no patterns)
+391
((match-pattern val (and) sk fk)
+392
sk)
+393
+394
;; And pattern - single pattern
+395
((match-pattern val (and pat) sk fk)
+396
(match-pattern val pat sk fk))
+397
+398
;; And pattern - multiple patterns (all must match)
+399
((match-pattern val (and pat1 pat2 ...) sk fk)
+400
(match-pattern val pat1
+401
(match-pattern val (and pat2 ...) sk fk)
+402
fk))
+403
+404
;; Or pattern - base case (no patterns, fail)
+405
((match-pattern val (or) sk fk)
+406
fk)
+407
+408
;; Or pattern - single pattern
+409
((match-pattern val (or pat) sk fk)
+410
(match-pattern val pat sk fk))
+411
+412
;; Or pattern - multiple patterns (first match wins)
+413
((match-pattern val (or pat1 pat2 ...) sk fk)
+414
(match-pattern val pat1 sk
+415
(match-pattern val (or pat2 ...) sk fk)))
+416
+417
;; Not pattern - matches if sub-pattern does NOT match
+418
((match-pattern val (not pat) sk fk)
+419
(match-pattern val pat fk sk))
+420
+421
;; Transform pattern - apply proc, then match result
+422
((match-pattern val (= proc pat) sk fk)
+423
(match-pattern (proc val) pat sk fk))
+424
+425
;; Record pattern - match record type with positional fields
+426
;; Just type check, no field patterns
+427
((match-pattern val ($ type) sk fk)
+428
(if (and (vector? val)
+429
(> (vector-length val) 0)
+430
(eq? (vector-ref val 0) 'type))
+431
sk
+432
fk))
+433
+434
;; Type with field patterns - delegate to helper with index 1
+435
((match-pattern val ($ type pat ...) sk fk)
+436
(if (and (vector? val)
+437
(> (vector-length val) 0)
+438
(eq? (vector-ref val 0) 'type))
+439
(match-record-fields val 1 (pat ...) sk fk)
+440
fk))
+441
+442
;; Vector literal pattern - #() matches empty vector
+443
((match-pattern val #() sk fk)
+444
(if (and (vector? val) (= (vector-length val) 0))
+445
sk
+446
fk))
+447
+448
;; Vector literal pattern - #(p1 p2 ...) matches vector with that many elements
+449
((match-pattern val #(pat ...) sk fk)
+450
(if (and (vector? val)
+451
(= (vector-length val) (%count-patterns pat ...)))
+452
(%match-vector-elements val 0 (pat ...) sk fk)
+453
fk))
+454
+455
;; Vector pattern - (vector) matches empty vector
+456
((match-pattern val (vector) sk fk)
+457
(if (and (vector? val) (= (vector-length val) 0))
+458
sk
+459
fk))
+460
+461
;; (vector p1 p2 ...) matches vector with exactly that many elements
+462
((match-pattern val (vector pat ...) sk fk)
+463
(if (and (vector? val)
+464
(= (vector-length val) (%count-patterns pat ...)))
+465
(%match-vector-elements val 0 (pat ...) sk fk)
+466
fk))
+467
+468
;; Struct pattern - match Sigil structs with keyword field patterns
+469
;; (: type) - type check only
+470
;; (: type field: ...) - with field patterns
+471
((match-pattern val (: type arg ...) sk fk)
+472
(%match-struct val type (arg ...) sk fk))
+473
+474
;; Dict pattern - match dicts with keyword field patterns
+475
;; (dict) or #{ } - type check only
+476
;; (dict key: ...) or #{ key: ... } - with field patterns
+477
((match-pattern val (dict arg ...) sk fk)
+478
(%match-dict val (arg ...) sk fk))
+479
+480
;; Pair pattern - recursively match car and cdr
+481
;; This handles both (h . t) and (a b c) patterns
+482
((match-pattern val (ph . pt) sk fk)
+483
(if (pair? val)
+484
(match-pattern (car val) ph
+485
(match-pattern (cdr val) pt sk fk)
+486
fk)
+487
fk))
+488
+489
;; Variable pattern - bind the whole value
+490
((match-pattern val var sk fk)
+491
(let ((var val)) sk))))
+492
+493
;; ============================================================
+494
;; Match Macro - Pure syntax-rules implementation
+495
;; ============================================================
+496
+497
;; Helper: process match clauses
+498
(define-syntax %match-clauses
+499
(syntax-rules ()

Showing the first 500 of 600 diff lines for this file. This diff is INCOMPLETE; read the file or clone the repository for the rest.