mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +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))
((syntax-object? 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))
;; output is from original text
(make-syntax-object
(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))
;; output introduced by macro
(make-syntax-object
(decorate-source (syntax-object-expression x) s)
(make-wrap (cons m ms)
(if rib
(cons rib (cons 'shift s))
(cons 'shift s)))
(cons rib (cons 'shift ss))
(cons 'shift ss)))
(syntax-object-module x))))))
((vector? 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)))
((fx= i n) v)
(vector-set! v i
@ -2630,7 +2630,8 @@
who 'syntax-violation)
(arg-check string? message 'syntax-violation)
(throw 'syntax-error who message
(source-annotation (or form subform))
(or (source-annotation subform)
(source-annotation form))
(strip form empty-wrap)
(and subform (strip subform empty-wrap)))))

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

@ -75,7 +75,7 @@
(printer warning-type-printer))
(define %warning-types
;; List of know warning types.
;; List of known warning types.
(map (lambda (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))))
((not (bytevector? body))
(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))
(else
;; check length; assert type; add other required fields?