scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Sanitize Olin's atrocious 2-line IF.

This commit is contained in:
sperber 2003-04-16 13:01:32 +00:00
parent 3c3c539446
commit a6978187ba
1 changed files with 18 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
scsh/fname.scm
View File

@ -20,7 +20,8 @@
(not (char=? #\/ (string-ref fname (- (string-length fname) 1)))))) (not (char=? #\/ (string-ref fname (- (string-length fname) 1))))))
(define (file-name-as-directory fname) (define (file-name-as-directory fname)
(if (string=? fname ".") "" (if (string=? fname ".")
""
(let ((len (string-length fname))) (let ((len (string-length fname)))
(if (and (> len 0) (if (and (> len 0)
(char=? #\/ (string-ref fname (- len 1)))) (char=? #\/ (string-ref fname (- len 1))))
@ -38,12 +39,13 @@
(define (directory-as-file-name fname) (define (directory-as-file-name fname)
(let ((len (string-length fname))) (let ((len (string-length fname)))
(if (zero? len) "." ; "" -> "." (if (zero? len)
"." ; "" -> "."
;; Trim trailing slashes. ;; Trim trailing slashes.
(cond ((last-non-slash fname) => (cond ((last-non-slash fname) =>
(lambda (i) (lambda (i)
(if (= i (- len 1)) fname ; No slash. (if (= i (- len 1))
fname ; No slash.
(substring fname 0 (+ i 1))))) ; Trim slashes. (substring fname 0 (+ i 1))))) ; Trim slashes.
;;; Solid slashes -- invoke weird Posix rule. ;;; Solid slashes -- invoke weird Posix rule.
@ -51,12 +53,14 @@
(define (ensure-file-name-is-directory fname) (define (ensure-file-name-is-directory fname)
(if (string=? fname "") "" (if (string=? fname "")
""
(file-name-as-directory fname))) (file-name-as-directory fname)))
(define (ensure-file-name-is-nondirectory fname) (define (ensure-file-name-is-nondirectory fname)
(if (string=? fname "") "" (if (string=? fname "")
""
(directory-as-file-name fname))) (directory-as-file-name fname)))
@ -166,7 +170,8 @@
(define (resolve-file-name fname . maybe-root) (define (resolve-file-name fname . maybe-root)
(let* ((root (ensure-file-name-is-nondirectory (:optional maybe-root "."))) (let* ((root (ensure-file-name-is-nondirectory (:optional maybe-root ".")))
(fname (ensure-file-name-is-nondirectory fname))) (fname (ensure-file-name-is-nondirectory fname)))
(if (zero? (string-length fname)) "/" (if (zero? (string-length fname))
"/"
(let ((c (string-ref fname 0))) (let ((c (string-ref fname 0)))
(cond ((char=? #\/ c) fname) ; Absolute file name. (cond ((char=? #\/ c) fname) ; Absolute file name.
@ -225,9 +230,11 @@
(define (absolute-file-name fname . maybe-root) (define (absolute-file-name fname . maybe-root)
(let ((fname (ensure-file-name-is-nondirectory fname))) (let ((fname (ensure-file-name-is-nondirectory fname)))
(if (zero? (string-length fname)) "/" (if (zero? (string-length fname))
"/"
(simplify-file-name (simplify-file-name
(if (char=? #\/ (string-ref fname 0)) fname ; Absolute file name. (if (char=? #\/ (string-ref fname 0))
fname ; Absolute file name.
(let ((root (:optional maybe-root (cwd)))) (let ((root (:optional maybe-root (cwd))))
(string-append (file-name-as-directory root) fname))))))) (string-append (file-name-as-directory root) fname)))))))
@ -263,7 +270,8 @@
(let ((ans (cons (substring s 0 i) ans)) (let ((ans (cons (substring s 0 i) ans))
(s (substring s (+ i 1) len)) (s (substring s (+ i 1) len))
(len (- len (+ i 1)))) (len (- len (+ i 1))))
(if (zero? len) (lp ans "") (if (zero? len)
(lp ans "")
(let ((next-char (string-ref s 0))) (let ((next-char (string-ref s 0)))
(cond ((char=? #\{ next-char) (cond ((char=? #\{ next-char)
(cond ((string-index s #\}) => (cond ((string-index s #\}) =>