2003-11-28 10:41:39 -05:00
|
|
|
(define-structure configure (export host)
|
2003-11-30 15:50:50 -05:00
|
|
|
(open scheme-with-scsh
|
|
|
|
|
srfi-13)
|
2003-11-28 10:41:39 -05:00
|
|
|
(begin
|
|
|
|
|
(define (canonical-machine uname-record)
|
|
|
|
|
(let* ((machine (uname:machine uname-record))
|
|
|
|
|
(os (uname:os-name uname-record)))
|
2003-11-30 15:50:50 -05:00
|
|
|
(cond
|
|
|
|
|
((member machine '("i386" "i486" "i586" "i686")) "i386")
|
|
|
|
|
((or (string=? machine "Power Macintosh")
|
|
|
|
|
(and (string=? os "AIX")
|
|
|
|
|
(regexp-search? (rx (: "00" (= 6 digit) any any "00"))
|
|
|
|
|
machine)))
|
|
|
|
|
"powerpc")
|
|
|
|
|
(else machine))))
|
2003-11-28 10:41:39 -05:00
|
|
|
|
|
|
|
|
(define (canonical-os-name uname-record)
|
2003-11-30 15:50:50 -05:00
|
|
|
(string-downcase (uname:os-name uname-record)))
|
|
|
|
|
|
2003-11-28 10:41:39 -05:00
|
|
|
(define (host)
|
|
|
|
|
(let ((uname-record (uname)))
|
|
|
|
|
(string-append (canonical-machine uname-record)
|
|
|
|
|
"-"
|
|
|
|
|
(canonical-os-name uname-record))))))
|
