mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-06 17:40:29 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source 
Conflicts:
	module/ice-9/psyntax-pp.scm
This commit is contained in:
Andy Wingo 2012-02-15 23:04:53 +01:00
commit 2988685d84
4 changed files with 8712 additions and 8689 deletions
Download patch file Download diff file Expand all files Collapse all files

17382
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

13
module/ice-9/psyntax.scm
View file

@ -1459,25 +1459,25 @@
s)) s))
((syntax-object? x) ((syntax-object? x)
(let ((w (syntax-object-wrap x))) (let ((w (syntax-object-wrap x)))
(let ((ms (wrap-marks w)) (s (wrap-subst w))) (let ((ms (wrap-marks w)) (ss (wrap-subst w)))
(if (and (pair? ms) (eq? (car ms) the-anti-mark)) (if (and (pair? ms) (eq? (car ms) the-anti-mark))
;; output is from original text ;; output is from original text
(make-syntax-object (make-syntax-object
(syntax-object-expression x) (syntax-object-expression x)
(make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s))) (make-wrap (cdr ms) (if rib (cons rib (cdr ss)) (cdr ss)))
(syntax-object-module x)) (syntax-object-module x))
;; output introduced by macro ;; output introduced by macro
(make-syntax-object (make-syntax-object
(decorate-source (syntax-object-expression x) s) (decorate-source (syntax-object-expression x) s)
(make-wrap (cons m ms) (make-wrap (cons m ms)
(if rib (if rib
(cons rib (cons 'shift s)) (cons rib (cons 'shift ss))
(cons 'shift s))) (cons 'shift ss)))
(syntax-object-module x)))))) (syntax-object-module x))))))
((vector? x) ((vector? x)
(let* ((n (vector-length x)) (let* ((n (vector-length x))
(v (decorate-source (make-vector n) x))) (v (decorate-source (make-vector n) s)))
(do ((i 0 (fx+ i 1))) (do ((i 0 (fx+ i 1)))
((fx= i n) v) ((fx= i n) v)
(vector-set! v i (vector-set! v i
@ -2630,7 +2630,8 @@
who 'syntax-violation) who 'syntax-violation)
(arg-check string? message 'syntax-violation) (arg-check string? message 'syntax-violation)
(throw 'syntax-error who message (throw 'syntax-error who message
(source-annotation (or form subform)) (or (source-annotation subform)
(source-annotation form))
(strip form empty-wrap) (strip form empty-wrap)
(and subform (strip subform empty-wrap))))) (and subform (strip subform empty-wrap)))))

2
module/system/base/message.scm
View file

@ -75,7 +75,7 @@
(printer warning-type-printer)) (printer warning-type-printer))
(define %warning-types (define %warning-types
;; List of know warning types. ;; List of known warning types.
(map (lambda (args) (map (lambda (args)
(apply make-warning-type args)) (apply make-warning-type args))

4
module/web/server.scm
View file

@ -264,7 +264,9 @@ on the procedure being called at any particular time."
(call-with-encoded-output-string charset body)))) (call-with-encoded-output-string charset body))))
((not (bytevector? body)) ((not (bytevector? body))
(error "unexpected body type")) (error "unexpected body type"))
((response-must-not-include-body? response) ((and (response-must-not-include-body? response)
body
(not (zero? (bytevector-length body))))
(error "response with this status code must not include body" response)) (error "response with this status code must not include body" response))
(else (else
;; check length; assert type; add other required fields? ;; check length; assert type; add other required fields?