(module implementation mzscheme

  (require-for-syntax
   (planet "combinators.ss" ("cce" "combinators.plt" 1 4))
   "syntax-indirection.scm"
   "metadata.scm"
   "tags.scm")

  (require "../../language/defun.scm")

  (provide define-tagged-imports build-module build-interface get-interfaces)

  (define-syntax (define-tagged-imports stx)
    (syntax-case stx ()
      [(dti tag ifc mod)
       (let* ([imeta (read-syntax-indirection #'ifc)]
              [funs (ifc-funs imeta)]
              [args (map (curry ifc-args imeta) funs)])
         (with-syntax ([(label ...) funs]
                       [(temp ...) (generate-temporaries funs)]
                       [(f ...) (map syntax-local-introduce
                                     (map (curry tag-id #'tag) funs))]
                       [((arg ...) ...) (map generate-temporaries args)])
           (syntax/loc stx
             (begin (define impl (mod-tag mod 'tag))
                    (define-values (temp ...)
                      (values (ifc-label impl 'label) ...))
                    (defun f (arg ...) (temp arg ...)) ...))))]))

  (define-syntax (build-interface stx)
    (syntax-case stx ()
      [(bi ifc [ext int] ...)
       (let* ([imeta (read-syntax-indirection #'ifc)]
              [args (map (curry ifc-args imeta)
                         (syntax->list #'(ext ...)))])
         (with-syntax ([((arg ...) ...) (map generate-temporaries args)])
           (syntax/loc stx
             (interface-impl
              (list (cons 'ext (lambda (arg ...) (int arg ...))) ...)))))]))

  (define-syntax (build-module stx)
    (syntax-case stx ()
      [(bm [tag impl] ...)
       (syntax/loc stx
         (module-impl (list (cons 'tag impl) ...)))]))

  (define-syntax (get-interfaces stx)
    (syntax-case stx ()
      [(gi mod tag ...)
       (syntax/loc stx
         (let* ([val mod])
           (values (mod-tag val 'tag) ...)))]))

  (define (module-impl ifc-impls) ifc-impls)

  (define (interface-impl fun-impls) fun-impls)

  (define (mod-tag mod-impls tag) (cdr (assoc tag mod-impls)))

  (define (ifc-label fun-impls label) (cdr (assoc label fun-impls))) 

  )