(module module-elaborator mzscheme
  
  (require (lib "list.ss")
           (lib "contract.ss"))

  (provide/contract [wrap-in-module ((listof syntax?) any/c (listof any/c) . -> . (listof syntax?))] )
  
  ;; full-on COPIED from plt/collects/lang/htdp-langs.ss
  
  (define (wrap-in-module exps language-module-spec teachpack-specs)
    (let ([new-module-id (gensym "-htdp")])
      (with-syntax ([(tp-spec ...) teachpack-specs])
      (list (let ([mod (expand #`(module #,new-module-id #,language-module-spec 
                                   (require-for-syntax mzscheme)
                                   (require tp-spec ...)
                                   #,@exps))])
              (rewrite-module mod))
            #`(require #,new-module-id)
;            #`(let ([done-already? #f])
;                (dynamic-wind
;                 void
;                 (lambda () (dynamic-require '#,new-module-id #f))
;                 (lambda () 
;                   (unless done-already?
;                     (set! done-already? #t)
;                     (current-namespace (module->namespace '#,new-module-id))))))
            ))))
  
  ;; rewrite-module : syntax -> syntax
  ;; rewrites te module to provide all definitions and 
  ;; print out all results.
  
  (define (rewrite-module stx)
    (syntax-case stx (module #%plain-module-begin)
      [(module name lang (#%plain-module-begin bodies ...))
       (with-syntax ([(rewritten-bodies ...) 
                      (rewrite-bodies (syntax->list (syntax (bodies ...))))])
         (syntax (module name lang
                   (#%plain-module-begin 
                    rewritten-bodies ...))))]
      [else
       (raise-syntax-error 'htdp-languages "internal error .1")]))
  
  ;; rewrite-bodies : (listof syntax) -> syntax
  (define (rewrite-bodies bodies)
    (let loop ([bodies bodies]
               [ids null])
      (cond
        [(null? bodies) 
         (list
          (with-syntax ([(ids ...) ids])
            (syntax (provide ids ...))))]
        [else
         (let ([body (car bodies)])
           (syntax-case body (define-values define-syntaxes require require-for-syntax provide)
             [(define-values (new-vars ...) e)
              (cons body (loop (cdr bodies)
                               (append
                                ids 
                                (filter-ids (syntax (new-vars ...))))))]
             [(define-syntaxes (new-vars ...) e)
              (cons body (loop (cdr bodies)
                               (append
                                ids 
                                (filter-ids (syntax (new-vars ...))))))]
             [(require specs ...)
              (cons body (loop (cdr bodies) ids))]
             [(require-for-syntax specs ...)
              (cons body (loop (cdr bodies) ids))]
             [(provide specs ...)
              (loop (cdr bodies) ids)]
             [else 
              (let ([new-exp
                     (with-syntax ([body body]
                                   [print-results
                                    (lambda (dont-care)
                                      (void) ; intended to simulate the code in drscheme that actually does something.
                                      )])
                       (syntax 
                         (call-with-values
                          (lambda () body)
                          print-results)))])
                (cons new-exp (loop (cdr bodies) ids)))]))])))
  
  (define (filter-ids ids)
    ;; When a `define-values' or `define-syntax' declaration
    ;; is macro-generated, if the defined name also originates
    ;; from a macro, then the name is hidden to anything
    ;; that wasn't generated by the same macro invocation. This
    ;; hiding relies on renaming at the symbol level, and it's
    ;; exposed by the fact that `syntax-e' of the identifier 
    ;; returns a different name than `identifier-binding'.
    (filter
     (lambda (id)
       (let ([ib (identifier-binding id)])
         ;; ib should always be a 4-elem list, but
         ;; check, just in case:
         (or (not (pair? ib)) 
             (eq? (syntax-e id)
                  (cadr ib)))))
     (syntax->list ids)))
  
  
  ; pathetic 'verified-by-inspection' test case:
  
  `(define test-reader
    (let ([done? #f])
      (lambda ()
        (if done?
            eof
            (begin
              (set! done? #t)
              #'(+ 3 4))))))
  `(printf "~a\n" (wrap-in-module test-reader `(lib "htdp-beginner.ss" "lang")))
  )