diff options
author | Andy Wingo <wingo@pobox.com> | 2008-05-03 13:46:56 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-05-03 13:46:56 +0200 |
commit | be4efc52d29f7d26db01da846121bd648be99567 (patch) | |
tree | 3fd9616f953d7deba1a247e88052097a10438eba | |
parent | 063fd30bbe68c67475dc46ba5d4cf49bac321305 (diff) | |
download | guile-be4efc52d29f7d26db01da846121bd648be99567.tar.gz |
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...)).
-rw-r--r-- | module/system/base/syntax.scm | 20 |
1 files changed, 19 insertions, 1 deletions
diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm index 7f23df601..a1d9181d3 100644 --- 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 | ;;; @@ -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)))))) + ;;; ;;; Utilities |