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

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

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