diff --git a/lang/inner-lang-helper.rkt b/lang/inner-lang-helper.rkt index a7275de..fb42538 100644 --- a/lang/inner-lang-helper.rkt +++ b/lang/inner-lang-helper.rkt @@ -45,11 +45,10 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; -; Copied out from racket/contract/private/base for speed -; Used to be called current-contract-region +; Copied out from racket/contract/private/base to avoid import ; Importing racket/contract/region is slow +; Used to be called current-contract-region ; - (require racket/stxparam syntax/location) (define-syntax-parameter current-file-path @@ -64,10 +63,66 @@ id))]) #'id)) (quasisyntax/loc stx (#%expression #,stx))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; +; Copied out from racket/path to avoid import +; +(define (find-relative-path directory filename #:more-than-root? [more-than-root? #f]) + + (define (do-explode-path who orig-path) + (define l (explode-path orig-path)) + (for ([p (in-list l)]) + (when (not (path-for-some-system? p)) + (raise-argument-error who + "(and/c path-for-some-system? simple-form?)" + orig-path))) + l) + + (let ([dir (do-explode-path 'find-relative-path directory)] + [file (do-explode-path 'find-relative-path filename)]) + (if (and (equal? (car dir) (car file)) + (or (not more-than-root?) + (not (eq? 'unix (path-convention-type directory))) + (null? (cdr dir)) + (null? (cdr file)) + (equal? (cadr dir) (cadr file)))) + (let loop ([dir (cdr dir)] + [file (cdr file)]) + (cond [(null? dir) (if (null? file) filename (apply build-path file))] + [(null? file) (apply build-path/convention-type + (path-convention-type filename) + (map (lambda (x) 'up) dir))] + [(equal? (car dir) (car file)) + (loop (cdr dir) (cdr file))] + [else + (apply build-path (append (map (lambda (x) 'up) dir) file))])) + filename))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; +; Copied out from racket/list to avoid import +; +(define (filter-not f list) + (unless (and (procedure? f) + (procedure-arity-includes? f 1)) + (raise-argument-error 'filter-not "(any/c . -> . any/c)" 0 f list)) + (unless (list? list) + (raise-argument-error 'filter-not "list?" 1 f list)) + ;; accumulating the result and reversing it is currently slightly + ;; faster than a plain loop + (let loop ([l list] [result null]) + (if (null? l) + (reverse result) + (loop (cdr l) (if (f (car l)) result (cons (car l) result)))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define-syntax (get-here-path stx) #'(begin (let* ([cfp (current-file-path)] diff --git a/main.rkt b/main.rkt index eb9c8ea..b3ec0d1 100644 --- a/main.rkt +++ b/main.rkt @@ -19,9 +19,11 @@ (require pollen/top) (provide (all-from-out pollen/top)) + ;; Get project values + (require pollen/world) + (provide (all-from-out pollen/world)) + ;; Build 'inner-here-path and 'inner-here - (require (only-in racket/path find-relative-path)) - (require (only-in pollen/world PROJECT_ROOT)) (define (here-path->here here-path) (path->string (path-replace-suffix (find-relative-path PROJECT_ROOT here-path) ""))) (define inner-here-path (get-here-path)) @@ -34,9 +36,6 @@ (require 'inner) ;; Split out the metas. - (require (only-in racket/path find-relative-path)) - (require (only-in pollen/world PROJECT_ROOT)) - (require txexpr) (define (split-metas-to-hash tx) ;; return tx without metas, and meta hash @@ -56,11 +55,9 @@ ;; set up the 'main export - (require pollen/decode pollen/world) - (require (only-in racket/list filter-not)) + (require pollen/decode) (define here-ext (car (regexp-match #px"\\w+$" inner-here-path))) (define wants-decoder? (member here-ext (map to-string DECODABLE_EXTENSIONS))) - ;(print (cdr main-without-metas)) (define main (apply (cond [(equal? here-ext "ptree") (λ xs (decode (cons 'ptree-root xs) #:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))]