pull in srfi-9, implement record-case

* module/system/base/syntax.scm: Pull in srfi-9. Define a record-case
  macro that will replace (match foo (($ <type> slot ...) body...)).

diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm
index 7f23df6..a1d9181 100644 (file)
--- a/module/system/base/syntax.scm
+++ b/module/system/base/syntax.scm
@@ -20,11 +20,14 @@
 ;;; Code:
 
 (define-module (system base syntax)
+  :use-modules (srfi srfi-9)
   :export (%make-struct slot
            %slot-1 %slot-2 %slot-3 %slot-4 %slot-5
            %slot-6 %slot-7 %slot-8 %slot-9
            list-fold)
-  :export-syntax (syntax define-type define-record |))
+  :export-syntax (syntax define-type define-record record-case)
+  :re-export-syntax (define-record-type))
+(export-syntax |) ;; emacs doesn't like the |
 
 \f
 ;;;
@@ -157,6 +160,21 @@
 (define (%slot-8 x) (vector-ref x 8))
 (define (%slot-9 x) (vector-ref x 9))
 
+(define-macro (record-case record . clauses)
+  (let ((r (gensym)))
+    (define (process-clause clause)
+      (let ((record-type (caar clause))
+            (slots (cdar clause))
+            (body (cdr clause)))
+        `(((record-predicate ,record-type) ,r)
+          (let ,(map (lambda (slot)
+                       `(,slot ((record-accessor ,record-type ',slot) ,r)))
+                     slots)
+            ,@body))))
+    `(let ((,r ,record))
+       (cond ,@(map process-clause clauses)
+             (else (error "unhandled record" ,r))))))
+
 \f
 ;;;
 ;;; Utilities