default-in.rkt

#lang racket/base
(require (for-syntax racket/base
                     racket/set
                     racket/list
                     racket/match
                     racket/require-transform
                     syntax/parse
                     syntax/modcollapse))

(define-syntax default-in
  (make-require-transformer
   (λ (stx)
     (syntax-parse stx
       [(_ m [in:id def:id] ...)
        (define ins (make-hasheq))
        (for ([i*d (in-list (syntax->list #'([in . def] ...)))])
          (match-define (cons in-stx _) (syntax-e i*d))
          (define in (syntax-e in-stx))
          (when (hash-has-key? ins in)
            (raise-syntax-error 'default-in "duplicate import" stx in-stx))
          (hash-set! ins in i*d))

        (define-values (ims srcs) (expand-import #'m))
        (for ([im (in-list ims)])
          (hash-remove! ins (import-src-sym im)))

        (define ims+
          (for/list ([(in i*d) (in-hash ins)])
            (match-define (cons in-stx def) (syntax-e i*d))
            (match-define
              (list source-mod source-id nominal-source-mod nominal-source-id
                    source-phase import-phase nominal-export-phase)
              (or (identifier-binding def)
                  (raise-syntax-error 'default-in "default must be bound" stx def)))
            (define source-mod-path
              (collapse-module-path-index
               source-mod
               (λ ()
                 ;; xxx this is stupid, but I don't know how not to do it
                 (raise-syntax-error 'default-in "default must be imported"
                                     stx def))))
            (import in-stx source-id
                    source-mod-path
                    import-phase
                    0 nominal-export-phase def)))
        (values (append ims+ ims) srcs)]))))

;; xxx defined here, because it can't be in the other file
(define-syntax (xxx-stupid-void stx)
  #'(void))

(provide default-in
         xxx-stupid-void)

(module+ test
  (define moogle displayln)
  (require (default-in racket/bool
             [snoozle displayln]

             ;; xxx
             [snozle moogle]

             [nozzle void]))
  (snoozle 42)
  (nozzle 1 2 3 4))