;;AUTOLOAD: provide
;;AUTOLOAD: require
;;AUTOLOAD: unrequire
;;AUTOLOAD: *modules*

;;AUTODOC: provide "testifies that a package is loaded"
;;(provide 'modulename)
;;
;;Should be called by a package with one argument (symbol) to insures that 
;;the package has been loaded

;;AUTODOC: require "insures that a package is loaded"
;;(require 'modulename)
;;
;;Should be called each time a module is required by another
;;loads the file and calls <modulename>:load-hook if exists

;;AUTODOC: unrequire "allows unloading of a module"
;;(unrequire 'modulename)
;;
;;Should be called after requiring a module once not needed anymore.
;;will call <modulename>:unload-hook if exists, and then makunbound of all 
;;the symbols in the <modulename> package

;;AUTODOC: *modules* "list of loaded packages"
;;Hashtable of loaded module names and the number of currently present 
;;packages requiring it

;; needs the file basename.kl for the function file-basename

;; modules is a hashtable of loaded modules indexed by atoms
;; and with value the refcount of people needing it.

(defvar *modules* (Hashtable ()))

(defun provide (name)
  (set name (intern (file-basename name)))
  (if (not (getn *modules* name))
    (put *modules* name 0)
))

(defun require (name)
  (set name (intern (file-basename name)))
  (if (getn *modules* name) 
    ;; already loaded
    (with (count (get *modules* name 0))
      (put *modules* name (+ count 1))
    )
    ;; not there: attempt to load it
    (with (
	hook (intern (+ name ":load-hook"))
	require:succesful ()
      )
      (unwind-protect (progn
	  (put *modules* name 1)	; do it here to prevent loops
	  (load name)			; load with name in module
	  (setq require:succesful t)
	  (if (and (boundp hook) (typep (eval hook) Function))
	    (catch 'ALL (apply hook ()))
	  )
	)
	;; always executed, inside the inner with in case of error
	(if (not require:succesful)	; clean
	  (delete *modules* name)
)))))

(defun unrequire (name)
  (set name (intern (file-basename name)))
  (if (getn *modules* name) 
    (with (count (get *modules* name 0))
      (incf count -1)
      (if (= 0 count)
	(with (hook (intern (+ name ":unload-hook"))
	    re (regcomp (+ "^" (quote-string-for-regexp name) ":"))
	  )
	  (if (and (boundp hook) (typep (eval hook) Function))
	    (catch 'ALL (apply hook ()))
	  )
	  (delete *modules* name)
	  (do-all-symbols (s)
	    (if (regexec re s)
	      (makunbound s)
	  ))
	)
	;; no free, just decrement
	(put *modules* name count)
    ))
))

