;;;;
;;;; module.stk	-- Module stuff
;;;; 
;;;; Copyright  2000-2002 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; 
;;;; 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:  1-Jun-2000 12:26 (eg)
;;;; Last file update:  1-May-2002 11:38 (eg)
;;;;


;;=============================================================================
;;
;; 				SYMBOL-VALUE*	
;;
;;=============================================================================
#|
<doc EXT symbol-value* 
 * (symbol-value* symbol module)
 * (symbol-value* symbol module default)
 *
 * Returns the value bound to |symbol| in |module|. If |symbol| is not bound,
 * an error is signaled if no |default| is provided, otherwise |symbol-value| 
 * returns |default|.
 *
 * @noindent
 * Note that this function searches the value of |symbol| in |module| @b{and}
 * all the modules it imports whereas |symbol-value| searches
 * only in |module|.
doc>
|#
(define (symbol-value* name module :optional (default #f default?))
  (let ((absent (gensym)))
    (let Loop ((all-mods (cons module (module-imports module))))
      (if (null? all-mods)
	  ;; Symbol was absent in the module and its imported modules 
	  (if default?
	      default
	      (error 'symbol-value* "symbol ``~S'' not found" name))
	  ;; Let's see
	  (let ((val (symbol-value name (car all-mods) absent)))
	    (if (eq? val absent)
		(Loop (cdr all-mods))
		val))))))

;;=============================================================================
;;
;; 				SELECT-MODULE	
;;
;;=============================================================================
#|
<doc ext-syntax select-module
 * (select-module <name>)
 *
 * Changes the value of the current module to the module with the given |name|. 
 * The expressions evaluated after |select-module| will take place in 
 * module |name| environment.  Module |name| must have been created 
 * previously by a |define-module|. The result of |select-module| is @emph{void}.
 * |Select-module| is particularly useful when debugging since it
 * allows to place toplevel evaluation in a particular module. The
 * following transcript shows an usage of |select-module|.
 * @footnote{This transcript uses the default value for the 
 * 	       function |repl-display-prompt| (see @pxref{repl-display-prompt})
 * 	       which displays the name of the current module in the evaluator
 * 	       prompt.}:
 * @lisp
 * stklos> (define foo 1)
 * stklos> (define-module bar
 *           (define foo 2))
 * stklos> foo
 * 1
 * stklos> (select-module bar)
 * bar> foo
 * 2
 * bar> (select-module stklos) 
 * stklos> 
 * @end lisp
doc>
|#

(define-macro (select-module name)
  `(%%set-current-module (find-module ',name)))


;;=============================================================================
;;
;; 				DEFINE-MODULE	
;;
;;=============================================================================
#|
<doc ext-syntax define-module
 * (define-module <name> <expr1> <expr2> ...)
 *
 * |Define-module| evaluates the expressions |<expr1>|, |<expr2>| ... which
 * constitute the body of the module |<name>| in the environment of that module.
 * |Name| must be a valid symbol. If this symbol has not already been used to
 * define a module, a new module, named |name|, is created.
 * Otherwise, the expressions |<expr1>|, |<expr2>| ... are evaluated in
 * the environment of the (old) module |<name>|
 * @footnote{In fact |define-module| on a given name
 * 	     defines a new module only the first time it is invoked on this name.
 * 	     By this way, interactively reloading a module does not define 
 * 	     a new entity, and the other modules which use it are not altered.}.
 * Definitions done in a module are local to the module and do not interact with 
 * the definitions in other modules. Consider the following definitions,
 * @lisp
 * (define-module M1
 *    (define a 1))
 * 
 * (define-module M2
 *   (define a 2)
 *   (define b (* 2 x)))
 * @end lisp
 * 
 * Here, two modules are defined and they both bind the symbol |a| to a 
 * value. However, since |a| has been defined in two distinct modules
 * they denote two different locations. 
 * 
 * The |STklos| module, which is predefined, is a special module which
 * contains all the @emph{global variables} of a @rfive{} program.  A symbol
 * defined in the |STklos| module, if not hidden by a local definition, is
 * always visible from inside a module. So, in the previous exemple, the
 * |x| symbol refers the |x| symbol defined in the |STklos| module.
 * 
 * The result of |define-module| is @emph{void}.
doc>
|#
(define %modules-stack  '())
(define %module-create  (lambda (name)
			  (set! %modules-stack (cons (current-module)
						     %modules-stack))
			  (%create-module name)))

(define %module-restore (lambda ()
			  (let ((previous (car %modules-stack)))
			    (set! %modules-stack (cdr %modules-stack))
			    previous)))

(define %module-handler (lambda (k l m)
			  (%module-restore)
			  (error l m)))

(define-macro (define-module name . body)
  `(with-handler
      %module-handler 
      (%%set-current-module (%module-create ',name))
      ,@body
      (%%set-current-module (%module-restore))
      (values (void) ',name)))

;;=============================================================================
;;
;; 				IMPORT
;;
;;=============================================================================
#|
<doc ext-syntax import
 * (import <module1> <module2> ...)
 *
 * Specifies the modules which are imported by the current module.
 * Importing a module makes the symbols it exports visible to the
 * importer, if not hidden by local definitions. When a symbol 
 * is exported by several of the imported modules, the location denoted by
 * this symbol in the importer module correspond to the one of the first module
 * in the list 
 * @lisp
 * (<module1> <module2> ...) 
 * @end lisp
 * which exports it. 
 *
 * If several |import| clauses appear in a module, the set of
 * imported modules  is determined by appending the various list of modules 
 * in their apparition order. 
 *
 * @lisp
 * (define-module M1
 *   (export a b)
 *   (define a 'M1-a)
 *   (define b 'M1-b))
 * 
 * (define-module M2
 *   (export b c)
 *   (define b 'M2-b)
 *   (define c 'M2-c))
 * 
 * (define-module M3
 *   (import M1 M2)
 *   (display (list a b c)))  @print{} (m1-a m1-b m2-c)
 * @end lisp
 *
 * @strong{Note:} Importations are not @emph{transitive}: when
 * the module @math{C} imports the module @math{B} which is an importer of 
 * @math{A}, the symbols of @math{A} are not visible from @math{C}, except 
 * by explicitly importing the @math{A} module from @math{C}.
 * 
 * @strong{Note:} The module |STklos|, which contains the @emph{global
 * variables} is always implicitly imported from a module. Furthermore, 
 * this module is always placed at the end of the list of imported modules.
doc>
|#
(define (%module-import importer modules)
  (let Loop ((l modules) (res (reverse (module-imports importer))))
    (if (null? l)
	(%module-imports-set! importer (reverse res))
	(let ((mod (find-module (car l) #f)))
	  (if mod
	      (Loop (cdr l)
		      (if (memq mod res)
			  res		   	; already imported
			  (cons mod res))) 	; add it to our result
	      (error 'import "module `~S' does not exist" (car l)))))))

(define-macro (import . modules)
  `(%module-import (current-module) ',modules))

;;=============================================================================
;;
;; 				EXPORT
;;
;;=============================================================================
#|
<doc ext-syntax export
 * (export <symbol1> <symbol2> ...)
 *
 * Specifies the symbols which are exported (i.e. @emph{visible}) outside 
 * the current module. By default, symbols defined in a module are not 
 * visible outside this module, excepted if they appear in an |export|
 * clause. 
 * 
 * If several |export| clauses appear in a module, the set of
 * exported symbols is determined by ``@emph{unionizing}'' symbols exported
 * in all the |export| clauses.
 * 
 * The result of |export| is @emph{void}.
doc>
|#
(define (%module-export exporter symbols)
  (let Loop ((l symbols) (res (module-exports exporter)))
    (if (null? l)
	(%module-exports-set! exporter res)
	(if (symbol? (car l))
	    (Loop (cdr l)
		  (if (memq (car l) res)
		      res			; already exported
		      (cons (car l) res)))	; add it to our result
	    (error 'export "bad symbol `~S'" (car l))))))

(define-macro (export . symbols)
  `(%module-export (current-module) ',symbols))

;;=============================================================================
;;
;; 				IN-MODULE
;;
;;=============================================================================
#|
<doc ext-syntax in-module
 * (in-module mod s)
 * (in-module mod s default)
 *
 * This form returns the value of symbol with name |s| in the module with name
 * |mod|. If this symbol is not bound,  an error is signaled if no |default| is
 * provided, otherwise |in-module| returns |default|. Note that the value of |s|
 * is searched in |mod| and all the modules it imports.
 *
 * This form is in fact a shortcut. In effect, 
 * @lisp
 * (in-module my-module foo)
 * @end lisp
 * @noindent
 * is equivalent to
 * @lisp
 * (symbol-value* 'foo (find-module 'my-module))
 * @end lisp
doc>
|#
(define-macro (in-module mod symb . default)
  `(apply symbol-value* ',symb (find-module ',mod) ',default))


;; LocalWords:  emph doc ext