Skip to content

Instantly share code, notes, and snippets.

@Lattay

Lattay/detect.scm

Created May 6, 2020 14:07
Show Gist options
  • Save Lattay/a12e2868eba22c6ce8beb8c7d8fe3188 to your computer and use it in GitHub Desktop.
Save Lattay/a12e2868eba22c6ce8beb8c7d8fe3188 to your computer and use it in GitHub Desktop.
Download ZIP
RSR5 Scheme implementation detection (May 2020 version)
Raw
detect.scm
;;; Original post http://www.willdonnelly.net/blog/runtime-scheme-detection/
;;; This is an updated version as of May 2020
;;; I updated signatures for most of Scheme and dropped Ikarus (dead project)
;;; I also added chibi-scheme, chez-scheme and replaced mzscheme by racket
;;; DETECT
;;; A set of functions to allow an interpreted Scheme
;;; program to determine the implementation it is
;;; running under.
;; DETECT:SIGNATURE
;; Assemble a signature of the current
;; Scheme implementation.
(define (detect:signature)
(list
;; AXCH: exact-sqrt
(exact? (sqrt 4))
;; AXCH: exact-times-zero
(exact? (* 0 3.1))
;; AXCH: exact-div-zero
(exact? (/ 0 4.7))
;; AXCH: exact-rationals
(exact? (/ 1 3))
;; AXCH: case-sensitive
(eq? 'a 'A)
;; AXCH: promises-are-thunks
(procedure? (delay 3))
;; Do strings made from numbers less than 1 omit the 0?
(string=? ".5" (number->string 0.5))
;; AXCH: literal-rationals
(number? (string->number "1/2"))
;; AXCH: literal-complexes
(number? (string->number "1+i"))
;; Is the empty string eqv to itself?
(eqv? "" "")
;; How about the empty vector?
(eqv? '#() '#())
;; A non-empty string?
(eqv? "a" "a")
;; Does SET! have a constant return value?
(let ((x 0)) (eqv? (set! x 1) (set! x 'asd)))
;; Is it equal to other undefined things?
(eqv? (for-each (lambda (x) #t) '(0 1 2)) (let ((x 123)) (set! x 321)))
;; Are negative and positive inexact zero the same?
(eq? +0.0 -0.0)
(eqv? +0.0 -0.0)
(equal? +0.0 -0.0)
;; Is the default vector filled with zeroes?
(equal? (make-vector 5) '#(0 0 0 0 0))
;; Is the default vector filled with falses?
(equal? (make-vector 5) '#(#f #f #f #f #f))
;; Vector-fill returns a vector?
(vector? (vector-fill! (make-vector 1) 0)) ))
;; DETECT:KNOWN-SIGNATURES
;; A precalculated list of signatures for all supported
;; Scheme implementations.
(define detect:known-signatures
'((racket (#t #t #t #t #f #f #f #t #t #t #f #t #t #t #f #f #f #t #f #f)) ;; 7.5
(chicken (#t #f #f #t #f #f #f #t #t #f #f #f #t #t #f #f #f #f #f #f)) ;; 5.2.0
(guile (#t #f #f #t #f #f #f #t #t #t #t #t #t #t #f #f #f #f #f #f)) ;; 2.2.6
(bigloo (#f #f #f #f #f #t #f #f #f #f #f #f #t #t #f #t #t #f #f #f)) ;; 4.3
(gambit (#t #t #f #t #f #f #t #t #t #f #f #f #t #t #f #f #f #t #f #f)) ;; 4.9
(scheme48 (#f #f #f #t #t #t #f #t #t #t #t #t #t #t #t #t #t #f #f #f)) ;; 1.9.2
(chibi-scheme (#t #t #f #t #f #f #f #t #t #f #t #f #t #t #f #f #f #f #f #f)) ;; 0.8.0
(mit-scheme (#t #t #t #t #t #f #t #t #t #f #f #f #f #f #f #f #f #f #t #f)) ;; 10.1.10
(gauche (#t #t #f #t #f #f #f #t #t #f #f #f #f #f #f #t #t #f #f #f)) ;; 0.9.9
(chez-scheme (#t #t #f #t #f #t #f #t #t #t #t #f #t #f #f #f #f #t #f #f)) ;; 9.5.2
))
;; DETECT:MATCH-SIGNATURE
;; Determine the name of the current Scheme implementation
;; by checking the signature returned by DETECT:SIGNATURE
;; against a table of known signatures.
(define (detect:match-signature)
(let ((signature (detect:signature)))
; Loop over the DETECT:KNOWN-SIGNATURES list
(let test ((siglist detect:known-signatures))
(if (equal? '() siglist)
; Return 'UNKNOWN if we're stumped
'unknown
(let ((testsig (car siglist)))
(if (equal? (cadr testsig) signature)
(car testsig)
(test (cdr siglist))))))))
;; DETECT:NAME
;; Memoized form of DETECT:MATCH-SIGNATURE
(define detect:name
(let ((memo #f))
(lambda ()
(and (not memo)
(set! memo (detect:match-signature)))
memo)))
(display (detect:signature))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment