record-case definition is moved to libcompile.ss and the file is

deleted.

src/libcompile.ss

@@ -13,18 +13,30 @@
 
 (let ()
 
-(define-syntax cond-expand
+(define-syntax record-case
   (lambda (x)
+    (define (enumerate fld* i)
+      (syntax-case fld* ()
+        [() #'()]
+        [(x . x*) 
+         (with-syntax ([i i] [i* (enumerate #'x* (fx+ i 1))])
+           #'(i . i*))]))
+    (define (generate-body ctxt cls*)
+      (syntax-case cls* (else)
+        [() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v #'x))]
+        [([else b b* ...])  #'(begin b b* ...)]
+        [([(rec-name rec-field* ...) b b* ...] . rest) (identifier? #'rec-name)
+         (with-syntax ([altern (generate-body ctxt #'rest)]
+                       [(id* ...) (enumerate #'(rec-field* ...) 0)]
+                       [rtd #'(type-descriptor rec-name)])
+          #'(if ($record/rtd? v rtd)
+                (let ([rec-field* ($record-ref v id*)] ...)
+                  b b* ...)
+                altern))]))
     (syntax-case x ()
-      [(_ test conseq altern)
-       (if (eval (syntax-object->datum #'test))
-           #'conseq
-           #'altern)])))
-
-(cond-expand (eq? "" "")
-  (include "record-case.chez.ss")
-  (include "record-case.ss"))
-
+      [(_ expr cls* ...)
+       (with-syntax ([body (generate-body #'_ #'(cls* ...))])
+         #'(let ([v expr]) body))])))
 
 (include "set-operations.ss")
 

src/record-case.ss

@@ -1,25 +0,0 @@
-
-(define-syntax record-case
-  (lambda (x)
-    (define (enumerate fld* i)
-      (syntax-case fld* ()
-        [() #'()]
-        [(x . x*) 
-         (with-syntax ([i i] [i* (enumerate #'x* (fx+ i 1))])
-           #'(i . i*))]))
-    (define (generate-body ctxt cls*)
-      (syntax-case cls* (else)
-        [() (with-syntax ([x x]) #'(error #f "unmatched ~s in ~s" v #'x))]
-        [([else b b* ...])  #'(begin b b* ...)]
-        [([(rec-name rec-field* ...) b b* ...] . rest) (identifier? #'rec-name)
-         (with-syntax ([altern (generate-body ctxt #'rest)]
-                       [(id* ...) (enumerate #'(rec-field* ...) 0)]
-                       [rtd #'(type-descriptor rec-name)])
-          #'(if ($record/rtd? v rtd)
-                (let ([rec-field* ($record-ref v id*)] ...)
-                  b b* ...)
-                altern))]))
-    (syntax-case x ()
-      [(_ expr cls* ...)
-       (with-syntax ([body (generate-body #'_ #'(cls* ...))])
-         #'(let ([v expr]) body))])))