/usr/share/racket/collects/compiler/compilation-path.rkt is in racket-common 6.3-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | #lang racket/base
(provide get-compilation-dir+name
get-compilation-dir
get-compilation-bytecode-file)
(define (do-get-compilation-dir+name who path modes roots)
;; Check arguments
(unless (path-string? path)
(raise-argument-error who "path-string?" path))
(unless (and (list? modes)
(pair? modes)
(andmap (lambda (p)
(and (path-string? p)
(relative-path? p)))
modes))
(raise-argument-error who "(non-empty-listof (and/c path-string? relative-path?))" modes))
(unless (and (list? roots)
(pair? roots)
(andmap (lambda (p)
(or (path-string? p) (eq? p 'same)))
roots))
(raise-argument-error who "(non-empty-listof (or/c path-string? 'same))" roots))
;; Function to try one combination:
(define (get-one mode root)
(let-values ([(base name must-be-dir?) (split-path path)])
(values
(cond
[(eq? 'relative base)
(cond
[(eq? root 'same) mode]
[else (build-path root mode)])]
[else (build-path (cond
[(eq? root 'same) base]
[(relative-path? root) (build-path base root)]
[else (reroot-path base root)])
mode)])
name)))
;; Try first root:
(define-values (p n) (get-one (car modes) (car roots)))
(if (or (and (null? (cdr roots))
(null? (cdr modes)))
(file-exists? (path-add-suffix (build-path p n) #".zo")))
;; Only root or first has a ".zo" file:
(values p n)
(let loop ([roots (cdr roots)])
(cond
[(null? roots)
;; No roots worked, so assume the first mode + root:
(values p n)]
[else
;; Check next root:
(let mloop ([modes modes])
(cond
[(null? modes) (loop (cdr roots))]
[else
(define-values (p n) (get-one (car modes) (car roots)))
(if (file-exists? (path-add-suffix (build-path p n) #".zo"))
(values p n)
(mloop (cdr modes)))]))]))))
(define (get-compilation-dir+name path
#:modes [modes (use-compiled-file-paths)]
#:roots [roots (current-compiled-file-roots)])
(do-get-compilation-dir+name 'get-compilation-dir+name path modes roots))
(define (get-compilation-dir path
#:modes [modes (use-compiled-file-paths)]
#:roots [roots (current-compiled-file-roots)])
(let-values ([(dir name) (do-get-compilation-dir+name 'get-compilation-dir path modes roots)])
dir))
(define (get-compilation-bytecode-file path
#:modes [modes (use-compiled-file-paths)]
#:roots [roots (current-compiled-file-roots)])
(let-values ([(dir name) (do-get-compilation-dir+name 'get-compilation-bytecode-file path modes roots)])
(build-path dir (path-add-suffix name #".zo"))))
|