#lang scheme/base

(require (for-syntax scheme/base)
         (for-syntax "../private/compiler/context.ss")
         (for-syntax "../private/compiler/compile.ss")
         "../private/runtime/runtime.ss"
         "../private/runtime/standard-library.ss")

(define-syntax (script-compile stx)
  (syntax-case stx ()
    [(script-compile ast ...)
     (parameterize ([current-eval-context #'here]
                    [current-compilation-context 'script]
                    [current-source-syntax stx])
       (with-syntax ([e (compile-script (syntax->datum #'(ast ...)))])
         #'(quote-syntax (begin (current-Function-context #'here)
                                e))))]))

(define-syntax (script-begin stx)
  (syntax-case stx ()
    [(script-begin ast ...)
     (parameterize ([current-eval-context #'here]
                    [current-compilation-context 'script]
                    [current-source-syntax stx])
       (with-syntax ([e (compile-script (syntax->datum #'(ast ...)))])
         #'(begin (current-Function-context #'here)
                  e)))]))

(define-syntax (interaction-begin stx)
  (syntax-case stx ()
    [(interaction-begin ast ...)
     (parameterize ([current-eval-context #'here]
                    [current-compilation-context 'interaction]
                    [current-source-syntax stx])
       (with-syntax ([e (compile-interaction (syntax->datum #'(ast ...)))])
         #'(begin (current-Function-context #'here)
                  e)))]))

(define-syntax (interaction-compile stx)
  (syntax-case stx ()
    [(interaction-compile ast ...)
     (with-syntax ([e (parameterize ([current-eval-context #'here]
                                     [current-compilation-context 'interaction]
                                     [current-source-syntax stx])
                        (compile-interaction (syntax->datum #'(ast ...))))])
       #'(quote-syntax (begin (current-Function-context #'here)
                              e)))]))

(define-syntax (eval-begin stx)
  (syntax-case stx ()
    [(eval-begin ast ...)
     (parameterize ([current-pragmas (hash-set (current-pragmas) '(lexical scope) #t)]
                    [current-eval-context #'here]
                    [current-compilation-context 'eval]
                    [current-source-syntax stx])
       (with-syntax ([body (with-scope #f
                             (compile-global (syntax->datum #'(ast ...))))])
         #'(begin (current-Function-context #'here)
                  body)))]))

(define-syntax (module-compile stx)
  (syntax-case stx ()
    [(module-compile ast ...)
     (with-syntax ([body (parameterize ([current-eval-context #'here]
                                        [current-source-syntax stx])
                           (compile-module (syntax->datum #'(ast ...))))])
       (with-syntax ([module #'(#%plain-module-begin
                                (install-standard-library-once! global-object)
                                (current-Function-context #'here)
                                body)])
         #'(quote-syntax module)))]))

(define-syntax (module-begin stx)
  (syntax-case stx ()
    [(module-begin)
     #'(#%plain-module-begin (begin #f))]
    [(module-begin ast ...)
     (with-syntax ([body (parameterize ([current-eval-context #'here]
                                        [current-source-syntax stx])
                           (compile-module (syntax->datum #'(ast ...))))])
       #'(#%plain-module-begin
          (install-standard-library-once! global-object)
          (current-Function-context #'here)
          body))]))

(define-syntax (function-begin stx)
  (syntax-case stx ()
    [(function-begin ast)
     (parameterize ([current-eval-context #'here]
                    [current-compilation-context 'eval]
                    [current-source-syntax stx])
       (compile-function-expression (syntax->datum #'ast)))]))

(provide module-begin module-compile eval-begin script-begin script-compile interaction-begin interaction-compile function-begin)