(module typed-scheme mzscheme
  
  (require "private/prims.ss" "private/extra-procs.ss" "private/internal-forms.ss")
  (require-for-template "private/prims.ss" "private/extra-procs.ss" "private/internal-forms.ss" mzscheme)
  
  (require-for-syntax "private/typechecker.ss" 
                      "private/type-environments.ss" "private/tc-utils.ss"
                      "private/type-env.ss" "private/type-name-env.ss"
                      "private/base-env.ss"
                      "private/utils.ss"
                      "private/internal-forms.ss"
                      "private/init-envs.ss"
                      "private/effects.ss"
                      (lib "kerncase.ss" "syntax")
                      (lib "match.ss"))

  
  (provide 
   ;; provides syntax such as define: and define-typed-struct
   (all-from "private/prims.ss") 
   ;; provides some pointless procedures - should be removed
   (all-from "private/extra-procs.ss"))
    
  (provide (all-from-except mzscheme #%module-begin #%top-interaction))
  (provide (rename module-begin #%module-begin)
           (rename top-interaction #%top-interaction))

 (define-syntax (module-begin stx)
    (syntax-case stx ()                     
      ((_ forms ...)
       (begin
         (start-timing (syntax-property stx 'enclosing-module-name))
         ;; add initial value bindings - this table is updated
         (initialize-type-env)
         ;; add initial type bindings - this table is updated
         (initialize-type-name-env)
         (parameterize (;; this paramter is for parsing types
                        [current-tvars initial-tvar-env]
                        ;; this parameter is just for printing types
                        ;; this is a parameter to avoid dependency issues
                        [current-type-names
                         (lambda () (type-name-env-map (lambda (id ty)
                                                         (cons (syntax-e id) ty))))])           
           (do-time "Initialized Envs")
           (with-syntax* (;; local-expand the module
                          ;; pmb = #%plain-module-begin
                          ;; rfs = (require-for-syntax mzscheme)
                          [(pmb rfs body2 ...) (local-expand #'(#%module-begin forms ...) 'module-begin null #;stop-list)]
                          [__ (do-time "Local Expand Done")]
                          ;; typecheck the body, and produce syntax-time code that registers types
                          [extra-code (type-check #'(body2 ...))])
             (do-time "Typechecked")
             (printf "checked ~a~n" (syntax-property stx 'enclosing-module-name))
             ;; reconstruct the module with the extra code
             #'(pmb rfs body2 ... extra-code)))))))
  
  (define-syntax (top-interaction stx)
    (syntax-case stx (module)
      [(_ module . rest) #'(module . rest)]
      ((_ . form)
       (begin
         ;; add initial value bindings - this table is updated
         (initialize-type-env)
         ;; add initial type bindings - this table is updated
         (initialize-type-name-env)
         (parameterize (;; this paramter is for parsing types
                        [current-tvars initial-tvar-env]
                        ;; this parameter is just for printing types
                        ;; this is a parameter to avoid dependency issues
                        [current-type-names
                         (lambda () (type-name-env-map (lambda (id ty)
                                                         (cons (syntax-e id) ty))))])       
           ;(do-time "Initialized Envs")
           (let* (;; local-expand the module
                  [body2 (local-expand #'(#%top-interaction . form) 'top-level null)]
                  ;[__ (do-time "Local Expand Done")]
                  ;; typecheck the body, and produce syntax-time code that registers types
                  [type (tc-toplevel-form body2)])
             (define x 3)
             ;(do-time "Typechecked")
             ;(printf "checked ~a~n" (syntax-property stx 'enclosing-module-name))
             (kernel-syntax-case body2 ()
               [(head . _)
                (or (module-identifier=? #'head #'define-values)
                    (module-identifier=? #'head #'define-syntaxes)
                    (module-identifier=? #'head #'require)
                    (module-identifier=? #'head #'provide)
                    (module-identifier=? #'head #'require-for-template)
                    (module-identifier=? #'head #'require-for-syntax)
                    (module-identifier=? #'head #'begin))
                body2]
               ;; reconstruct the module with the extra code
               [_ (with-syntax ([b body2]
                                [ty-str (match type
                                          [($ tc-result t thn els)
                                           (format "- : ~a\n" t)]
                                          [x (printf "~a~n" x) ""])])                    
                    #;#`(let ([v b] [type 'ty-str])
                        (values v (string->symbol type)))
                    #`(let ([v b] [type 'ty-str])
                        (begin0 
                          v
                          (printf ty-str))))])))))))
  
  )