feat: define-record-{equality,matcher}!

these are great

record.sls

@@ -0,0 +1,42 @@
+(library (meh record)
+  (export define-record-equality! define-record-matcher!)
+  (import (chezscheme)
+          (meh match))
+
+(define-syntax define-record-equality!
+  (syntax-rules ()
+    [(_ record-type-name)
+     (let ()
+       (define rtd (record-type-descriptor record-type-name))
+       (define field-count (vector-length (record-type-field-names rtd)))
+       (define accessors
+         (do ([i 0 (add1 i)]
+              [as '() (cons (record-accessor rtd i) as)])
+             [(= i field-count) (reverse! as)]))
+       (record-type-equal-procedure rtd
+                                    (lambda (r1 r2 =)
+                                      (for-all
+                                       (lambda (accessor) (= (accessor r1) (accessor r2)))
+                                       accessors))))]
+    [(_ name name* ...)
+     (begin (define-record-equality! name)
+            (define-record-equality! name*) ...)]))
+
+(define-syntax define-record-matcher!
+  (syntax-rules ()
+    [(_ record-type-name)
+     (define-pattern record-type-name
+       (lambda (e)
+         (syntax-case e ()
+           [(_ pat* (... ...))
+            (with-syntax ([rtd #'(record-type-descriptor record-type-name)]
+                          [(idx* (... ...))
+                           (datum->syntax
+                            #'* (iota (length (syntax->list #'(pat* (... ...))))))])
+              #'(and (guard x (record? x rtd))
+                     (access (record-accessor rtd idx*) pat*)
+                     (... ...)))])))]
+    [(_ name name* ...)
+     (begin (define-record-matcher! name)
+            (define-record-matcher! name*) ...)]))
+)

std.sls

@@ -16,7 +16,8 @@
 
   (import (chezscheme))
 
-  (export (import (meh match)))
+  (export (import (meh match))
+          (import (meh record)))
 
   ;;; SYNTAX