(module rename-below mzscheme

  (require "phase.ss")

  (require-for-syntax (lib "plt-match.ss"))

  (provide rename-below rename-expression)

  (define-syntax (rename-expression stx)
    (syntax-case stx ()
      [(re [src dest] ...)
       (syntax/loc stx
         (define-syntaxes (dest ...)
           (values (redirect-expression #'src) ...)))]))

  (define-for-syntax (redirect-expression id)
    (with-syntax ([name id])
      (lambda (stx)
        (syntax-case stx ()
          [(_ . rest) (syntax/loc stx (#%expression (name . rest)))]
          [_ (identifier? stx) (syntax/loc stx (#%expression name))]))))

  (define-syntax (rename-below stx)
    (syntax-case stx ()
      [(rb [above below] ...)
       (begin
         (for-each (lambda (id)
                     (unless (identifier? id)
                       (raise-syntax-error #f "expected an identifier" stx id)))
                   (syntax->list #'(above ... below ...)))
         (match (syntax-local-context)
           [(? pair?)
            (syntax/loc stx (rename-below/block [above below] ...))]
           ['module
             (syntax/loc stx (rename-below/module [above below] ...))]
           ['top-level
            (syntax/loc stx (rename-below/top-level [above below] ...))]
           ['expression
            (raise-syntax-error #f "cannot be used as an expression" stx)]
           ['module-begin
            (raise-syntax-error #f "cannot be used as a module body" stx)]))]))

  (define-syntax (rename-below/block stx)
    (syntax-case stx ()
      [(rb/b [above below] ...)
       (syntax/loc stx
         (begin
           (define-syntax below? (box #f))
           (in-phase1/pass2 (set-box! (syntax-local-value #'below?) #t))
           (define-syntaxes (below ...)
             (values (redirect-below #'below? #'above) ...))))]))

  (define-syntax (rename-below/module stx)
    (syntax-case stx ()
      [(rb/m [above below] ...)
       (begin
         (syntax-local-lift-module-end-declaration
          (syntax/loc stx
            (in-phase1 (set-box! (syntax-local-value #'below?) #f))))
         (syntax/loc stx
           (begin
             (define-syntax below? (box #t))
             (in-phase1/pass2 (set-box! (syntax-local-value #'below?) #t))
             (define-syntaxes (below ...)
               (values (redirect-below #'below? #'above) ...)))))]))

  (define-syntax (rename-below/top-level stx)
    (syntax-case stx ()
      [(rb/tl [above below] ...)
       (syntax/loc stx
         (begin
           ;; First, "declare" top-level names in case of forward references
           (define-syntaxes (above ...) (values))
           (define-syntaxes (below ...) (values (redirect #'above) ...))))]))

  (define-for-syntax (redirect id-stx)
    (lambda (ref-stx)
      (syntax-case ref-stx ()
        [(ref . args) (identifier? #'ref) (quasisyntax/loc ref-stx (#,id-stx . args))]
        [ref (identifier? #'ref) id-stx])))

  (define-for-syntax (redirect-below box-stx id-stx)
    (lambda (ref-stx)
      (if (unbox (syntax-local-value box-stx))
          ((redirect id-stx) ref-stx)
          (raise-syntax-error #f "used before definition" ref-stx))))

  )