path rewriter knows about main js-sicp project path
This commit is contained in:
parent
9988201d06
commit
db302a1b0c
|
@ -2,7 +2,8 @@
|
||||||
|
|
||||||
(require racket/path
|
(require racket/path
|
||||||
racket/contract
|
racket/contract
|
||||||
racket/list)
|
racket/list
|
||||||
|
racket/runtime-path)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -13,8 +14,15 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(define-runtime-path this-path ".")
|
||||||
|
(define this-normal-path
|
||||||
|
(let ()
|
||||||
|
(normalize-path this-path)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define current-root-path
|
(define current-root-path
|
||||||
(make-parameter (current-directory)))
|
(make-parameter (normalize-path (current-directory))))
|
||||||
|
|
||||||
|
|
||||||
;; The path rewriter takes paths and provides a canonical symbol for it.
|
;; The path rewriter takes paths and provides a canonical symbol for it.
|
||||||
|
@ -25,16 +33,21 @@
|
||||||
(define (rewrite-path a-path)
|
(define (rewrite-path a-path)
|
||||||
(let ([a-path (normalize-path a-path)])
|
(let ([a-path (normalize-path a-path)])
|
||||||
(cond
|
(cond
|
||||||
[(within-collects? a-path)
|
|
||||||
(string->symbol
|
|
||||||
(string-append "collects/"
|
|
||||||
(path->string
|
|
||||||
(find-relative-path collects a-path))))]
|
|
||||||
[(within-root? a-path)
|
[(within-root? a-path)
|
||||||
(string->symbol
|
(string->symbol
|
||||||
(string-append "root/"
|
(string-append "root/"
|
||||||
(path->string
|
(path->string
|
||||||
(find-relative-path (current-root-path) a-path))))]
|
(find-relative-path (current-root-path) a-path))))]
|
||||||
|
[(within-collects? a-path)
|
||||||
|
(string->symbol
|
||||||
|
(string-append "collects/"
|
||||||
|
(path->string
|
||||||
|
(find-relative-path collects a-path))))]
|
||||||
|
[(within-this-project-path? a-path)
|
||||||
|
(string->symbol
|
||||||
|
(string-append "js-vm/"
|
||||||
|
(path->string
|
||||||
|
(find-relative-path this-normal-path a-path))))]
|
||||||
[else
|
[else
|
||||||
#f])))
|
#f])))
|
||||||
|
|
||||||
|
@ -59,6 +72,10 @@
|
||||||
(within? collects a-path))
|
(within? collects a-path))
|
||||||
|
|
||||||
|
|
||||||
|
(define (within-this-project-path? a-path)
|
||||||
|
(within? this-normal-path a-path))
|
||||||
|
|
||||||
|
|
||||||
;; within?: normalized-path normalized-path -> boolean
|
;; within?: normalized-path normalized-path -> boolean
|
||||||
;; Produces true if a-path is within the base.
|
;; Produces true if a-path is within the base.
|
||||||
(define (within? base a-path)
|
(define (within? base a-path)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user