From 98ae6cb1859542eb08d4f3214ade4e0a9f8d48bc Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Sat, 29 Nov 2003 04:01:29 +0000
Subject: [PATCH] Made `this-expression-source-directory' use setup/plthome if
 the current path is in the plthome tree, so that generated syntax doesn't
 hard-wire a plthome location.  The resulting syntax will use `un-plthome-ify'
 in this case.

original commit: 127a796f8b6f589987f435a5cdba07b7d9551846
---
 collects/mzlib/etc.ss | 43 ++++++++++++++++++++-----------------------
 1 file changed, 20 insertions(+), 23 deletions(-)

diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss
index 3b3e34b..d9f64c3 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.ss
@@ -1,10 +1,12 @@
 
 (module etc mzscheme
-  (require "spidey.ss")
+  (require "spidey.ss"
+           (lib "plthome.ss" "setup"))
   (require-for-syntax (lib "kerncase.ss" "syntax")
 		      (lib "stx.ss" "syntax")
 		      (lib "name.ss" "syntax")
 		      (lib "context.ss" "syntax")
+		      (lib "plthome.ss" "setup")
 		      "private/stxset.ss")
 
   (provide true false
@@ -438,28 +440,23 @@
  (define-syntax (this-expression-source-directory stx)
    (syntax-case stx ()
      [(_)
-      (let ([source (syntax-source stx)]
-	    [local (lambda ()
-		     (let ([s (or (current-load-relative-directory)
-				  (current-directory))])
-		       (datum->syntax-object
-			(quote-syntax 'here)
-			s
-			stx)))])
-	(if (and source
-		 (string? source)
-		 (file-exists? source))
-	    (let-values ([(base file dir?) (split-path source)])
-	      (cond
-	       [(string? base)
-		(with-syntax ([base (path->complete-path 
-				     base
-				     (or (current-load-relative-directory)
-					 (current-directory)))])
-		  (syntax base))]
-	       [else ; must be (eq? base 'relative)
-		(local)]))
-	    (local)))]))
+      (let* ([source (syntax-source stx)]
+	     [local (lambda ()
+		      (or (current-load-relative-directory)
+			  (current-directory)))]
+	     [dir (plthome-ify
+                   (or (and source (string? source) (file-exists? source)
+                            (let-values ([(base file dir?) (split-path source)])
+                              (and (string? base)
+                                   (path->complete-path
+                                    base
+                                    (or (current-load-relative-directory)
+                                        (current-directory))))))
+                       (local)))])
+        (if (and (pair? dir) (eq? 'plthome (car dir)))
+          (with-syntax ([d dir])
+            (syntax (un-plthome-ify 'd)))
+          (datum->syntax-object (quote-syntax here) dir stx)))]))
 
  ;; This is a macro-generating macro that wants to expand
  ;; expressions used in the generated macro. So it's weird,