guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-286-g2


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-11-286-g23988e8
Date: Sat, 28 Aug 2010 17:19:01 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=23988e8c50e62355689f5bcb34ca65c45fb35fc7

The branch, master has been updated
       via  23988e8c50e62355689f5bcb34ca65c45fb35fc7 (commit)
      from  7d0e17389c6856883a87f914d0d7c916620832d5 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 23988e8c50e62355689f5bcb34ca65c45fb35fc7
Author: Andreas Rottmann <address@hidden>
Date:   Sat Aug 28 10:16:30 2010 -0700

    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.

-----------------------------------------------------------------------

Summary of changes:
 module/rnrs/arithmetic/fixnums.scm |    2 +-
 module/rnrs/base.scm               |   20 ++++++++++++++++++++
 module/rnrs/conditions.scm         |   12 +++++++++++-
 module/rnrs/enums.scm              |    1 -
 module/rnrs/exceptions.scm         |   12 ++++++------
 module/rnrs/records/syntactic.scm  |   11 +++++++----
 6 files changed, 45 insertions(+), 13 deletions(-)

diff --git a/module/rnrs/arithmetic/fixnums.scm 
b/module/rnrs/arithmetic/fixnums.scm
index cda1933..c1f3571 100644
--- a/module/rnrs/arithmetic/fixnums.scm
+++ b/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)
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm
index e92089e..74fce31 100644
--- a/module/rnrs/base.scm
+++ b/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))))
+
 )
diff --git a/module/rnrs/conditions.scm b/module/rnrs/conditions.scm
index 53d4d0f..b897221 100644
--- a/module/rnrs/conditions.scm
+++ b/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)))
diff --git a/module/rnrs/enums.scm b/module/rnrs/enums.scm
index cd7e346..79d3417 100644
--- a/module/rnrs/enums.scm
+++ b/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 (... ...))))
diff --git a/module/rnrs/exceptions.scm b/module/rnrs/exceptions.scm
index cd5bacf..ff4049b 100644
--- a/module/rnrs/exceptions.scm
+++ b/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)
-       (guard0 (variable cond-clause ... (else else-clause ...)) body))
-      ((_ (variable cond-clause ...) body)
-       (guard0 (variable cond-clause ... (else (raise variable))) body))))
+      ((_ (variable cond-clause ... . ((else else-clause ...))) . body)
+       (guard0 (variable cond-clause ... (else else-clause ...)) . body))
+      ((_ (variable cond-clause ...) . body)
+       (guard0 (variable cond-clause ... (else (raise variable))) . body))))
 )
diff --git a/module/rnrs/records/syntactic.scm 
b/module/rnrs/records/syntactic.scm
index d46efbc..5070212 100644
--- a/module/rnrs/records/syntactic.scm
+++ b/module/rnrs/records/syntactic.scm
@@ -177,10 +177,13 @@
                      (record-constructor
                       (make-record-constructor-descriptor 
                        record-name #,parent-cd #,protocol)))
-                   (register-record-type 
-                    #,record-name-sym 
-                    record-name (make-record-constructor-descriptor 
-                                 record-name #,parent-cd #,protocol))
+                    (define dummy
+                      (let ()
+                        (register-record-type 
+                         #,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))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]