From 1aa0dd2b4529d19b78f344c921fb71e38fbbee19 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 3 May 2008 14:52:36 +0200 Subject: Convert assemble.scm to use record-case. * module/system/base/syntax.scm (record?): Temporarily export this thing, so that code will remain correct when I change to srfi-9 records. * module/system/vm/assemble.scm: Convert to use record-case. --- module/system/base/syntax.scm | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) (limited to 'module/system/base/syntax.scm') diff --git a/module/system/base/syntax.scm b/module/system/base/syntax.scm index 6c98b90c4..3a61ea6f6 100644 --- a/module/system/base/syntax.scm +++ b/module/system/base/syntax.scm @@ -175,11 +175,21 @@ (cond ,@(map process-clause clauses) (else (error "unhandled record" ,r)))))) +;; These are short-lived, and headed to the chopping block. (use-modules (ice-9 match)) (define-macro (record-case record . clauses) (define (process-clause clause) - `(($ ,@(car clause)) ,@(cdr clause))) - `(match ,record ,(map process-clause clauses))) + (if (eq? (car clause) 'else) + clause + `(($ ,@(car clause)) ,@(cdr clause)))) + `(match ,record ,@(map process-clause clauses))) + +(define (record? x) + (and (vector? x) + (not (zero? (vector-length x))) + (symbol? (vector-ref x 0)) + (eqv? (string-ref (symbol->string (vector-ref x 0)) 0) #\<))) +(export record?) ;;; -- cgit v1.2.3