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