Re: [PATCH] Use proper SRFI-35 constructs

[Ludovic Courtès]

Andreas Rottmann <address@hidden> writes:

> Thanks for the patch; I'll push it soonish.

Here are a couple of additional patches.  The first one fixes a couple
of things with the previous SRFI-35 patch; the second one addresses
minor glitches reported by Guile-Lint.

Thanks,
Ludovic.

# Bazaar revision bundle v0.9
#
# message:
#   Error condition fixes and linting in `g-wrap.scm'.
# committer: Ludovic Courtes <address@hidden>
# date: Sat 2007-09-01 15:52:51.880000114 +0200

=== modified file ChangeLog
--- ChangeLog
+++ ChangeLog
@@ -1,5 +1,17 @@
 2007-09-01  Ludovic Courtès  <address@hidden>
 
+       * g-wrap.scm (g-wrap): Don't use `srfi-11', don't export
+       `provide-type-class!' (unbound), export the condition type
+       predicates.
+       (gw-handle-condition): Fixed typos, handle
+       `gw-bad-typespec-option-error?' properly.
+       (raise-bad-typespec-option): Don't provide initializers for
+       `spec' and `type'.
+       (for-each-function): Removed.
+       (wrap-type!): Use `format-error' instead of `error'.
+
+2007-09-01  Ludovic Courtès  <address@hidden>
+
        Use proper SRFI-35 constructs.
 
        * g-wrap.scm (&gw-bad-typespec, &gw-bad-typespec-option,

=== modified file g-wrap.scm
--- g-wrap.scm
+++ g-wrap.scm
@@ -33,13 +33,14 @@
   #:use-module (ice-9 pretty-print)
   #:use-module (oop goops)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (g-wrap util)
   
   #:export
   (&gw-bad-typespec
+   gw-bad-typespec-error? gw-bad-typespec-option-error?
+   gw-stacked-error? gw-name-conflict-error?
    raise-bad-typespec
    raise-stacked
    gw-handle-condition
@@ -93,10 +94,9 @@
    
    add-item! add-type! add-constant! add-function!
    add-client-item!
-   
-   provide-type-class!
+
    defines-generic?
-   
+
    wrap-type! wrap-function! wrap-constant!
 
    get-wrapset generate-wrapset compute-client-types
@@ -130,29 +130,35 @@
   (next    stacked-error-next-condition)
   (message stacked-error-message))
 
+
 (define-method (format-error msg . args)
   (display "g-wrap: " (current-error-port))
   (apply format (current-error-port) msg args)
   (newline (current-error-port)))
 
 (define (gw-handle-condition c)
-  (cond ((condition-has-type? c &gw-stacked)
-         (format-error "~A:" (gw-stacked-error-message c))
+  (cond ((gw-stacked-error? c)
+         (format-error "~A:" (stacked-error-message c))
          (gw-handle-condition (stacked-error-next-condition c)))
-        ((condition-has-type? c &gw-bad-typespec)
+        ((gw-bad-typespec-error? c)
          (cond
           ((bad-typespec-type c)
            (format-error "bad typespec `~A ~A': ~A"
-                         (type c) (typespec-options c) (bad-typespec-message 
c)))
+                         (type c) (bad-typespec-options c)
+                         (bad-typespec-message c)))
           (else
            (format-error "bad typespec `~A': ~A" (bad-typespec-form c)
                          (bad-typespec-message c)))))
+        ((gw-bad-typespec-option-error? c)
+         (format-error "bad typespec option: ~A: ~A"
+                       (bad-typespec-option c)
+                       (bad-typespec-option-message c)))
         ((gw-bad-element-error? c)
          (format-error "bad element ~S in tree ~S"
                        (bad-element c) (bad-element-tree c)))
         ((gw-name-conflict-error? c)
          (format-error "name conflict: ~A in namespace ~A: ~A"
-                       (conflicting-name c) (conflict-namespace c)
+                       (conflicting-name c) (conflicting-namespace c)
                        (name-conflict-message c)))
         (else
          (format-error "unhandled error condition: ~A" c))))
@@ -238,7 +244,7 @@
 (define-method (raise-bad-typespec-option option (msg <string>) . args)
   (raise (condition
           (&gw-bad-typespec-option
-           (spec #f) (type #f) (option option)
+           (option option)
            (message (apply format #f msg args))))))
 
 (define-method (raise-stacked next (msg <string>) . args)
@@ -681,9 +687,6 @@
 (define-method (fold-functions kons knil (ws <gw-wrapset>))
   (fold kons knil (reverse (slot-ref ws 'functions))))
 
-(define-method (for-each-function proc (ws <gw-wrapset>))
-  (for-each proc (reverse (slot-ref ws 'functions))))
-
 (define-method (consider-types? (wrapset <gw-wrapset>) (item <gw-item>))
   #t)
 
@@ -746,7 +749,7 @@
   (let ((class (hashq-ref (class-slot-ref
                            (class-of wrapset) 'type-classes) class-name)))
     (if (not class)
-        (error "unknown type class ~S" class-name)) ;; FIXME: better handling
+        (format-error "unknown type class ~S" class-name)) ;; FIXME: better 
handling
     (add-type! wrapset (apply make class args))))
 
 (define-method (wrap-function! (wrapset <gw-wrapset>) . args)

=== modified directory  // last-changed:address@hidden
... s51
# revision id: address@hidden
# sha1: c5134d678b6211ff4f5356dbec6c5bfd2b98efc7
# inventory sha1: 5fb72eb7784cab95dfade3d4a24f0ce3decc3e39
# parent ids:
#   address@hidden
# base id: address@hidden
# properties:
#   branch-nick: g-wrap

# Bazaar revision bundle v0.9
#
# message:
#   Tiny source linting.
# committer: Ludovic Courtes <address@hidden>
# date: Sat 2007-09-01 15:56:06.148000002 +0200

=== modified file ChangeLog
--- ChangeLog
+++ ChangeLog
@@ -1,5 +1,12 @@
 2007-09-01  Ludovic Courtès  <address@hidden>
 
+       * g-wrap/util.scm: Use `srfi-13'.
+       (any-str->c-sym-str): Use `string-concatenate'.
+       (class-slot-set-supers-union!): Use `concatenate'.
+
+       * g-wrap/scm-codegen.scm (generate-wrapset-scm): Removed unused
+       bindings.
+
        * g-wrap.scm (g-wrap): Don't use `srfi-11', don't export
        `provide-type-class!' (unbound), export the condition type
        predicates.

=== modified file g-wrap/scm-codegen.scm
--- g-wrap/scm-codegen.scm
+++ g-wrap/scm-codegen.scm
@@ -37,10 +37,7 @@
   (define (rndr expressions)
     (render (make-scm-code expressions) port))
   
-  (let ((wrapset-name-c-sym (any-str->c-sym-str
-                             (symbol->string (name wrapset))))
-        (client-types (compute-client-types wrapset))
-        (items (reverse (slot-ref wrapset 'items))))
+  (let ((items (reverse (slot-ref wrapset 'items))))
 
     (define (render-items cg)
       (for-each (lambda (item)

=== modified file g-wrap/util.scm
--- g-wrap/util.scm
+++ g-wrap/util.scm
@@ -29,6 +29,7 @@
 
 (define-module (g-wrap util)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-13)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (oop goops)
@@ -177,8 +178,7 @@
      ((char-numeric? char) (string char))
      (else "_")))
 
-  (apply
-   string-append
+  (string-concatenate
    (map
     char->string-replacement
     (string->list name))))
@@ -232,7 +232,7 @@
 
 (define (class-slot-set-supers-union! class slot init)
   (class-slot-set! class slot
-                   (apply append
+                   (concatenate
                           (cons
                            init
                            (map (lambda (c)

=== modified directory  // last-changed:address@hidden
... qm5
# revision id: address@hidden
# sha1: 6ece3e2e48a8ba357aa011a0d59e3e361ceb2a43
# inventory sha1: a783c5b7494212e3af66e76427d212cb1f777665
# parent ids:
#   address@hidden
# base id: address@hidden
# properties:
#   branch-nick: g-wrap