[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Use proper SRFI-35 constructs
From: |
Ludovic Courtès |
Subject: |
Re: [PATCH] Use proper SRFI-35 constructs |
Date: |
Sat, 01 Sep 2007 16:00:45 +0200 |
User-agent: |
Gnus/5.11 (Gnus v5.11) Emacs/22.1 (gnu/linux) |
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