From db302a1b0c6968119ea645690f43230cd6139816 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Fri, 13 May 2011 15:43:44 -0400 Subject: [PATCH] path rewriter knows about main js-sicp project path --- path-rewriter.rkt | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/path-rewriter.rkt b/path-rewriter.rkt index 8195dff..48c2239 100644 --- a/path-rewriter.rkt +++ b/path-rewriter.rkt @@ -2,7 +2,8 @@ (require racket/path 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 - (make-parameter (current-directory))) + (make-parameter (normalize-path (current-directory)))) ;; The path rewriter takes paths and provides a canonical symbol for it. @@ -25,16 +33,21 @@ (define (rewrite-path a-path) (let ([a-path (normalize-path a-path)]) (cond - [(within-collects? a-path) - (string->symbol - (string-append "collects/" - (path->string - (find-relative-path collects a-path))))] [(within-root? a-path) (string->symbol (string-append "root/" (path->string (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 #f]))) @@ -59,6 +72,10 @@ (within? collects a-path)) +(define (within-this-project-path? a-path) + (within? this-normal-path a-path)) + + ;; within?: normalized-path normalized-path -> boolean ;; Produces true if a-path is within the base. (define (within? base a-path)