define-below/define-below.ss
(module define-below mzscheme

  (require-for-syntax (planet "syntax-utils.ss" ("cce" "syntax-utils.plt" 1 1))
                      (planet "combinators.ss" ("cce" "combinators.plt" 1 4))
                      (planet "stx.ss" ("ryanc" "macros.plt" 1 0))
                      (lib "boundmap.ss" "syntax")
                      (lib "unit-exptime.ss"))

  (require (planet "phase.ss" ("cce" "syntax-utils.plt" 1 1))
           (lib "unit.ss"))

  (provide top/error rename-below
           define-values-below define-below
           define-values/invoke-unit/below
           import export)

  (define-for-syntax defined-name-mapping (make-module-identifier-mapping))

  (define-syntax (top/error stx)
    (syntax-case stx ()
      [(t/e . id)
       (identifier? #'id)
       (raise-syntax-error #f "undefined" #'id)]))

  (define-syntax (rename-below stx)
    (syntax-case stx ()
      [(r-b [above below] ...)
       (begin
         (for-each (lambda (id)
                     (unless (identifier? id)
                       (raise-syntax-error
                        #f "expected an identifier" stx id)))
                   (syntax->list #'(above ... below ...)))
         (case (syntax-local-context)
           [( module module-begin )
            (syntax/loc stx (rename-below/module [above below] ...))]
           [( top-level )
            (syntax/loc stx (rename-below/top-level [above below] ...))]
           [else
            (raise-syntax-error
             #f "used outside a top-level context" stx)]))]))

  (define-syntax (rename-below/module rename-stx)
    (syntax-case rename-stx ()
      [(r-b/m [above below] ...)
       (begin
         (syntax-local-lift-module-end-declaration
          (syntax/loc rename-stx
            (in-phase1 (set-box! below? #f))))
         (syntax/loc rename-stx
           (begin
             (define-for-syntax below? (box #t))
             (in-phase1 (set-box! below? #t))
             (#%expression (in-phase1 (set-box! below? #t)))
             (define-syntax (below below-stx)
               (unless (unbox below?)
                 (raise-syntax-error #f "used before definition" below-stx))
               (rename-transform (syntax above) below-stx))
             ...)))]))

  (define-syntax (rename-below/top-level rename-stx)
    (syntax-case rename-stx ()
      [(r-b/t-l [above below] ...)
       (syntax/loc rename-stx
         (begin
           (define-syntax (below below-stx)
             (rename-transform (syntax above) below-stx))
           ...))]))

  (define-syntax (define-values/invoke-unit/below stx)
    (syntax-case stx ( import export )
      [(d/i/b u@ (import i^ ...) (export e^ ...))
       (let*-values ([(exports) (syntax->list (syntax (e^ ...)))]
                     [(parents var-lists def-lists stx-lists)
                      (map/values 4 (yrruc signature-members stx) exports)])
         (with-syntax* ([((e^-orig ...) ...)
                         (map append var-lists def-lists stx-lists)]
                        [((e^-name ...) ...)
                         (map (lambda (names)
                                (map syntax-local-introduce
                                     (syntax->list names)))
                              (syntax->list (syntax ((e^-orig ...) ...))))]
                        [((e^-temp ...) ...)
                         (map generate-temporaries
                              (syntax->list #'((e^-name ...) ...)))])
           (syntax/loc stx
             (begin
               (define-values/invoke-unit
                 u@
                 (import i^ ...)
                 (export (rename e^ [e^-temp e^-name] ...) ...))
               (rename-below [e^-temp e^-name] ... ...)))))]))

  (define-syntax (define-below stx)
    (syntax-case stx ()
      [(d-b (header . formals) . body)
       (syntax/loc stx (d-b header (lambda formals . body)))]
      [(d-b var body)
       (syntax/loc stx
         (begin
           (rename-below [hidden var])
           (define hidden body)))]))

  (define-syntax (define-values-below stx)
    (syntax-case stx ()
      [(d-v-b (var ...) body)
       (with-syntax ([(hidden ...) (generate-temporaries #'(var ...))])
         (syntax/loc stx
           (begin
             (rename-below [hidden var] ...)
             (define-values (hidden ...) body))))]))

  (define-for-syntax (rename-transform id stx)
    (syntax-case stx ()
      [(head . rest)
       (identifier? #'head)
       (with-syntax ([id id])
         (syntax/loc stx (id . rest)))]
      [_
       (identifier? stx)
       id]))

  )