From 00bacaeb3c348ff38d745b022a1d35419551a749 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 21 Feb 2014 12:40:28 -0800 Subject: [PATCH] remove dependency on current-contract-region --- lang/inner-lang-helper.rkt | 59 ++++++++++++++++++++++++++------------ 1 file changed, 40 insertions(+), 19 deletions(-) diff --git a/lang/inner-lang-helper.rkt b/lang/inner-lang-helper.rkt index 551d5af..a7275de 100644 --- a/lang/inner-lang-helper.rkt +++ b/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)))