← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/lsp/module.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-05-17 02:46:26 UTC
  • Revision ID: james.westby@ubuntu.com-20060517024626-lljr08ftv9g9vefl
Tags: upstream-0.9h-20060510
Import upstream version 0.9h-20060510

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/lsp/module.lsp
 
1
;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
 
2
;;;;  Copyright (c) 1990, Giuseppe Attardi.
 
3
;;;;
 
4
;;;;    This program is free software; you can redistribute it and/or
 
5
;;;;    modify it under the terms of the GNU Library General Public
 
6
;;;;    License as published by the Free Software Foundation; either
 
7
;;;;    version 2 of the License, or (at your option) any later version.
 
8
;;;;
 
9
;;;;    See file '../Copyright' for full details.
 
10
 
 
11
;;;;    module routines
 
12
 
 
13
;; This is taken from SBCL's code/module.lisp which is in the public
 
14
;; domain.
 
15
 
 
16
(in-package "SYSTEM")
 
17
 
 
18
;;;; exported specials
 
19
 
 
20
(defvar *modules* ()
 
21
  "This is a list of module names that have been loaded into Lisp so far.
 
22
   It is used by PROVIDE and REQUIRE.")
 
23
 
 
24
(defvar *module-provider-functions* nil
 
25
  "See function documentation for REQUIRE")
 
26
 
 
27
;;;; PROVIDE and REQUIRE
 
28
 
 
29
(defun provide (module-name)
 
30
  "Adds a new module name to *MODULES* indicating that it has been loaded.
 
31
   Module-name is a string designator"
 
32
  (pushnew (string module-name) *modules* :test #'string=)
 
33
  t)
 
34
 
 
35
(defvar *requiring* nil)
 
36
 
 
37
(defun require-error (control &rest arguments)
 
38
  (error "Module error: ~?" control arguments))
 
39
 
 
40
(defun require (module-name &optional pathnames)
 
41
  "Loads a module, unless it already has been loaded. PATHNAMES, if supplied,
 
42
   is a designator for a list of pathnames to be loaded if the module
 
43
   needs to be. If PATHNAMES is not supplied, functions from the list
 
44
   *MODULE-PROVIDER-FUNCTIONS* are called in order with MODULE-NAME
 
45
   as an argument, until one of them returns non-NIL.  User code is
 
46
   responsible for calling PROVIDE to indicate a successful load of the
 
47
   module."
 
48
  (let ((name (string module-name)))
 
49
    (when (member name *requiring* :test #'string=)
 
50
      (require-error "~@<Could not ~S ~A: circularity detected. Please check ~
 
51
                     your configuration.~:@>" 'require module-name))
 
52
    (let ((saved-modules (copy-list *modules*))
 
53
          (*requiring* (cons name *requiring*)))
 
54
      (unless (member name *modules* :test #'string=)
 
55
        (cond (pathnames
 
56
               (unless (listp pathnames) (setf pathnames (list pathnames)))
 
57
               ;; ambiguity in standard: should we try all pathnames in the
 
58
               ;; list, or should we stop as soon as one of them calls PROVIDE?
 
59
               (dolist (ele pathnames t)
 
60
                 (load ele)))
 
61
              (t
 
62
               (unless (some (lambda (p) (funcall p module-name))
 
63
                             *module-provider-functions*)
 
64
                 (require-error "Don't know how to ~S ~A."
 
65
                                'require module-name)))))
 
66
      (set-difference *modules* saved-modules))))
 
67
 
 
68
(pushnew #'(lambda (module)
 
69
             (let* ((sysdir (translate-logical-pathname #P"SYS:"))
 
70
                    (module (string module)))
 
71
               (or
 
72
                (let ((path (merge-pathnames (make-pathname :name module) sysdir)))
 
73
                  (load path :if-does-not-exist nil))
 
74
                (let ((path (merge-pathnames (make-pathname :name (string-downcase module)) sysdir)))
 
75
                  (load path :if-does-not-exist nil)))))
 
76
         *module-provider-functions*)