remove dependency on current-contract-region

lang/inner-lang-helper.rkt

@@ -1,9 +1,7 @@
 #lang racket/base
 (require (for-syntax racket/base))
 
-(require racket/contract/region)
-
-(provide (all-defined-out) (all-from-out racket/contract/region))
+(provide (all-defined-out))
 
 ;; A place to stash functions that don't change between compiles of Pollen files.
 
@@ -44,22 +42,45 @@
 (define-syntax (require-project-require-files stx)
   (do-project-require-file-syntax stx))
 
-(define-syntax (get-here-path stx)
-  (datum->syntax stx 
-                 '(begin 
-                    ;; This macro might be used in an expression context, 
-                    ;; so we use let, not define.
-                    (let* ([ccr (current-contract-region)] ; trick for getting current module name
-                           [here-path (cond
-                                        ;; if contract-region is called from within submodule,
-                                        ;; you get a list
-                                        ;; in which case, just grab the path from the front
-                                        [(list? ccr) (car ccr)]
-                                        ;; file isn't yet saved in drracket
-                                        ;; 'pollen-lang-module name is applied by reader
-                                        [(equal? 'pollen-lang-module ccr) 'nowhere] 
-                                        [else ccr])])
-                      (path->string here-path)))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;
+; Copied out from racket/contract/private/base for speed
+; Used to be called current-contract-region
+; Importing racket/contract/region is slow
+;
+
+(require racket/stxparam syntax/location)
+
+(define-syntax-parameter current-file-path
+  (λ (stx)
+    (if (eq? (syntax-local-context) 'expression)
+        (let* ([ctxt (syntax-local-lift-context)]
+               [id (hash-ref (make-hasheq) ctxt #f)])
+          (with-syntax ([id (or id
+                                (let ([id (syntax-local-lift-expression 
+                                           (syntax/loc stx (quote-module-name)))])
+                                  (hash-set! (make-hasheq) ctxt (syntax-local-introduce id))
+                                  id))])
+            #'id))
+        (quasisyntax/loc stx (#%expression #,stx)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define-syntax (get-here-path stx)
+  #'(begin 
+      (let* ([cfp (current-file-path)]
+             [here-path (cond
+                          ;; file isn't yet saved in drracket
+                          ;; 'pollen-lang-module name is applied by reader
+                          [(or (equal? 'pollen-lang-module cfp)
+                               (and (list? cfp) (equal? (car cfp) 'pollen-lang-module)))
+                           "unsaved-file"]
+                          ;; if current-file-path is called from within submodule, you get a list
+                          ;; in which case, just grab the path from the front
+                          [(list? cfp) (path->string (car cfp))]
+                          [else (path->string cfp)])])
+        here-path)))