;;; $Id: mrequire.scm,v 1.1 1995/01/06 17:59:57 miles Exp $
;;; ----------------------------------------------------------------
;;; mrequire.scm -- Wrapper for slib require/provide that makes it modular
;;; 4 Jan 1995, Miles Bader <miles@eskimo.com>
;;; ----------------------------------------------------------------
;;;

(in-package slib)

(export-library slib (slib require) guile (record defmacro))
(export-library guile (slib))		; make slib usable from the guile lib

(use-library guile)

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

(in-module slib)

(export-interface require
 (REQUIRE PROVIDE PROVIDED?
  (REQUIRE REQUIRE:REQUIRE)
  (PROVIDE REQUIRE:PROVIDE)
  (PROVIDED? REQUIRE:PROVIDED?)))

;; The initial interface used by an slib module
(export-interface slib
 require
 slib-hooks
 vicinity
 time
 guile)

(use-interface guile)
(use-interface guile-internals)
(use-interface slib-hooks (*features*))
(use-interface module)
(use-interface variable)
(use-interface vicinity)

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

(define *require-pathname* (in-vicinity (library-vicinity) "require.scm"))

(define *slib-package* (find-module 'slib *root-package* #f))
(define *slib-library* (find-interface 'slib *root-package* #f))

(define *slib-module-initial-interface*
  (find-interface 'slib *slib-package* #f))

(define (make-slib-module)
  (let ((module (make-module)))
    (module-use! module *slib-module-initial-interface*)
    module))

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

(define *require-module*
  (find-module 'require *slib-package* make-slib-module))

;; The internal variables in the require module that we fuck with to fool the
;; slib require/provide code into using modules.  We just share variables in
;; our module with it.
;;
(define *provide-variable* (module-variable (current-module) 'provide))
(module-add! *require-module* 'provide *provide-variable*)
(module-add! *require-module* 'require:provide *provide-variable*)
;;
(define *require-variable* (module-variable (current-module) 'require))
(module-add! *require-module* 'require *require-variable*)
(module-add! *require-module* 'require:require *require-variable*)
;;
(define *provided?-variable* (module-variable (current-module) 'provided?))
(module-add! *require-module* 'provided? *provided?-variable*)
(module-add! *require-module* 'require:provided? *provided?-variable*)

;; Load the slib require code into our deviously prepared receptacle...
(let ((load-module *load-module*))
  (dynamic-wind (lambda () (set! *load-module* *require-module*))
		(lambda () (try-load *require-pathname*))
		(lambda () (set! *load-module* load-module))))

;; Stash the slib version of these routines
(define slib-require (variable-ref *require-variable*))
(define slib-provide (variable-ref *provide-variable*))
(define slib-provided? (variable-ref *provided?-variable*))

;; Things not represented by separate interfaces (that are in the core)
(define *core-features*
  (do ((features *features* (cdr features))
       (core '()))
      ((null? features) core)
    (if (not (module-bound? *slib-library* (car features)))
	(set! core (cons (car features) core)))))

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

;; Require loads the given slib code into its own unique module in the slib
;; package, 
(define (require name)
  (if (not (memq name *core-features*))
      (let ((interface (module-ref *slib-library* name #f)))
	(if (not interface)
	    (let* (;; the new module to put the loaded code into
		   (module (find-module name *slib-package* make-slib-module))
		   ;; what to restore *load-module* to after loading
		   (old-load-module *load-module*)
		   ;; what to restore the current-module to after loading
		   (old-module (current-module))
		   ;; A list of things PROVIDEd by the module
		   (names (list name))
		   ;; A provide routine that stashes the names in NAMES
		   (%provide
		    (lambda (what)
		      (if (symbol? what)
			  (set! names (cons what (delq! what names))))
		      (slib-provide what)))
		   ;; what to restore the provide routine to
		   (old-provide (variable-ref *provide-variable*)))
	      (dynamic-wind
	       (lambda ()
		 (variable-set! *provide-variable* %provide)
		 (set! *load-module* module)
		 (set-current-module module))
	       (lambda ()
		 (slib-require name))
	       (lambda ()
		 (set-current-module old-module)
		 (set! *load-module* old-load-module)
		 (variable-set! *provide-variable* old-provide)))

	      ;; Make an interface to this module; although it has exactly
	      ;; the same contents as MODULE, we need a separate interface to
	      ;; avoid use-loops.
	      (set! interface (find-interface name *slib-package* #t))

	      ;; Export everything in the module to the interface
	      (module-export module interface)

	      ;; Alias the same interface under any other PROVIDEd names
	      (for-each (lambda (alias)
			  (if (not (eq? alias name))
			      (import-variable name *slib-package*
					       alias *slib-package*)))
			(cdr names))

	      ;; And export all of them from the slib library
	      (module-export *slib-package* *slib-library* names)))
	(module-use! (current-module) interface))))

(define (provided? feature)
  (or (and (symbol? feature) (module-bound? *slib-library* feature))
      (slib-provided? feature)))
