From fb74476915ed15a61effe0c7d6398ec79a2828e6 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 10 Dec 2007 16:13:25 +0000
Subject: [PATCH] change 'include' and 'include-bitmap' to better match normal
 module-path syntax

svn: r7936

original commit: eab8008c4f62d8561c57d8642860f0c5061ddbc7
---
 collects/mzlib/include.ss | 67 +++++++++++++++++++++++++++++++++++----
 1 file changed, 61 insertions(+), 6 deletions(-)

diff --git a/collects/mzlib/include.ss b/collects/mzlib/include.ss
index 26a3257..d760b43 100644
--- a/collects/mzlib/include.ss
+++ b/collects/mzlib/include.ss
@@ -1,11 +1,71 @@
 
 (module include mzscheme
   (require-for-syntax (lib "stx.ss" "syntax")
-		      (lib "path-spec.ss" "syntax")
 		      "private/increader.ss"
 		      "cm-accomplice.ss")
   (require (lib "etc.ss"))
 
+  (define-for-syntax (resolve-path-spec fn loc stx build-path-stx)
+    (let ([file
+	   (syntax-case* fn (lib) module-or-top-identifier=?
+	     [_
+	      (string? (syntax-e fn))
+	      (let ([s (syntax-e fn)])
+		(unless (or (relative-path? s)
+			    (absolute-path? s))
+		  (raise-syntax-error
+		   #f
+		   "bad pathname string"
+		   stx
+		   fn))
+		(string->path s))]
+	     [(-build-path elem ...)
+	      (module-or-top-identifier=? #'-build-path build-path-stx)
+	      (let ([l (syntax-object->datum (syntax (elem ...)))])
+		(when (null? l)
+		  (raise-syntax-error
+		   #f
+		   "`build-path' keyword is not followed by at least one string"
+		   stx
+		   fn))
+		(apply build-path l))]
+	     [(lib filename ...)
+	      (let ([l (syntax-object->datum (syntax (filename ...)))])
+		(unless (or (andmap string? l)
+			    (pair? l))
+		  (raise-syntax-error
+		   #f
+		   "`lib' keyword is not followed by a sequence of string datums"
+		   stx
+		   fn))
+		(build-path (if (null? (cdr l))
+				(collection-path "mzlib")
+				(apply collection-path (cdr l)))
+			    (car l)))]
+	     [else
+	      (raise-syntax-error
+	       #f
+	       "not a pathname string, `build-path' form, or `lib' form for file"
+	       stx
+	       fn)])])
+      (if (complete-path? file)
+	  file
+	  (path->complete-path
+	   file
+	   (cond
+	    ;; Src of include expression is a path?
+	    [(and (path? (syntax-source loc))
+		  (complete-path? (syntax-source loc)))
+	     (let-values ([(base name dir?) 
+			   (split-path (syntax-source loc))])
+	       (if dir?
+		   (syntax-source loc)
+		   base))]
+	    ;; Load relative?
+	    [(current-load-relative-directory)]
+	    ;; Current directory
+	    [(current-directory)])))))
+
   (define-syntax-set (do-include ; private
 		      include-at/relative-to
 		      include
@@ -143,8 +203,3 @@
 	   include-at/relative-to
 	   include/reader
 	   include-at/relative-to/reader))
-
-		 
-			   
-	      
-