Several fixes to R6RS libraries

* module/rnrs/arithmetic/fixnums.scm (fixnum-width): Make this return an
  an exact integer instead of an inexact number.

* module/rnrs/base.scm (assertion-violation): Implement.

* module/rnrs/conditions.scm (simple-conditions): Allow also simple
  conditions as argument.

* module/rnrs/enums.scm (define-enumeration): Properly construct empty
  enumeration sets.

* module/rnrs/exceptions.scm (guard): Don't restrict the body to a
  single expression.

* module/rnrs/records/syntactic.scm (define-record-type0): Expand into a
  series of definitions only.

module/rnrs/arithmetic/fixnums.scm

@@ -93,7 +93,7 @@
 	  (rnrs lists (6)))
 
   (define fixnum-width 
-    (let ((w (round (/ (log (+ most-positive-fixnum 1)) (log 2)))))
+    (let ((w (inexact->exact (round (/ (log (+ most-positive-fixnum 1)) (log 2))))))
       (lambda () w)))
 
   (define (greatest-fixnum) most-positive-fixnum)

module/rnrs/base.scm

@@ -94,4 +94,24 @@
 	     ((negative? y) (values (- q 1) (+ r y)))
 	     (else (values (+ q 1) (+ r y)))))))
 
+ (define raise
+   (@ (rnrs exceptions) raise))
+ (define condition
+   (@ (rnrs conditions) condition))
+ (define make-assertion-violation
+   (@ (rnrs conditions) make-assertion-violation))
+ (define make-who-condition
+   (@ (rnrs conditions) make-who-condition))
+ (define make-message-condition
+   (@ (rnrs conditions) make-message-condition))
+ (define make-irritants-condition
+   (@ (rnrs conditions) make-irritants-condition))
+ 
+ (define (assertion-violation who message . irritants)
+   (raise (condition
+           (make-assertion-violation)
+           (make-who-condition who)
+           (make-message-condition message)
+           (make-irritants-condition irritants))))
+
 )

module/rnrs/conditions.scm

@@ -95,7 +95,17 @@
   (define make-compound-condition 
     (record-constructor (make-record-constructor-descriptor 
 			 &compound-condition #f #f)))
-  (define simple-conditions (record-accessor &compound-condition 0))
+  (define simple-conditions
+    (let ((compound-ref (record-accessor &compound-condition 0)))
+      (lambda (condition)
+        (cond ((compound-condition? condition)
+               (compound-ref condition))
+              ((condition-internal? condition)
+               (list condition))
+              (else
+               (assertion-violation 'simple-conditions
+                                    "not a condition"
+                                    condition))))))
 
   (define (condition? obj) 
     (or (compound-condition? obj) (condition-internal? obj)))

module/rnrs/enums.scm

@@ -137,7 +137,6 @@
 	 (define-syntax constructor-syntax
 	   (lambda (s)
 	     (syntax-case s ()
-	       ((_) (syntax #f))
 	       ((_ sym (... ...))
 		(let* ((universe '(symbol ...))
 		       (syms (syntax->datum #'(sym (... ...))))

module/rnrs/exceptions.scm

@@ -51,17 +51,17 @@
 
   (define-syntax guard0
     (syntax-rules ()
-      ((_ (variable cond-clause ...) body)
+      ((_ (variable cond-clause ...) . body)
        (call/cc (lambda (continuation)
 		  (with-exception-handler
 		   (lambda (variable)
 		     (continuation (cond cond-clause ...)))
-		   (lambda () body)))))))
+		   (lambda () . body)))))))
 
   (define-syntax guard
     (syntax-rules (else)
-      ((_ (variable cond-clause ... . ((else else-clause ...))) body)
+      ((_ (variable cond-clause ... . ((else else-clause ...))) . body)
-       (guard0 (variable cond-clause ... (else else-clause ...)) body))
+       (guard0 (variable cond-clause ... (else else-clause ...)) . body))
-      ((_ (variable cond-clause ...) body)
+      ((_ (variable cond-clause ...) . body)
-       (guard0 (variable cond-clause ... (else (raise variable))) body))))
+       (guard0 (variable cond-clause ... (else (raise variable))) . body))))
 )

module/rnrs/records/syntactic.scm

@@ -177,10 +177,13 @@
 		      (record-constructor
 		       (make-record-constructor-descriptor 
 			record-name #,parent-cd #,protocol)))
-		    (register-record-type 
+                    (define dummy
-		     #,record-name-sym 
+                      (let ()
-		     record-name (make-record-constructor-descriptor 
+                        (register-record-type 
-				  record-name #,parent-cd #,protocol))
+                         #,record-name-sym 
+                         record-name (make-record-constructor-descriptor 
+                                      record-name #,parent-cd #,protocol))
+                        'dummy))
 		    (define predicate-name (record-predicate record-name))
 		    #,@field-accessors
 		    #,@field-mutators))