Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

64 lines (56 sloc) 2.367 kB
#lang racket/base
(require scheme/match scheme/system scheme/promise
(for-syntax scheme/base syntax/boundmap))
(provide from-env run-command call-with-PATH defmatcher domatchers defautoloads)
;; this is used when this module is loaded, before `clearenv' is called
(define (from-env var default [split #f])
(let ([val (getenv var)])
(if (and val (> (string-length val) 0))
(if split (regexp-split split val) val)
default)))
;; Capture the initial path for all kinds of things that need it
(define default-path (getenv "PATH"))
(define (call-with-PATH thunk)
(dynamic-wind
(lambda () (putenv "PATH" default-path))
thunk
(lambda () (putenv "PATH" "")))) ; no way to actually delete a var
;; Conveniently running an external process (given its name and string args)
;; and return the stdout in a string
(define (run-command cmd . args)
(define exe (call-with-PATH (lambda () (find-executable-path cmd))))
(define out (open-output-string))
(parameterize ([current-output-port out])
(if (and exe (apply system* exe args))
(get-output-string out)
"unknown")))
;; Allows defining matchers separately, easier to maintain code.
(define-for-syntax matcher-patterns (make-free-identifier-mapping))
(define-syntax (defmatcher stx)
(syntax-case stx ()
[(_ name pattern body ...)
(begin (free-identifier-mapping-put!
matcher-patterns #'name
(cons #'[pattern body ...]
(free-identifier-mapping-get matcher-patterns #'name
(lambda () '()))))
#'(begin))]))
(define-syntax (domatchers stx)
(syntax-case stx ()
[(_ name val)
#`(match val #,@(reverse (free-identifier-mapping-get matcher-patterns
#'name)))]))
;; used to delay loading libraries
(define-syntax defautoloads
(syntax-rules ()
[(_ [lib var])
(begin (define hidden (delay (dynamic-require 'lib 'var)))
(define-syntax var
(syntax-id-rules (set!)
[(set! . _) (error 'var "cannot mutate")]
[(x . xs) ((force hidden) . xs)]
[_ (force hidden)])))]
[(_ [lib var ...])
(begin (defautoloads (lib var)) ...)]
[(_ [lib var ...] ...)
(begin (defautoloads (lib var ...)) ...)]))
Jump to Line
Something went wrong with that request. Please try again.