#lang racket/base
(require (for-syntax racket/base racket/provide-transform))
(require racket/provide-syntax)

(provide (all-defined-out))


; *** provide-syntax ***

(define-for-syntax current-my-syntax-local-introduce (make-parameter (lambda (x) (error "ERROR"))))  ;<-New!
  
(define-for-syntax (my-syntax-local-introduce stx) ((current-my-syntax-local-introduce) stx))        ;<-New!

(define-for-syntax orig-insp (variable-reference->module-declaration-inspector (#%variable-reference)))

(define-for-syntax (make-my-provide-macro proc)
  (make-provide-transformer
   (lambda (stx modes)
     (let* ([i (make-syntax-introducer)]
            [d-stx (syntax-disarm stx orig-insp)]
            [new-stx (i (parameterize ([current-my-syntax-local-introduce i]) (proc (i d-stx))))]) ;<-Change!
       (expand-export (syntax-rearm new-stx stx) modes)))))

(define-syntax (define-my-provide-syntax stx)
  (syntax-case stx ()
    [(_ id proc)
     (identifier? #'id)
     (syntax/loc stx
       (define-syntax id
         (make-my-provide-macro proc)))] ;<-Change
    [(_ (id . args) . body)
     (identifier? #'id)
     (syntax/loc stx
       (define-my-provide-syntax id ;<-Change
         (lambda args . body)))]))

(define-syntax (my-provide stx)
  (unless (memq (syntax-local-context) '(module module-begin))
    (raise-syntax-error #f
                        "not at module level"
                        stx))
  
  (syntax-case stx ()
    [(_ out ...)
     (with-syntax ([(out ...)
                    (map (lambda (o) (pre-expand-export o null))
                         (syntax->list #'(out ...)))])
       (syntax-property
        (quasisyntax/loc stx 
          (#%provide #,(syntax-property
                        #`(expand (my-provide-trampoline out ...)) ;<-Change
                        'certify-mode 'transparent)))
        'certify-mode 'transparent))]))


; *** trampoline ***                         

(define-syntax (my-provide-trampoline stx)
  (syntax-case stx ()
    [(_ out ...)
     (letrec ([transform-simple
               (lambda (out)
                 (let ([exports (expand-export (syntax-local-introduce out) null)])   ;<-Change !
                   (map (lambda (export)
                          (let ([base
                                 (if (eq? (syntax-e (export-local-id export))
                                          (export-out-sym export))
                                     (syntax-local-introduce (export-local-id export))
                                     #`(rename #,(syntax-local-introduce (export-local-id export))    ;<-Change !
                                               #,(syntax-local-introduce (export-out-sym export))))]  ;<-Change !
                                [mode (export-mode export)])
                            (let ([phased
                                   (cond
                                     [(eq? mode 0) base]
                                     [else #`(for-meta #,mode #,base)])])
                              (if (export-protect? export)
                                  #`(protect #,phased)
                                  phased))))
                        exports)))])
       (syntax-case stx ()
         [(_ out ...)
          (with-syntax ([(new-out ...)
                         (apply append
                                (map transform-simple (syntax->list #'(out ...))))])
            (syntax/loc stx
              (begin new-out ...)))]))]))


; *** extra-marker ***

(define-for-syntax extra-marker (make-syntax-introducer))


; *** define ***

(define-syntax (define-marked stx)
  (syntax-case stx ()
    [(_ var val) (identifier? #'var)
     (with-syntax ([mk-var (syntax-local-introduce 
                            (extra-marker  
                             (syntax-local-introduce #'var)))])
       #'(define mk-var val))]))


; *** provide ***

(define-syntax (provide-all-defined-marked-out stx)
  (syntax-case stx ()
    [(_) (with-syntax ([\mk-all-defined-out/
                        (syntax-local-introduce 
                         (extra-marker 
                          (syntax-local-introduce 
                           (datum->syntax stx (syntax-e #'(all-defined-out))))))])
           #'(provide \mk-all-defined-out/))]))

(define-provide-syntax (all-defined-marked-out stx)
  (syntax-case stx ()
    [(_) (syntax-local-introduce 
          (extra-marker 
           (syntax-local-introduce 
            (datum->syntax stx (syntax-e #'(all-defined-out))))))]))

(define-my-provide-syntax (my-all-defined-marked-out stx)
  (syntax-case stx ()
    [(_) (my-syntax-local-introduce                      ;<-Change !
          (extra-marker 
           (my-syntax-local-introduce                    ;<-Change !
            (datum->syntax stx (syntax-e #'(all-defined-out))))))]))