Add unparser methods for HTTP datatypes.

diff --git a/v7/src/runtime/http-syntax.scm b/v7/src/runtime/http-syntax.scm
index e4e03a2e61664ded78a282ace4c3082df6b728f1..933f2213dcc615862f71041cabaf75d63585cd58 100644 (file)
--- a/v7/src/runtime/http-syntax.scm
+++ b/v7/src/runtime/http-syntax.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: http-syntax.scm,v 1.3 2008/09/21 07:35:03 cph Exp $
+$Id: http-syntax.scm,v 1.4 2008/09/21 22:20:14 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -103,6 +103,11 @@ USA.
 
 (define-guarantee http-header "HTTP header field")
 
+(set-record-type-unparser-method! <http-header>
+  (simple-unparser-method 'HTTP-HEADER
+    (lambda (header)
+      (list (http-header-name header)))))
+
 (define (make-http-header name value)
   (guarantee-http-token name 'MAKE-HTTP-HEADER)
   (let ((defn (header-value-defn name)))

diff --git a/v7/src/runtime/httpio.scm b/v7/src/runtime/httpio.scm
index 78a6bcfb3c2796abbf112a0e8062fff2f7aec119..e5b0c119f97818b107cabe2c14ee0cdd1ffab301 100644 (file)
--- a/v7/src/runtime/httpio.scm
+++ b/v7/src/runtime/httpio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: httpio.scm,v 14.10 2008/09/21 07:35:06 cph Exp $
+$Id: httpio.scm,v 14.11 2008/09/21 22:20:18 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -52,6 +52,12 @@ USA.
       (guarantee-headers&body headers body 'MAKE-HTTP-REQUEST)
     (%make-http-request method uri version headers body)))
 
+(set-record-type-unparser-method! <http-request>
+  (simple-unparser-method 'HTTP-REQUEST
+    (lambda (request)
+      (list (http-request-method request)
+           (http-request-uri request)))))
+
 (define-record-type <http-response>
     (%make-http-response version status reason headers body)
     http-response?
@@ -71,6 +77,11 @@ USA.
       (guarantee-headers&body headers body 'MAKE-HTTP-RESPONSE)
     (%make-http-response version status reason headers body)))
 
+(set-record-type-unparser-method! <http-response>
+  (simple-unparser-method 'HTTP-RESPONSE
+    (lambda (response)
+      (list (http-response-status response)))))
+
 (define (guarantee-headers&body headers body caller)
   (guarantee-http-headers headers caller)
   (if body