84 lines
2.3 KiB
Scheme
84 lines
2.3 KiB
Scheme
(define (implementation-name)
|
|
(cond-expand
|
|
(capyscheme "capyscheme")
|
|
(chezscheme "chezscheme")
|
|
(chibi "chibi")
|
|
(chicken "chicken")
|
|
(cyclone "cyclone")
|
|
(foment "foment")
|
|
(gambit "gambit")
|
|
(gauche "gauche")
|
|
(guile "guile")
|
|
(ikarus "ikarus")
|
|
(ironscheme "ironscheme")
|
|
(kawa "kawa")
|
|
(larceny "larceny")
|
|
(loko "loko")
|
|
(meevax "meevax")
|
|
(mit "mit-scheme")
|
|
(mosh "mosh")
|
|
(racket "racket")
|
|
(sagittarius "sagittarius")
|
|
(stklos "stklos")
|
|
(tr7 "tr7")
|
|
(ypsilon "ypsilon")
|
|
(else #f)))
|
|
|
|
(define (implementation-version)
|
|
(let ((version-list
|
|
(cond-expand
|
|
(capyscheme
|
|
(list-ref
|
|
(shell->list ("capy --help | head -n1 | tr ' ' '\n'"))
|
|
1))
|
|
(chezscheme (shell->list "chezscheme --version"))
|
|
(chibi (shell->list "chibi-scheme -V | tr ' ' '\n'") 2)
|
|
(chicken (cdr (shell->list "csc -version | grep Version | tr ' ' '\n'")))
|
|
(cyclone (cdr (reverse (shell->list "cyclone -v | grep Version | tr ' ' '\n'"))))
|
|
(foment "foment")
|
|
(gambit "gambit")
|
|
(gauche (cdr (shell->sexp "gosh -V | grep \"(version\"")))
|
|
(guile "guile")
|
|
(ikarus "ikarus")
|
|
(ironscheme "ironscheme")
|
|
(kawa "kawa")
|
|
(larceny "larceny")
|
|
(loko "loko")
|
|
(meevax "meevax")
|
|
(mit "mit-scheme")
|
|
(mosh "mosh")
|
|
(racket "racket")
|
|
(sagittarius "sagittarius")
|
|
(stklos "stklos")
|
|
(tr7 "tr7")
|
|
(ypsilon "ypsilon")
|
|
(else #f))))
|
|
(if (and (shell-exit-code)
|
|
(= (shell-exit-code) 0))
|
|
(car version-list)
|
|
#f)))
|
|
|
|
(define (cpu-architecture)
|
|
(let ((arch (shell->list "uname --machine")))
|
|
(if (= (shell-exit-code) 0)
|
|
(car arch)
|
|
#f)))
|
|
|
|
(define (machine-name)
|
|
(let ((name (shell->list "uname --nodename")))
|
|
(if (= (shell-exit-code) 0)
|
|
(car name)
|
|
#f)))
|
|
|
|
(define (os-name)
|
|
(let ((name (shell->list "uname --sysname")))
|
|
(if (= (shell-exit-code) 0)
|
|
(car name)
|
|
#f)))
|
|
|
|
(define (os-version)
|
|
(let ((version-list (shell->list "uname --kernel-version | tr ' ' '\n'")))
|
|
(if (= (shell-exit-code) 0)
|
|
(list-ref (reverse version-list) 1)
|
|
#f)))
|