remove dependency on current-contract-region

pull/9/head
Matthew Butterick 11 years ago
parent 361b184bee
commit 00bacaeb3c

@ -1,9 +1,7 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(require racket/contract/region) (provide (all-defined-out))
(provide (all-defined-out) (all-from-out racket/contract/region))
;; A place to stash functions that don't change between compiles of Pollen files. ;; 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) (define-syntax (require-project-require-files stx)
(do-project-require-file-syntax stx)) (do-project-require-file-syntax stx))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; 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) (define-syntax (get-here-path stx)
(datum->syntax stx #'(begin
'(begin (let* ([cfp (current-file-path)]
;; 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 [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 ;; file isn't yet saved in drracket
;; 'pollen-lang-module name is applied by reader ;; 'pollen-lang-module name is applied by reader
[(equal? 'pollen-lang-module ccr) 'nowhere] [(or (equal? 'pollen-lang-module cfp)
[else ccr])]) (and (list? cfp) (equal? (car cfp) 'pollen-lang-module)))
(path->string here-path))))) "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)))

Loading…
Cancel
Save