;;; $Id: modops.scm,v 1.7 1995/01/07 21:48:02 miles Exp $
;;; ----------------------------------------------------------------
;;; modops.scm -- User-level interface to Guile's module system
;;; 2 Dec 1994, Miles Bader <miles@eskimo.com>
;;; ----------------------------------------------------------------
;;;
;;; Common operations (these are all macros, and with the exception of VALUE
;;; in define-export, no arguments are evaluated):
;;;
;;;    (in-module NAME)
;;;        Sets the current module to NAME in the current package, and the
;;;        current interface to an interface with the same name.
;;;    (use-interface OPERATORS...)
;;;        Imports variables from other interfaces into the current module.
;;;        The most common use is just (use-interface NAME).
;;;    (export-interface NAME OPERATORS...)
;;;        Exports variables from the current module into the interface
;;;        called NAME in the current package.
;;;        The most common use is (export-interface NAME (VARIABLE-NAME ...)).
;;;    (export-interfaces-to-library NAME)
;;;        Asserts that all subsequent interfaces exported from this module
;;;        are to be themselves exported to LIBRARY.
;;;
;;;    (in-package NAME)
;;;        Sets the current package to the package called NAME.  Until a
;;;        subsequent in-module, the current module will be a special one in
;;;        which package definition operators can be executed.
;;;    (use-library OPERATORS...)
;;;        Imports interfaces from other libraries into the current package.
;;;        The most common use is just (use-library NAME).
;;;        This function may also be used after an in-module, in which case,
;;;        it only applies to that module.
;;;    (export-library NAME OPERATORS...)
;;;        Exports interfaces from the current package into the library
;;;        called NAME.
;;;        The most common use is (export-library NAME (INTERFACE-NAME ...)).
;;;
;;;    (in-interface NAME)
;;;        Sets the `current interface' to NAME in the current package.
;;;    (export OPERATORS...)
;;;        Like export-interface, but exports to the current interface.
;;;    (define-export SYMBOL VALUE)
;;;        Like define, but also exports SYMBOL to the current interface.
;;;
;;; ----------------
;;; A typical file using these module operators might look like:
;;;
;;;   (in-package extensions)
;;;   (in-module foo)
;;;
;;;   (use-library slib)
;;;
;;;   ;; Export routines to deal with foos
;;;   (export-interface foo (make-foo foo-blah string->foo))
;;;
;;;   ;; Add modules we use to our search path
;;;   (use-interface guile)
;;;   (use-interface struct)
;;;   (use-interface i/o)
;;;
;;;   (define (make-foo) ...)
;;;   ...
;;;
;;; Instead of EXPORT-INTERFACE, we could have used EXPORT, which exports to
;;; the `current interface' (which is initially set by IN-MODULE to an
;;; interface with the same name as the current module).  Or alternatively,
;;; there could have been no export statement at all, and we could have used
;;; DEFINE-EXPORT instead of DEFINE for each symbol that we wished to export
;;; (DEFINE-EXPORT exports to the current interface like EXPORT does). 
;;;
;;; ----------------
;;; Here are some examples of more complex uses:
;;;
;;;   ;; Imports the symbols AND, OR, and NOT from the scheme interface
;;;   (use-interface scheme (and or not))
;;;   
;;;   ;; Imports everything from the graphics interface with a prefix of
;;;   ;; "graphics:" 
;;;   (use-interface graphics "graphics:")
;;;   
;;;   ;; Imports all symbols from the graphics interface with a prefix of
;;;   ;; "graphics:", *except* the symbol BITBLT, which is imported as is,
;;;   ;; and the symbol CLEAR-SCREEN, which is imported as CLS (note that if
;;;   ;; you want explicitly imported symbols to be prefixed, you must
;;;   ;; supply the prefix yourself).
;;;   (use-interface graphics (bitblt (clear-screen cls)) "graphics:")
;;;   
;;;   ;; Exports the symbols X, Y, and Z (from the current module) as the
;;;   ;; interface FOO
;;;   (export-interface foo (x y z))
;;;   
;;;   ;; Exports as the interface FOO the symbols A, B, and C from the
;;;   ;; current module, and all symbols from the interface BLAH with a
;;;   ;; prefix of "blah:"
;;;   (export-interface foo (a b c) blah "blah:")
;;;    
;;; ----------------
;;; The following primitive module routines are used:
;;;   (make-variable VALUE [NAME-HINT]) => VARIABLE
;;;   (make-undefined-variable [NAME-HINT]) => VARIABLE
;;;   (variable-set! VARIABLE VALUE)
;;;   (variable-ref VARIABLE) => VALUE
;;;   (variable-bound? VARIABLE) => #t | #f
;;; 
;;;   (make-module [HASH-TABLE-SIZE]) => MODULE
;;;   (module? THING) => #t | #f
;;;   (module-uses MODULE) => MODULE-LIST
;;;   (module-uses! MODULE MODULE-LIST)
;;; 
;;;   (module-add! MODULE SYMBOL VARIABLE)
;;;   (module-remove! MODULE SYMBOL)
;;;   (module-for-each FUN MODULE)
;;;   (module-local-variable MODULE SYMBOL) => VARIABLE | #f
;;;   (module-variable MODULE SYMBOL) => VARIABLE | #f
;;;   (module-bound? MODULE SYMBOL) => #t | #f
;;;
;;;   (module-id MODULE) => STRING | #f
;;;   (module-set-id! MODULE STRING)
;;;   
;;;   (set-current-module MODULE)
;;;   (current-module)
;;; ----------------

