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

- use "cond" instead of "case" in "canonical-machine", 

- downcase OS name in "canonical-os-name".
This commit is contained in:
michel-schinz 2003-11-30 20:50:50 +00:00
parent a8b0bdd72a
commit b8ddec939b
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
scheme/configure.scm
View File

@ -1,24 +1,24 @@
(define-structure configure (export host) (define-structure configure (export host)
(open scheme-with-scsh) (open scheme-with-scsh
srfi-13)
(begin (begin
(define (canonical-machine uname-record) (define (canonical-machine uname-record)
(let* ((machine (uname:machine uname-record)) (let* ((machine (uname:machine uname-record))
(os (uname:os-name uname-record))) (os (uname:os-name uname-record)))
(case machine (cond
(("i386" "i486" "i586" "i686") "i386") ((member machine '("i386" "i486" "i586" "i686")) "i386")
(("Power Machintosh") "powerpc") ((or (string=? machine "Power Macintosh")
(else (cond ((and (string=? os "AIX") (and (string=? os "AIX")
(regexp-search? (rx (: "00" (= 6 digit) any any "00")) machine)) (regexp-search? (rx (: "00" (= 6 digit) any any "00"))
"powerpc") machine)))
(else machine)))))) "powerpc")
(else machine))))
(define (canonical-os-name uname-record) (define (canonical-os-name uname-record)
(uname:os-name uname-record)) (string-downcase (uname:os-name uname-record)))
(define (host) (define (host)
(let ((uname-record (uname))) (let ((uname-record (uname)))
(string-append (canonical-machine uname-record) (string-append (canonical-machine uname-record)
"-" "-"
(canonical-os-name uname-record)))))) (canonical-os-name uname-record))))))