/usr/share/racket/collects/dynext/file.rkt is in racket-common 6.1-4.
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 | #lang racket/base
(provide append-zo-suffix
append-c-suffix
append-constant-pool-suffix
append-object-suffix
append-extension-suffix
extract-base-filename/ss
extract-base-filename/c
extract-base-filename/kp
extract-base-filename/o
extract-base-filename/ext)
(define (append-zo-suffix s)
(path-add-suffix s #".zo"))
(define (append-c-suffix s)
(path-add-suffix s #".c"))
(define (append-constant-pool-suffix s)
(path-add-suffix s #".kp"))
(define (append-object-suffix s)
(path-add-suffix s (case (system-type)
[(unix macosx) #".o"]
[(windows) #".obj"])))
(define (append-extension-suffix s)
(path-add-suffix s (system-type 'so-suffix)))
(define (extract-suffix appender)
(subbytes (path->bytes (appender (bytes->path #"x"))) 1))
(define-values (extract-base-filename/ss
extract-base-filename/c
extract-base-filename/kp
extract-base-filename/o
extract-base-filename/ext)
(let ([mk
(lambda (who pat kind simple)
(define (extract-base-filename s [p #f])
(define rx
(byte-pregexp (bytes-append #"^(.*)\\.(?i:" pat #")$")))
(unless (path-string? s)
(raise-type-error who "path or valid-path string" s))
(cond [(regexp-match
rx (path->bytes (if (path? s) s (string->path s))))
=> (lambda (m) (bytes->path (cadr m)))]
[p (if simple
(error p "not a ~a filename (doesn't end with ~a): ~a"
kind simple s)
(path-replace-suffix s #""))]
[else #f]))
extract-base-filename)])
(values
(mk 'extract-base-filename/ss #"rkt|ss|scm" "Racket" #f)
(mk 'extract-base-filename/c
#"c|cc|cxx|cpp|c[+][+]|m" "C" ".c, .cc, .cxx, .cpp, .c++, or .m")
(mk 'extract-base-filename/kp #"kp" "constant pool" ".kp")
(mk 'extract-base-filename/o
(case (system-type)
[(unix beos macos macosx) #"o"]
[(windows) #"obj"])
"compiled object"
(extract-suffix append-object-suffix))
(mk 'extract-base-filename/ext
(regexp-quote (subbytes (system-type 'so-suffix) 1) #f)
"Racket extension"
(extract-suffix append-extension-suffix)))))
|