(module metadata mzscheme

  (require (lib "contract.ss")
           (lib "etc.ss")
           (lib "list.ss")
           (planet "combinators.ss" ("cce" "combinators.plt" 1 4))
           "syntax-errors.scm"
           "idmap.scm"
           "tags.scm"
           "sharing.scm")

  ;; An Ifc is (make-ifc-meta ...) where:
  ;;   orig : Syntax, name : ID,
  ;;   sigs : (Listof ID), args : (IDMap (Listof ID)),
  ;;   cons : (Listof ID), exprs : (IDMap Stx))
  ;; A Mod is (make-mod-meta ...) where:
  ;;   orig : Syntax, name : ID, impl : ID,
  ;;   itags : (Listof ID), imps : (IDMap Ifc),
  ;;   etags : (Listof ID), exps : (IDMap Ifc)
  (define-struct ifc-meta (orig name sigs args cons exprs))
  (define-struct mod-meta (orig name impl itags etags ifcs share))

  (provide/contract

   [ifc-meta? (-> any/c boolean?)]
   [interface-meta
    (-> syntax?
        identifier?
        (alistof identifier? (listof identifier?))
        (alistof identifier? syntax?)
        ifc-meta?)]

   [ifc-original (-> ifc-meta? syntax?)]
   [ifc-name (-> ifc-meta? identifier?)]
   [ifc-funs (-> ifc-meta? (listof identifier?))]
   [ifc-fun? (-> ifc-meta? identifier? boolean?)]
   [ifc-args (-> ifc-meta? identifier? (listof identifier?))]
   [ifc-thms (-> ifc-meta? (listof identifier?))]
   [ifc-rule (-> ifc-meta? identifier? syntax?)]

   [mod-meta? (-> any/c boolean?)]
   [module-meta
    (-> syntax?
        identifier?
        identifier?
        (alistof identifier? ifc-meta?)
        (alistof identifier? ifc-meta?)
        (listof (listof identifier?))
        mod-meta?)]

   [mod-original (-> mod-meta? syntax?)]
   [mod-name (-> mod-meta? identifier?)]
   [mod-impl (-> mod-meta? identifier?)]
   [mod-imports (-> mod-meta? (listof identifier?))]
   [mod-exports (-> mod-meta? (listof identifier?))]
   [mod-ifc (-> mod-meta? identifier? ifc-meta?)]
   [mod-import-sharing (-> mod-meta? sharing?)]
   [mod-export-sharing (-> mod-meta? sharing?)]
   )

  (define ifc-original ifc-meta-orig)
  (define ifc-name ifc-meta-name)
  (define ifc-funs ifc-meta-sigs)
  (define ifc-thms ifc-meta-cons)
  (define (ifc-args ifc id)
    (idmap-get (ifc-meta-args ifc) id (lambda () (ifc-fun-not-found! ifc id))))
  (define (ifc-rule ifc id)
    (idmap-get (ifc-meta-exprs ifc) id (lambda () (ifc-thm-not-found! ifc id))))

  (define (ifc-fun-not-found! ifc id)
    (syntax-error id "no function ~s in interface ~s"
                  (syntax-e id) (syntax-e (ifc-meta-name ifc))))

  (define (ifc-thm-not-found! ifc id)
    (syntax-error id "no theorem ~s in interface ~s"
                  (syntax-e id) (syntax-e (ifc-meta-name ifc))))

  (define (ifc-fun? ifc id)
    (idmap-member? (ifc-meta-args ifc) id))

  (define (interface-meta original name signatures contracts)
    (make-ifc-meta
     original
     name
     (map car signatures)
     (alist->idmap signatures)
     (map car contracts)
     (alist->idmap contracts)))

  (define mod-original mod-meta-orig)
  (define mod-name mod-meta-name)
  (define mod-impl mod-meta-impl)
  (define mod-imports mod-meta-itags)
  (define mod-exports mod-meta-etags)

  (define (module-meta original name implementation imports exports sharing)
    (let* ([itags (map car imports)]
           [etags (map car exports)]
           [ifcs (alist->idmap (append imports exports))]
           [tagged (pairs->tagged (append imports exports))])
      (make-mod-meta
       original name implementation
       itags etags ifcs
       (sharing-add-clauses sharing #t (empty-sharing tagged)))))

  (define (pairs->tagged pairs)
    (apply append (map pair->tagged pairs)))

  (define (pair->tagged pair)
    (ifc->tagged (car pair) (cdr pair)))

  (define (ifc->tagged tag ifc)
    (map (curry tag-id tag)
         (append (ifc-funs ifc) (ifc-thms ifc))))

  (define mod-export-sharing mod-meta-share)

  (define (mod-import-sharing meta)
    (let* ([exports
            (apply append
                   (map (lambda (tag) (ifc->tagged tag (mod-ifc meta tag)))
                        (mod-exports meta)))])
      (sharing-remove (mod-meta-share meta) exports)))

  (define (mod-ifc mod id)
    (idmap-get (mod-meta-ifcs mod) id (lambda () (mod-tag-not-found! mod id))))

  (define (mod-tag-not-found! mod id)
    (syntax-error id "no interface tag ~s in module ~s"
                  (syntax-e id) (syntax-e (mod-meta-name mod))))

  )