Skip to content

Instantly share code, notes, and snippets.

@corpix
Created April 4, 2021 14:02
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save corpix/b43d3a23b4d2e5a73b5a33edf14f6905 to your computer and use it in GitHub Desktop.
Save corpix/b43d3a23b4d2e5a73b5a33edf14f6905 to your computer and use it in GitHub Desktop.
#lang racket/base
(require setup/dirs
setup/variant
setup/cross-system
racket/promise)
(define plain-variant
(delay/sync
(cond
[(cross-installation?)
(if (eq? 'chez-scheme (cross-system-type 'vm))
'cs
(cross-system-type 'gc))]
[else
(let* ([dir (find-console-bin-dir)]
[exe (cond [(eq? 'windows (system-type)) "Racket.exe"]
[(equal? #".dll" (system-type 'so-suffix))
;; in cygwin so-suffix is ".dll"
"racket.exe"]
[else "racket"])]
[f (build-path dir exe)])
(displayln (list 'plain-variant 'f f))
(and (file-exists? f)
(with-input-from-file f
(lambda ()
(define m (regexp-match #rx#"bINARy tYPe:..(.)"
(current-input-port)))
(cond
[(not m) '3m]
[(equal? (cadr m) #"c") 'cgc]
[(equal? (cadr m) #"s") 'cs]
[else '3m])))))])))
(define (find-exe #:cross? [cross? #f]
#:untethered? [untethered? #f]
[mred? #f]
[variant (if cross?
(cross-system-type 'gc)
(system-type 'gc))])
(let* ([base (if mred?
(or (and (not untethered?)
(find-addon-tethered-gui-bin-dir)
(find-config-tethered-gui-bin-dir))
(find-lib-dir))
(or (and (not untethered?)
(find-addon-tethered-console-bin-dir)
(find-config-tethered-console-bin-dir))
(find-console-bin-dir)))]
[fail
(lambda ()
(error 'find-exe
"can't find ~a executable for variant ~a"
(if mred? "GRacket" "Racket")
variant))])
(let ([exe (build-path
base
(case (if cross?
(cross-system-type)
(system-type))
[(macosx)
(cond
[(not mred?)
;; Need Racket:
(string-append "racket" (variant-suffix variant #f))]
[mred?
;; Need GRacket:
(let ([sfx (variant-suffix variant #t)])
(build-path (format "GRacket~a.app" sfx)
"Contents" "MacOS"
(format "GRacket~a" sfx)))])]
[(windows)
(format "~a~a.exe" (if mred?
"GRacket"
"Racket")
(variant-suffix variant #t))]
[(unix)
(format "~a~a" (if mred?
"gracket"
"racket")
(variant-suffix variant #f))]))])
(displayln (list 'find-exe
'exe exe
'(cross-system-type) (cross-system-type)
'mred? mred?
'variant variant
'(get-cs-suffix) (get-cs-suffix)
'(force plain-variant) (force plain-variant)
'(cross-installation?) (cross-installation?)
'(variant-suffix variant #f) (variant-suffix variant #f)))
(unless (or (file-exists? exe)
(directory-exists? exe))
(fail))
exe)))
(find-exe)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment