#lang racket/base

(require
  "../private/planet.rkt"
  (for-syntax
    racket/base
    syntax/parse
    (cce syntax)
    "static-rep.rkt"
    "syntax-meta.rkt"
    "list-set.rkt")
  "dynamic-rep.rkt"
  "keywords.rkt")

(provide link-macro)

(define-for-syntax (restrict-module/static name stx mod imp-ids exp-ids)
  (make-module/static
    name
    (module/static-dynamic mod)
    stx
    (append
      (for/list ([imp-id (in-list imp-ids)])
        (make-import/static
          imp-id
          (syntax->meta #:message "not an interface" imp-id)
          null
          null))
      (for/list ([exp-id (in-list exp-ids)])
        (make-export/static
          exp-id
          (syntax->meta #:message "not an interface" exp-id)
          null
          null)))))

(define-syntax (restrict stx)
  (syntax-parse stx
    [(_ name full (import i ...) (export e ...))
     #'(define-syntax name
         (make-syntax-meta
           (restrict-module/static
             #'name
             #'original
             (syntax->meta #:message "not a module" #'full)
             (list #'i ...)
             (list #'e ...))
           (expand-keyword "cannot be used as an expression")))]))

(define-for-syntax (expand-link stx)
  (parameterize ([current-syntax stx])
    (syntax-parse stx
      #:literals (import export)
      [(form name (import i ...) (export e ...) (mod ...))
       (with-syntax ([original stx])
         #'(begin
             (form full (mod ...))
             (restrict name full (import i ...) (export e ...))))]
      [(_ name ())
       (syntax-error stx "must link at least one module")]
      [(_ name (mod))
       (syntax/loc stx
         (define-syntax name (syntax-local-value #'mod)))]
      [(form name (one two . mods))
       (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
                     (append one-two/imports one-two/exports))
                   (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))))
             (form name (one-two . mods)))))]
      [_
       (syntax-error
        stx
        "expected a name followed by a parenthesized list of one or more module names")])))

(define-syntax link-macro expand-link)