+++ /dev/null
-# Bazaar revision bundle v0.9
-#
-# message:
-# Use proper SRFI-35 constructs.
-#
-# committer: Ludovic Courtes <address@hidden>
-# date: Sat 2007-09-01 13:22:34.372999907 +0200
-
-=== modified file ChangeLog
-2007-09-01 Ludovic Courtès <address@hidden>
-
- Use proper SRFI-35 constructs.
-
- * g-wrap.scm (&gw-bad-typespec, &gw-bad-typespec-option,
- &gw-name-conflict, &gw-stacked): Use `define-condition-type'
- instead of `define-class'.
- (gw-handle-condition): New, replacement for the set of
- `handle-condition' methods.
- (raise-bad-typespec, raise-bad-typespec-option, raise-stacked):
- Specify all fields when invoking the `condition' macro, as
- required per SRFI-35.
- (make-typespec): Use `condition-has-type?' instead of `is-a?'.
- (generate-wrapset): Use `gw-handle-condition' instead of
- `handle-condition'.
-
- * g-wrap/util.scm: Autoload `(g-wrap)'.
- (&gw-bad-element): Use `define-condition-type'.
- (guard/handle): Use `gw-handle-condition'.
- (call-with-output-file/cleanup): Likewise.
-
- * scheme48/g-wrap/scheme48.scm (generate-packages): Use
- `gw-handle-condition'.
-
-=== modified file g-wrap.scm
---- g-wrap.scm
-+++ g-wrap.scm
-@@ -42,6 +42,7 @@
- (&gw-bad-typespec
- raise-bad-typespec
- raise-stacked
-+ gw-handle-condition
-
- <gw-item>
- description
-@@ -101,49 +102,63 @@
- get-wrapset generate-wrapset compute-client-types
- ))
-
-+\f
-+;;;
- ;;; Conditions
--
--(define-class &gw-bad-typespec (&error &message)
-- (spec #:getter typespec-form #:init-value #f)
-- (type #:getter type #:init-value #f)
-- (options #:getter typespec-options #:init-value #f))
--
--(define-class &gw-bad-typespec-option (&error &message)
-- (option #:getter typespec-option))
--
--(define-class &gw-name-conflict (&error &message)
-- (name #:getter conflicting-name)
-- (namespace #:getter conflict-namespace))
--
--(define-class &gw-stacked (&message)
-- (next #:getter next-condition))
-+;;;
-+
-+(define-condition-type &gw-bad-typespec &error
-+ gw-bad-typespec-error?
-+ (spec bad-typespec-form)
-+ (type bad-typespec-type)
-+ (options bad-typespec-options)
-+ (message bad-typespec-message))
-+
-+(define-condition-type &gw-bad-typespec-option &error
-+ gw-bad-typespec-option-error?
-+ (option bad-typespec-option)
-+ (message bad-typespec-option-message))
-+
-+(define-condition-type &gw-name-conflict &error
-+ gw-name-conflict-error?
-+ (name conflicting-name)
-+ (namespace conflicting-namespace)
-+ (message name-conflict-message))
-+
-+(define-condition-type &gw-stacked &error
-+ gw-stacked-error?
-+ (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-method (handle-condition (c &gw-stacked))
-- (format-error "~A:" (condition-message c))
-- (handle-condition (next-condition c)))
--
--(define-method (handle-condition (c &gw-bad-typespec))
-- (cond
-- ((type c)
-- (format-error "bad typespec `~A ~A': ~A"
-- (type c) (typespec-options c) (condition-message c)))
-- (else
-- (format-error "bad typespec `~A': ~A" (typespec-form c)
-- (condition-message c)))))
--
--(define-method (handle-condition (c &gw-bad-element))
-- (format-error "bad element ~S in tree ~S" (element c) (tree c)))
--
--(define-method (handle-condition (c &gw-name-conflict))
-- (format-error "name conflict: ~A in namespace ~A: ~A"
-- (conflicting-name c) (conflict-namespace c)
-- (condition-message c)))
--
-+(define (gw-handle-condition c)
-+ (cond ((condition-has-type? c &gw-stacked)
-+ (format-error "~A:" (gw-stacked-error-message c))
-+ (gw-handle-condition (stacked-error-next-condition c)))
-+ ((condition-has-type? c &gw-bad-typespec)
-+ (cond
-+ ((bad-typespec-type c)
-+ (format-error "bad typespec `~A ~A': ~A"
-+ (type c) (typespec-options c) (bad-typespec-message c)))
-+ (else
-+ (format-error "bad typespec `~A': ~A" (bad-typespec-form c)
-+ (bad-typespec-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)
-+ (name-conflict-message c)))
-+ (else
-+ (format-error "unhandled error condition: ~A" c))))
-+
-+
-+\f
- ;;;
-
- ;; An <gw-item> is "something" that shows up in the generated
-@@ -202,31 +217,38 @@
- (symbol->string
- (name type))) "_" suffix)))
-
-+\f
-+;;;
-+;;; Raising error conditions
-+;;;
-+
- ;; Here because needs <gw-type>
- (define-method (raise-bad-typespec type (options <list>) (msg <string>) . args)
- (raise (condition
- (&gw-bad-typespec
-- (type type) (options options)
-+ (spec #f) (type type) (options options)
- (message (apply format #f msg args))))))
-
- (define-method (raise-bad-typespec spec (msg <string>) . args)
- (raise (condition
- (&gw-bad-typespec
-- (spec spec)
-+ (spec spec) (type #f) (options #f)
- (message (apply format #f msg args))))))
-
- (define-method (raise-bad-typespec-option option (msg <string>) . args)
- (raise (condition
- (&gw-bad-typespec-option
-- (option option)
-+ (spec #f) (type #f) (option option)
- (message (apply format #f msg args))))))
-
--(define-method (raise-stacked (next &condition) (msg <string>) . args)
-+(define-method (raise-stacked next (msg <string>) . args)
-+ ;; NEXT should be a condition.
- (raise (condition
- (&gw-stacked
- (next next)
- (message (apply format #f msg args))))))
--
-+
-+\f
- ;;;
- ;;; Values
- ;;;
-@@ -367,10 +389,10 @@
- (check-typespec-options type options)
- (guard
- (c
-- ((is-a? c &gw-bad-typespec-option)
-+ ((condition-has-type? c &gw-bad-typespec-option)
- (raise-bad-typespec type options "bad typespec option ~S: ~A"
-- (typespec-option c)
-- (condition-message c))))
-+ (bad-typespec-option c)
-+ (bad-typespec-message c))))
- (let ((typespec (make <gw-typespec> #:type type)))
- (for-each (lambda (opt) (parse-typespec-option! typespec type opt))
- options)
-@@ -799,7 +821,7 @@
- (let ((had-error? #f))
- (guard
- (c
-- (#t (handle-condition c)
-+ (#t (gw-handle-condition c)
- (set! had-error? #t)))
- (generate-wrapset lang (get-wrapset lang name) basename))
- (if had-error?
-
-=== modified file g-wrap/util.scm
---- g-wrap/util.scm
-+++ g-wrap/util.scm
-@@ -32,10 +32,14 @@
- #:use-module (srfi srfi-34)
- #:use-module (srfi srfi-35)
- #:use-module (oop goops)
--
-+
-+ ;; XXX: This introduces a circular dependency, but `autoload' allows us to
-+ ;; work around it.
-+ #:autoload (g-wrap) (gw-handle-condition)
-+
- #:export
-- (&gw-bad-element
-- element tree
-+ (&gw-bad-element gw-bad-element-error?
-+ bad-element bad-element-tree
-
- call-with-output-file/cleanup
- slot-push!
-@@ -51,15 +55,16 @@
-
- ;;; Condition stuff
-
--(define-class &gw-bad-element (&error)
-- (element #:getter element)
-- (tree #:getter tree))
-+(define-condition-type &gw-bad-element &error
-+ gw-bad-element-error?
-+ (element bad-element)
-+ (tree bad-element-tree))
-
- (define-macro (guard/handle . body)
- (let ((cond-name (gensym)))
- `(guard
- (,cond-name
-- (else (handle-condition ,cond-name)))
-+ (else (gw-handle-condition ,cond-name)))
- ,@body)))
-
- ;;; General utilities
-@@ -77,7 +82,7 @@
- (c
- ((condition-has-type? c &error)
- (set! had-errors? #t)
-- (handle-condition c)))
-+ (gw-handle-condition c)))
-
- (call-with-output-file file-name proc)))
-
-
-=== modified file scheme48/g-wrap/scheme48.scm
---- scheme48/g-wrap/scheme48.scm
-+++ scheme48/g-wrap/scheme48.scm
-@@ -240,7 +240,7 @@
- (basedir (dirname filename)))
- (guard
- (c
-- (#t (handle-condition c)
-+ (#t (gw-handle-condition c)
- (set! had-error? #t)))
- (let ((wrapsets (map (lambda (name) (get-wrapset 'scheme48 name)) ws-names)))
- (call-with-output-file/cleanup filename
-
-=== modified directory // last-changed:address@hidden
-... 78u
-# revision id: address@hidden
-# sha1: a24de442febbd27e80362272657453807bcdbbff
-# inventory sha1: 5c6c33a5e2bf2627ed7c2c582d96daa3ccda72a3
-# parent ids:
-# address@hidden
-# base id: address@hidden
-# properties:
-# branch-nick: g-wrap
-
-# 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
- 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'.
-
-=== 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
projects / packages / g-wrap.git / commitdiff