#lang scheme/base

(require "../private/planet.ss"
         "dynamic-rep.ss")

(require (for-syntax scheme/base
                     (cce syntax)
                     "static-rep.ss"
                     "syntax-meta.ss"
                     "list-set.ss"))

(provide link-macro)

(define-for-syntax (expand-link stx)
  (parameterize ([current-syntax stx])
    (syntax-case stx ()
      [(_ name ())
       (syntax-error stx "must link at least one module")]
      [(_ name (mod))
       (syntax/loc stx
         (define-syntax name (syntax-local-value #'mod)))]
      [(link name (one two mod ...))
       (with-syntax ([original stx])
         (syntax/loc stx
           (begin
             (define-syntaxes (one-two one/impl two/impl)
               (let* ([one/static (syntax->meta #:message "not a module" #'one)]
                      [one/dynamic (module/static-dynamic one/static)]
                      [one/imports (module/static-imports one/static)]
                      [one/exports (module/static-exports one/static)]
                      [two/static (syntax->meta #:message "not a module" #'two)]
                      [two/dynamic (module/static-dynamic two/static)]
                      [two/imports (module/static-imports two/static)]
                      [two/exports (module/static-exports two/static)]
                      [one-two/exports
                       (list-union #:compare port/static-external=?
                                   one/exports two/exports)]
                      [one-two/imports
                       (list-union #:compare port/static-external=?
                                   one/imports
                                   (list-minus #:compare port/static-external=?
                                               two/imports one/exports))])
                 (values
                  (make-syntax-meta
                   (make-module/static #'one-two
                                       #'dynamic
                                       #'original
                                       one-two/imports
                                       one-two/exports
                                       null)
                   (expand-keyword "cannot be used as an expression"))
                  (make-rename-transformer one/dynamic)
                  (make-rename-transformer two/dynamic))))
             (define dynamic
               (make-module/dynamic
                (lambda (imp/dynamic)
                  (let* ([one/func (module/dynamic-implementation one/impl)]
                         [exp-one/dynamic (one/func imp/dynamic)]
                         [imp-two/dynamic
                          (interface/dynamic-join imp/dynamic exp-one/dynamic)]
                         [two/func (module/dynamic-implementation two/impl)]
                         [exp-two/dynamic (two/func imp-two/dynamic)]
                         [exp/dynamic
                          (interface/dynamic-join imp-two/dynamic
                                                  exp-two/dynamic)])
                    exp/dynamic))))
             (link name (one-two mod ...)))))]
      [_
       (syntax-error
        stx
        "expected a name followed by a parenthesized list of one or more module names")])))

(define-syntax link-macro expand-link)