;;;;
;;;;
;;;; library.stk         -- R7RS define-library
;;;;
;;;; Copyright © 2019-2023 Erick Gallesio <eg@stklos.net>
;;;; Copyright © 2023 Robby Zambito <contact@robbyzambito.me>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 18-Oct-2019 14:08
;;;;


(export define-library library-name library-list
        ;; FIXME
        %module-define-and-export
        %make-copy-module)

;;
;; A macro to redefine a symbol in a R7RS module
;;
(define-macro (%module-define-and-export . lst)
  `(begin
     ,@(map (lambda (x) `(%symbol-define ',x ,x)) lst)
     (export ,@lst)))

;;
;; Define a module which exports all the exported module of another
;; FIXME: find another name for this macro.
;;
(define-macro (%make-copy-module old new)
  (%%import (compiler-current-module) (list old))
  `(define-module ,new
     (import ,old)
     (export ,@(module-exports (find-module old)))))


;; ======================================================================
;;
;; DEFINE-LIBRARY
;;
;; ======================================================================
#|
<doc R7RS-SYNTAX define-library
 * (define-library <library name> <library declaration> ...)
 *
 * The form |define-library| is defined in R7RS. The |<library name>| can be
 * a symbol or a list (as modules).
 *
 * A |<library declaration>| is any of
 *
 * * |(export <export spec> ...)|
 * * |(import <import set> ...)|
 * * |(begin <command or definition> ...)|
 * * |(include <filename1> <filename2> ...)|
 * * |(include-ci <filename1> <filename2> ...)|
 * * |(include-library-declarations <filename1> <filename2> ...)|
 * * |(cond-expand <clause1> <clause2> ...)|
 *
 * See {{rseven}} for more information (or the specific entries in this document)
 * about each |<library declaration>|.
 *
 * NOTE: {{rseven}} permits to use library declarations only in
 * a library definition; {{stklos}} permits to use them (except
 * |include-library-declarations|) anywhere at toplevel.
doc>
|#
(define-macro (define-library name . decls)
  (let* ((module-name    (%normalize-library-name name))
         (conds          '())
         (imports        '())
         (exports        '())
         (body           '())
         (lib            (gensym))
         (module-restore (symbol-value '%module-restore
                                       (find-module 'SCHEME))))

    ;; Parse declarations
    (define (parse-declarations decls)
      (for-each (lambda (d)
                  (unless (pair? d)
                    (error 'define-library "bad library declaration clause ~s" d))
                  (let ((key  (car d))
                        (rest (cdr d)))
                    (case key
                      ((import)
                       (set! imports (append imports rest)))

                      ((export)
                       (set! exports (append exports rest)))

                      ((begin include include-ci)
                       (set! body (append body (list d))))

                      ((include-library-declarations)
                       (for-each (lambda (path)
                                   (parse-declarations
                                    (call-with-input-file (or (find-path path) path)
                                      port->sexp-list)))
                                 rest))

                      ((cond-expand)
                       (set! conds (cons d conds)))

                      (else
                       (error 'define-library "incorrect directive ~s" d)))))
                decls))
    (parse-declarations decls)
    ;;
    ;; Produce the expansion
    ;;
    ;; The difficulty here is that libraries have an empty environment. That
    ;; means that we cannot expand in a "define-module" and do the imports
    ;; and the exports in it. Consequently, we work in five phases:
    ;;  1. First, we create the library as a module and  just expand all the
    ;;     the cond-expand at the top of the module, as required by R7RS report.
    ;;  2. After that, we just do the imports and exports in the module. Note
    ;;     that this point and previous one can use the  expansion code of
    ;;     of cond-expand ir import/export since the STklos environment is
    ;;     visible.
    ;;  3. We transform the module in a library (that means more or less that
    ;;     the STklos module is  deleted from the import list.
    ;;  4. We evaluate the body in the module (which is now a library).
    ;;
    ;; NOTE: Since the environment of a library is empty, we cannot use the
    ;; primitives defined in STklos or SCHEME modules. In this case, we can
    ;; use the special call (%%in-scheme 'xx) to grab the value of xx in
    ;; SCHEME module (used for instance with %module-restore which
    ;; is needed at the end of the expansion of define-module
    ;;
    `(begin
       (define-module ,module-name
         ;; ①: start by expanding in place all the library cond-expand
         (begin ,@(reverse! conds))

         ;; ②: define the imports and the exports
         (import ,@imports)
         (export ,@exports)

         ;; ③: transform the module in a library
         (%module->library! ',module-name)

         ;; ④: evaluate the body in the library environment
         ,@body))))


#|
<doc EXT library-name
 * (library-name lib)
 *
 * Returns the name of |lib| if it was defined as an R7RS library,
 * and `#f` if the library is anonymous. If |lib| is not a library,
 * |library-name| raises an error. If a name is returned, it is
 * as a list.
 *
 * @lisp
 * (define-library (example cool-library))
 * (library-name (find-module 'example/cool-library))   => (example cool-library)
 * (library-name (find-module '(example cool-library))) => (example cool-library)
 * (module-name  (find-module 'example/cool-library))   => example/cool-library
 * (module-name  (find-module '(example cool-library))) => example/cool-library
 *
 * (define-module example/a-module)
 * (library-name (find-module 'example/a-module))     => error
 *
 * (library-name quotient)                            => error
 * @end lisp
doc>
|#
(define (library-name lib)
  (unless (library? lib)
    (if (module? lib)
        (error 'library-name "module ~S is not a library" (module-name lib))
        (error 'library-name "bad module/library ~S" lib)))
  (let ((name (module-name lib)))
    (and (not (eq? name #void))
         (%symbol->library-name (module-name lib)))))


#|
<doc EXT library-list
 * (library-list)
 *
 *  Returns the list of all the living libraries.
doc>
|#
(define (library-list)
  (filter library? (all-modules)))

