From 8007ec59d29ad1ff11f106d2b8397916b9c30bf7 Mon Sep 17 00:00:00 2001
From: Jacob Matthews <jacobm@cs.uchicago.edu>
Date: Tue, 20 Nov 2007 19:59:44 +0000
Subject: [PATCH] committing sam th's fix

svn: r7788
---
 collects/planet/lang/reader.ss | 41 +++++++++++++++++++++++++---------
 1 file changed, 30 insertions(+), 11 deletions(-)

diff --git a/collects/planet/lang/reader.ss b/collects/planet/lang/reader.ss
index 1b628bd780..10429bf788 100644
--- a/collects/planet/lang/reader.ss
+++ b/collects/planet/lang/reader.ss
@@ -17,14 +17,33 @@
           (raise-syntax-error 'read "bad min"))
         (unless (or maj (not min))
           (raise-syntax-error 'read "bad version number pair"))
-        (spec->read-data
-         `(planet "lang/reader.ss"
-                  (,owner
-                   ,pkgname
-                   ,@(if maj `(,maj) '())
-                   ,@(if min `(,min) '()))))))))
-         
-(define (planet-read in) 
-  (planet-read-fn in (λ (spec) ((dynamic-require spec 'read) in)))) 
-(define (planet-read-syntax srcname in) 
-  (planet-read-fn in (λ (spec) ((dynamic-require spec 'read-syntax) srcname in))))
\ No newline at end of file
+        (values 
+         `(planet "lang/main.ss"
+                   (,owner
+                    ,pkgname
+                    ,@(if maj `(,maj) '())
+                    ,@(if min `(,min) '())))
+         (spec->read-data
+          `(planet "lang/reader.ss"
+                   (,owner
+                    ,pkgname
+                    ,@(if maj `(,maj) '())
+                    ,@(if min `(,min) '())))))))))
+
+(define (wrap port spec body)
+    (let* ([p-name (object-name port)]
+	   [name (if (path? p-name)
+		     (let-values ([(base name dir?) (split-path p-name)])
+		       (string->symbol (path->string (path-replace-suffix name #""))))
+		     'page)]
+           [id 'doc])
+      `(module ,name ,spec
+         ,body)))         
+
+(define (planet-read [inp (current-input-port)])
+  (define-values (spec r) (planet-read-fn inp (λ (spec) (dynamic-require spec 'read))))
+  (wrap inp spec (r inp)))
+
+(define (planet-read-syntax [src #f] [port (current-input-port)])
+  (define-values (spec r) (planet-read-fn port (λ (spec) (dynamic-require spec 'read-syntax))))
+  (wrap port spec (r src port)))
\ No newline at end of file