/utils.rkt
Unknown | 63 lines | 56 code | 7 blank | 0 comment | 0 complexity | f1a1ce8701a530de6a8321c41f5cbb9f MD5 | raw file
1#lang racket/base 2 3(require scheme/match scheme/system scheme/promise 4 (for-syntax scheme/base syntax/boundmap)) 5 6(provide from-env run-command call-with-PATH defmatcher domatchers defautoloads) 7 8;; this is used when this module is loaded, before `clearenv' is called 9(define (from-env var default [split #f]) 10 (let ([val (getenv var)]) 11 (if (and val (> (string-length val) 0)) 12 (if split (regexp-split split val) val) 13 default))) 14 15;; Capture the initial path for all kinds of things that need it 16(define default-path (getenv "PATH")) 17(define (call-with-PATH thunk) 18 (dynamic-wind 19 (lambda () (putenv "PATH" default-path)) 20 thunk 21 (lambda () (putenv "PATH" "")))) ; no way to actually delete a var 22 23;; Conveniently running an external process (given its name and string args) 24;; and return the stdout in a string 25(define (run-command cmd . args) 26 (define exe (call-with-PATH (lambda () (find-executable-path cmd)))) 27 (define out (open-output-string)) 28 (parameterize ([current-output-port out]) 29 (if (and exe (apply system* exe args)) 30 (get-output-string out) 31 "unknown"))) 32 33;; Allows defining matchers separately, easier to maintain code. 34(define-for-syntax matcher-patterns (make-free-identifier-mapping)) 35(define-syntax (defmatcher stx) 36 (syntax-case stx () 37 [(_ name pattern body ...) 38 (begin (free-identifier-mapping-put! 39 matcher-patterns #'name 40 (cons #'[pattern body ...] 41 (free-identifier-mapping-get matcher-patterns #'name 42 (lambda () '())))) 43 #'(begin))])) 44(define-syntax (domatchers stx) 45 (syntax-case stx () 46 [(_ name val) 47 #`(match val #,@(reverse (free-identifier-mapping-get matcher-patterns 48 #'name)))])) 49 50;; used to delay loading libraries 51(define-syntax defautoloads 52 (syntax-rules () 53 [(_ [lib var]) 54 (begin (define hidden (delay (dynamic-require 'lib 'var))) 55 (define-syntax var 56 (syntax-id-rules (set!) 57 [(set! . _) (error 'var "cannot mutate")] 58 [(x . xs) ((force hidden) . xs)] 59 [_ (force hidden)])))] 60 [(_ [lib var ...]) 61 (begin (defautoloads (lib var)) ...)] 62 [(_ [lib var ...] ...) 63 (begin (defautoloads (lib var ...)) ...)]))