(define module-uses! module-uses-set!)

;;; ----------------------------------------------------------------
;;; Bootstrap the module system... presumably the current module is
;;; the scheme module holding a normal scheme system at this point.  In any
;;; case, we use the current module to get access to everything we need...
;;;
;;; More initialization is done at the end of this file.
;;;
(define *boot-module* (current-module))

(define *module-module* (make-module))
(module-uses! *module-module* (list *boot-module*))
(set-current-module *module-module*)

;; Initial hash-table sizes for various sorts of modules
(define *user-module-size* 519)
(define *interface-module-size* 57)
(define *search-module-size* 7)
(define *package-module-size* 57)
(define *package-init-module-size* 7)

;;; defines a macro that executes BODY without evaluating arguments
(define-macro (define-neval template . body)
  `(define-macro ,template `(,(lambda () ,@body))))

;;; ----------------------------------------------------------------
;;; handy module procedures (exported)

;; MODULE-REF -- exported
;;
;; Returns the value of a variable called NAME in MODULE or any of its
;; used modules.  If there is no such variable, then if the optional third
;; argument DEFAULT is present, it is returned; otherwise an error is signaled.
;; 
(define (module-ref module name . rest)
  (let ((variable (module-variable module name)))
    (if (and variable (variable-bound? variable))
	(variable-ref variable)
	(if (null? rest)
	    (error "No variable named" name 'in module)
	    (car rest)			; default value
	    ))))

;; MODULE-SET! -- exported
;;
;; Sets the variable called NAME in MODULE (or in a module that MODULE uses)
;; to VALUE; if there is no such variable, an error is signaled.
;; 
(define (module-set! module name value)
  (let ((variable (module-variable module name)))
    (if variable
	(variable-set! variable value)
	(error "No variable named" name 'in module))))

;; MODULE-DEFINE -- exported
;;
;; Sets the variable called NAME in MODULE to VALUE; if there is no such
;; variable, it is added first.
;; 
(define (module-define module name value)
  (let ((variable (module-local-variable module name)))
    (if variable
	(variable-set! variable value)
	(module-add! module name (make-variable value name)))))

;; MODULE-USE! -- internal
;;
;; Add INTERFACE to the list of interfaces used by MODULE.
;; 
(define (module-use! module interface)
  (module-uses! module
		(cons interface (delq! interface (module-uses module)))))

;; MAKE-USER-MODULE -- internal
;;
;; Creates a module with a proper initial use list for use as a source module.
;; 
(define (make-user-module)
  (let ((module (make-module)))
    (module-uses! module (list *module-basics-interface*))
    module))

;; ----------------------------------------------------------------

(define (%make-interface)
  (let ((interface (make-module *interface-module-size*)))
    (module-set-kind! interface 'interface)
    interface))

;; This is the interface automatically used by modules created by IN-MODULE
(define *module-basics-interface* (%make-interface))

;; This is the interface automatically used by a package's initial-module
;; (which is the current-module while defining package attributes).
(define *package-basics-interface* (%make-interface))

;; ----------------------------------------------------------------

;; DEFINE-MODULE-ATTRIBUTE -- internal
;; 
;; Various module attributes are stored using unique variable names in
;; the module.  As the symbol used is not interned, it is guaranteed not to
;; conflict with any user-bindings in the module.
;; 
;; This macro defines accessors that can be used to get/set an attribute with
;; the given name in a module.  [Because the symbol used is unique, the name
;; is just for debugging purposes]
;; 
(define-macro (define-module-attribute name getproc-name setproc-name)
  `(begin
     (define ,getproc-name #f)
     (define ,setproc-name #f)
     (let ((variable-name (intern-string #f ,name)))
       (set! ,getproc-name
	     (lambda (lib) (module-ref lib variable-name #f)))
       (set! ,setproc-name
	     (lambda (lib val) (module-define lib variable-name val))))))

;;; ----------------------------------------------------------------
;;; Packages -- namespaces for modules
;;; 

;; Each package represents two namespaces -- interfaces & modules.
;; Interfaces are stored directly in a package module; modules are stored in
;; a second module bound to a special variable name in the package module.
;; 
(define-module-attribute "modules"
  package-modules package-set-modules!)

;; Each package has an `initial module' which is the current module after
;; an in-package makes it the current package.  This module is slightly
;; different than a normal module, and most module operations can't be done
;; in it -- a call to in-module must be done first.
;; 
(define-module-attribute "initial-module"
  package-initial-module package-set-initial-module!)

;; MAKE-PACKAGE -- internal
;; 
(define (make-package)
  (let ((package (make-module *package-module-size*))
	(init-module (make-module *package-init-module-size*)))
    ;; define the special initial module
    (module-uses! init-module (list *package-basics-interface*))
    (module-set-package! init-module package)
    (module-set-search-space! init-module package)
    ;;
    (package-set-modules! package (make-module *package-module-size*))
    (package-set-initial-module! package init-module)
    (module-set-kind! package 'package)
    package))

;; PACKAGE? -- internal
;;
(define (package? thing)
  (and (module? thing) (package-modules thing) #t))

;; package-interface -- internal
;;
;; Returns from PACKAGE the interface called NAME, and DEFAULT if it isn't
;; found
;; 
(define package-interface module-ref)

;; PACKAGE-ADD-INTERFACE! -- internal
;;
;; Returns from PACKAGE the interface called NAME, and DEFAULT if it isn't
;; found
;; 
(define package-add-interface! module-define)

;; PACKAGE-MODULE, PACKAGE-ADD-MODULE! -- internal
;;
;; Like the previous two routines, but for modules instead of interfaces.
;; 
(define (package-module package name . rest)
  (apply module-ref (package-modules package) name rest))
(define (package-add-module! package name value)
  (module-define (package-modules package) name value))

;;; ----------------------------------------------------------------
;;; Module package attributes
;;; 

;; MODULE-PACKAGE, MODULE-SET-PACKAGE! -- internal
;; 
;; This is the package where module references are resolved (e.g., for
;; in-module), and new modules are created.
;;
(define-module-attribute "package"
  module-package module-set-package!)

;; MODULE-SEARCH-PACKAGE, MODULE-SET-SEARCH-SPACE! -- internal
;;
;; This is the package where interface references are resolved.   It separate
;; from (current-package) so that modules may have their own private
;; search-space (although this package should always use (current-package)).
;; 
(define-module-attribute "search-space"
  module-search-space module-set-search-space!)

;; MODULE-EXPORT-LIBRARY, MODULE-SET-EXPORT-LIBRARY! -- internal
;;
;; When not #f, this is a library to which any exported interfaces are
;; exported to in addition to the current package.
;; 
(define-module-attribute "export-library"
  module-export-library module-set-export-library!)

;;; ----------------------------------------------------------------
;;; Routines to resolve interface/module names.
;;; 

(define (name-module! module id package)
  ;; Give the module a nice name for printing
  (let ((package-name (module-name package))
	(leaf-name (symbol->string id)))
    (module-set-name!
     module 
     (if package-name
	 (string-append package-name "/" leaf-name)
	 leaf-name))))

;; RESOLVE-INTERFACE -- internal
;;
;; Returns the interface module corresponding to INTREF (if a symbol, it is
;; looked up in PACKAGE).  If it isn't found, it is created in PACKAGE, and
;; also exported to any non-#f elements of LIBRARIES (this hack to support
;; export-interfaces-to-library).
;; 
(define (resolve-interface intref package . export-libraries)
  (if (symbol? intref)
      (or (package-interface package intref #f)
	  (let ((interface (%make-interface)))
	    (package-add-interface! package intref interface)
	    (name-module! interface intref package)
	    (do ((libs export-libraries (cdr libs)))
		((null? libs))
	      (if (car libs)
		  (import-variable intref package intref (car libs))))
	    interface))
      intref))

;; RESOLVE-MODULE -- internal
;;
;; Returns the implementation module corresponding to MODREF (if a symbol, it
;; is looked up in PACKAGE).  If the module has to be created, CREATOR will
;; be called to do so.
;; 
(define (resolve-module modref package creator)
  (if (symbol? modref)
      (or (package-module package modref #f)
	  (let ((module (creator))
		;; The new module gets a private package to be its search
		;; space for libraries, which inherits from its package.
		(search-space (make-module *search-module-size*)))
	    (package-add-module! package modref module)
	    ;;
	    (module-uses! search-space (list package))
	    ;; Setup the module attributes
	    (module-set-package! module package)
	    (module-set-search-space! module search-space)
	    (name-module! module modref package)
	    module))
      modref))

;;; ----------------------------------------------------------------

;; FIND-INTERFACE -- internal
;;
;; Returns the interface named NAME in PACKAGE, loading external code somehow
;; if necessary to define it.  If no such interface can be found, and CREATE?
;; is true, a new interface in PACKAGE is returned, otherwise #f is returned.
;; 
(define (find-interface name package create?)
  (let ((interface (package-interface package name #f)))
    (if (module? interface)
	interface
	(or (package-load-interface package name interface)
	    (and create? (resolve-interface name package))))))

;; FIND-MODULE -- internal
;;
;; Returns the module named NAME in PACKAGE, loading external code somehow if
;; necessary to define it.  If no such module can be found, and CREATOR is
;; not #f, it is called to create the module, otherwise #f is returned.
;; 
(define (find-module name package creator)
  (let ((module (package-module package name #f)))
    (if (module? module)
	module
	(or (package-load-module package name module)
	    (and creator (resolve-module name package creator))))))

;;; ----------------------------------------------------------------
;;; For the common case, where someone just wants to have a single exported
;;; interface, we maintain a default interface with the same name as the
;;; module...
;;; 

(define-module-attribute "current-interface"
  module-current-interface module-set-current-interface!)

;; SET-CURRENT-INTERFACE -- exported
;; 
;; Sets the `current interface' to INTREF; if this is a symbol, no
;; interface is actually created until something is exported to it.
;; 
(define (set-current-interface intref)
  (module-set-current-interface! (current-module) intref))

;; CURRENT-INTERFACE -- exported
;; 
;; Returns the module which is the current default exported interface
;; for the current module.
;; 
(define (current-interface)
  (let* ((mod (current-module))
	 (interface (module-current-interface mod)))
    (cond ((eq? interface #f)
	   (error "No current interface"))
	  ((not (module? interface))
	   ;; not resolved yet, ensure it exists
	   (set! interface
		 (resolve-interface interface
				    (module-package mod)
				    (module-export-library mod)))
	   (set-current-interface interface)))
    interface))

;;; ----------------------------------------------------------------

;; MAKE-INTERFACE -- exported
;; 
;; Returns an interface module sharing variables with other modules, imported
;; according to OPERATORS (see extend-interface for more info on these).
;; PACKAGE is the namespace used to resolve interface references.
;; 
(define (make-interface package . operators)
  (apply extend-interface #f package operators))

;; EXTEND-INTERFACE -- internal
;;
;; Add to the interface module EXPORTING-TO variables imported from other
;; modules, according to OPERATORS.  If EXPORTING-TO is #f, an empty
;; interface is created to export to.  PACKAGE is the namespace used to
;; resolve interface references.
;;
;; Each OPERATOR is either:
;;   A module, in which case it becomes the `currently being imported' module,
;;   A symbol, in which case it is looked up as the name of an interface
;;     module, which becomes the `currently being imported' module, or
;;   #f, which turns off the implicit importation of the whole interface when
;;     no explicit imports are given.
;;   Something to import from the `currently being imported' module.  See the
;;     procedure import, below, for what these can be.  If no imports are
;;     given for a given interface, by default everything in the interface is
;;     imported (this behavior can be suppressed by using the #f operator).
;; 
(define (extend-interface exporting-to package . operators)
  (let ((importing-from #f)
	(auto-import? #t)		; If true, implicitly import rest
	(imported '()))
    (letrec ((do-import
	      (lambda (what)
		(if (not exporting-to)
		    (set! exporting-to (%make-interface)))
		(set! imported
		      (import what exporting-to importing-from imported))))
	     (finish-importing
	      (lambda ()
		;; If nothing imported explicitly, import everything implicitly
		(if (and auto-import? (null? imported))
		    (do-import #t))))
	     (new-interface
	      (lambda (module)
		(if importing-from (finish-importing))
		(set! importing-from module)
		(set! imported '())
		(set! auto-import? #t))))
      (do ((operators operators (cdr operators)))
	  ((eq? operators '())
	   (cond ((not exporting-to)
		  ;; optimization: importing everything from a single
		  ;; interface to a null destination will just return the
		  ;; source interface itself.
		  importing-from)
		 (#t
		  ;; otherwise just do it the slow way
		  (finish-importing)
		  exporting-to)))
	(let ((operator (car operators)))
	  (cond ((module? operator)
		 (new-interface operator))
		((symbol? operator)
		 (let ((interface (find-interface operator package #f)))
		   (if (not interface)
		       (error "Cannot import from" operator '-- ' no 'such
			      'interface))
		   (new-interface interface)))
		((eq? operator #f)
		 (set! auto-import? #f))
		(#t
		 (do-import operator))))))))

;; IMPORT -- internal
;;
;; Imports WHAT from the module FROM to the module TO.  ALREADY-IMPORTED is
;; either a list of symbols already imported, or #t, meaning all symbols; an
;; updated version of ALREADY-IMPORTED reflecting this import is returned.
;;
;; WHAT is either:
;;    A list, in which each element is either:
;;      A symbol, which is imported, or
;;      A sublist of two elements, the symbol in FROM, and the resulting
;;        symbol that should be imported into TO (if the sublist has only one
;;        element, then this variable isn't imported).
;;    #t, meaning all symbols in FROM not in ALREADY-IMPORTED.
;;    A string, meaning all symbols in FROM not in ALREADY-IMPORTED, with the
;;      additional result that each imported symbol has the string added as a
;;      prefix before it is imported into TO.
;; 
(define (import what to from already-imported)
  (cond ((list? what)
	 ;; Import individual symbols, possibly with renaming
	 (do ((imports what (cdr imports))
	      (remember-imports? (list? already-imported))
	      (added '()))
	     ((null? imports)
	      (if remember-imports?
		  (append! added already-imported)
		  #t))
	   (let* ((import (car imports))
		  (what (if (symbol? import) import (car import)))
		  (as
		   (if (symbol? import)
		       import
		       (and (not (null? (cdr import)))
			    (cadr import)))))
	     (if remember-imports? (set! added (cons what added)))
	     (if as (import-variable what from as to)))))
	((eq? already-imported #t)
	 ;; Import all remaining symbols -- but they've already all been done
	 #t)
	(#t
	 ;; Import all remaining symbols, possibly with a prefix
	 (module-for-each
	  (lambda (symbol variable)
	    (if (not (memq symbol already-imported)) ; only import new things
		(let ((as
		       (if (string? what)   ; see if there's a prefix
			   (string->symbol  ; if so, add it to the symbol
			    (string-append what (symbol->string symbol)))
			   symbol)))	    ; otherwise take the symbol as-is
		  (module-add! to as variable))))
	  from)
	 #t)))

;; IMPORT-VARIABLE -- internal
;;
;; Associates the symbol AS in the module TO with the same variable as that
;; associated with the symbol NAME in the module FROM.  NAME must already
;; exist in FROM unless FROM is (current-module), in which case this is
;; assumed to be an export, and more liberal rules apply.
;;
;; Returns the shared variable (if the import can't be done, an error is
;; signaled).
;; 
(define (import-variable name from as to)
  (let ((source-variable (module-local-variable from name))
	(target-variable (module-local-variable to as)))
    (cond ((and source-variable target-variable)
	   ;; There are bindings for both the source and target,
	   ;; which prevents us from doing the import unless they
	   ;; happen to refer to the same variable.
	   (if (not (eq? source-variable target-variable))
	       (error "Cannot import" name 'from from '--
		      as 'is 'already 'present 'in to))
	   source-variable)
	  (source-variable
	   ;; the simple case -- just copy the source to the target
	   (module-add! to as source-variable)
	   source-variable)
	  ((eq? (module-package from) #f)
	   ;; -- semi hack alert --
	   ;; If there's no source variable, it's an error
	   ;; *unless*: the source module is a user-module or package,
	   ;; which should only happen during exporting; in this
	   ;; case we create the source variable (sort of a
	   ;; `forward declaration')
	   (error "Cannot import" name 'from from '--
		  'no 'such 'variable))
	  (target-variable
	   ;; Copy the target to the source (this represents a
	   ;; previously exported variable being re-exported
	   ;; before it's actually been defined).
	   (module-add! from name target-variable)
	   target-variable)
	  (#t
	   ;; Make a new variable shared between the source and
	   ;; target (this represents a variable being exported
	   ;; before it's been defined).
	   (let ((variable (make-undefined-variable name)))
	     (module-add! to as variable)
	     (module-add! from name variable)
	     variable)))))

;;; ----------------------------------------------------------------

;; MODULE-EXPORT -- internal
;;
;; The non-syntax exporting function.
;; 
(define (module-export module intref . operators)
  (apply extend-interface
	 (resolve-interface intref (module-package module)
			    (module-export-library module))
	 (module-search-space module)
	 module
	 operators))

;;; ----------------------------------------------------------------
;;; Module syntax

;; IN-MODULE -- exported
;;
;; Sets the current module to the module called NAME in the current package,
;; creating it if necessary, and sets the default interface to an interface
;; with the same name.
;; 
;; All symbols created in this module are private unless exported.
;;
;; Any created module will use the `module-basics' interface so that further
;; module operations can be performed; to use a truly empty module, use
;; something like (set-current-module (make-module))
;;
(define-neval (in-module name)
  (set-current-module
   (resolve-module name (module-package (current-module)) make-user-module))
  (set-current-interface name))

;; USE-INTERFACE -- exported
;;
;; Imports variables from other interfaces into the current module.
;; References to unknown interfaces are resolved by trying to load code to
;; define the interface.
;; 
;; The most common use is just (use-interface INTERFACE-NAME), but see
;; make-interface for more details on OPERATORS.
;;
(define-neval (use-interface . operators)
  (module-use! (current-module)
	       (apply make-interface
		      (module-search-space (current-module)) operators)))

;; EXPORT-INTERFACE -- exported
;;
;; Exports variables from the current module into an interface called NAME,
;; according to the OPERATORS.  The most common use is (export-interface NAME
;; SYMBOL-LIST), but see make-interface for more details on OPERATORS.
;;
(define-neval (export-interface name . operators)
  (apply module-export (current-module) name #f operators))

;;; ----------------------------------------------------------------
;;; Two alternative ways to define an interface, using the current interface

(define-neval (in-interface name)
  (set-current-interface name))

;; EXPORT -- exported
;;
;; Like EXPORT-INTERFACE, but implicitly uses the current interface.
;; 
(define-neval (export . operators)
  (apply module-export (current-module) (current-interface) #f operators))

;; DEFINE-EXPORT -- exported
;;
;; Like DEFINE, but also exports this variable to the current interface.
;; 
(define-macro (define-export . args)
  (let ((define&export
	  (lambda (name value)
	    (variable-set! (import-variable name (current-module)
					    name (current-interface))
			   value))))
    `(,define&export ',(if (symbol? (car args)) (car args) (caar args))
		      ,(if (symbol? (car args))
			   (cadr args)
			   (cons 'lambda (cons (cdar args) (cdr args)))))))

;;; ----------------------------------------------------------------
;;; Package/library syntax

;; The top level interface/module name space
;;
(define *root-package* (make-package))

;; IN-PACKAGE -- exported
;; 
;; Sets the current package to the package called NAME.  Until a
;; subsequent in-module, the current module will be a special one in
;; which package definition operators can be executed.
;; 
(define-neval (in-package name)
  (set-current-module
   (package-initial-module (resolve-module name *root-package* make-package))))

;; USE-LIBRARY -- exported
;;
;; Extends the interface search space of the current package or module to
;; include libraries defined by OPERATORS.
;; 
;; The most common use is just (use-library LIBRARY-NAME), but see
;; make-interface for more details on OPERATORS.
;;
(define-neval (use-library . operators)
  (module-use! (module-search-space (current-module))
	       (apply make-interface *root-package* operators)))

;; EXPORT-LIBRARY -- exported
;;
;; Exports interfaces from the current package into a library called NAME,
;; according to the OPERATORS.  The most common use is (export-library NAME
;; MODULE-LIST), but see make-interface for more details on OPERATORS.
;;
(define-neval (export-library name . operators)
  (apply module-export (module-package (current-module)) name operators))

;; EXPORT-INTERFACES-TO-LIBRARY -- exported
;;
;; Asserts that all subsequent interfaces exported from this module are to be
;; themselves exported to LIBRARY.
;; 
(define-neval (export-interfaces-to-library library)
  (module-set-export-library! (current-module)
			      (resolve-interface library *root-package*)))

;;; ----------------------------------------------------------------
;;; Finish bootstrapping

;; The package containing all guile-specific stuff
;;
(define *guile-package* (resolve-module 'guile *root-package* make-package))

;; Give the initial bootstrap module a name; some later file can use
;; EXPORT-INTERFACE to actually set up its interfaces.
;;
(resolve-module 'guile *guile-package* (lambda () *boot-module*))
(module-use! *boot-module* *module-basics-interface*); so guile can use modules

;; Give this module (containing module stuff) a name
;;
(resolve-module 'module *guile-package* (lambda () *module-module*))

;; Errors for disallowed operations
;; 
(define-macro (module-only-error . noise)
  (error "This operation can only be used inside a module"))
(define-macro (package-only-error . noise)
  (error "This operation can only be used during package definition"))

;; Export `basic' interfaces that each module starts out with.  These are
;; purposely very minimal -- use-interface should be used to get things like
;; normal scheme operators.
;; 
(module-export *module-module*
	       *module-basics-interface*
	       '(in-module
		 export-interfaces-to-library
		 use-interface export-interface
		 in-interface export define-export
		 in-package use-library
		 (package-only-error export-library)))
(module-export *module-module*
	       *package-basics-interface*
	       '(use-library export-library in-module in-package
		 (module-only-error export-interfaces-to-library)
		 (module-only-error use-interface)
		 (module-only-error export-interface)))

;; Export a programmers interface
;;
(export-interface module
		  (;; module user interface
		   in-module use-interface export-interface
		   in-interface export define-export

		   ;; package user interface
		   in-package use-library export-library

		   ;; 
		   module-export module-use!
		   make-interface extend-interface
		   current-interface set-current-interface
		   make-package make-user-module
		   find-interface find-module
		   *root-package*

		   import-variable

		   module-package module-search-space

		   ;;
		   module-ref module-set! module-define))

(in-module guile)
(export-interface module		  
		  ;; low level module primitives from the boot module
		  (make-module module-uses module-uses!
		   module-local-variable module-variable module-bound?
		   module-add! module-remove!
		   module-for-each
		   current-module set-current-module))

;; ----------------------------------------------------------------
