|
|
@ -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)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|