suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

attempt to add a little more information

Browse Source 
to help diagnose this (and related) failures:

http://drdr.racket-lang.org/27793/pkgs/drracket-pkgs/drracket-test/tests/drracket/easter-egg.rkt
This commit is contained in:
Robby Findler 2013-11-18 21:32:13 -06:00
parent 62615f492d
commit d2fd37c251
1 changed files with 26 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
racket/collects/setup/dirs.rkt
View File

@ -3,7 +3,8 @@
(require racket/promise
compiler/private/winutf16
compiler/private/mach-o
'#%utils)
'#%utils
(for-syntax racket/base))
;; ----------------------------------------
;; "config"
@ -127,9 +128,10 @@
(define (get-false) #f)
(define (chain-to f) f)
(define-syntax define-finder
(syntax-rules (get-false chain-to)
(define-syntax (define-finder stx)
(syntax-case stx (get-false chain-to)
[(_ provide config:id id user-id #:default user-default default)
#'
(begin
(define-finder provide config:id id get-false default)
(provide user-id)
@ -138,6 +140,7 @@
(define (user-id)
(force user-dir)))]
[(_ provide config:id id user-id config:search-id search-id default)
#'
(begin
(define-finder provide config:id id user-id default)
(provide search-id)
@ -146,6 +149,7 @@
(cons-user (user-id) (single (id))))))]
[(_ provide config:id id user-id config:search-id search-id
extra-search-dir default)
#'
(begin
(define-finder provide config:id id user-id default)
(provide search-id)
@ -154,15 +158,17 @@
(extra (extra-search-dir)
(cons-user (user-id) (single (id)))))))]
[(_ provide config:id id get-false (chain-to get-default))
(begin
(with-syntax ([dir (generate-temporaries #'(id))])
#'(begin
(provide id)
(define dir
(delay
(or (force config:id) (get-default))))
(define (id)
(force dir)))]
(force dir))))]
[(_ provide config:id id get-false default)
(begin
(with-syntax ([dir (generate-temporaries #'(id))])
#'(begin
(provide id)
(define dir
(delay
@ -170,9 +176,9 @@
(let ([p (find-collects-dir)])
(and p (simplify-path (build-path p 'up default)))))))
(define (id)
(force dir)))]
(force dir))))]
[(_ provide config:id id user-id default)
(define-finder provide config:id id user-id #:default default default)]))
#'(define-finder provide config:id id user-id #:default default default)]))
(define-syntax no-provide (syntax-rules () [(_ . rest) (begin)]))