home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / lsp / module.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1994-05-07  |  2.4 KB  |  82 lines
  1. ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  2.  
  3. ;; This file is part of GNU Common Lisp, herein referred to as GCL
  4. ;;
  5. ;; GCL is free software; you can redistribute it and/or modify it under
  6. ;;  the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  7. ;; the Free Software Foundation; either version 2, or (at your option)
  8. ;; any later version.
  9. ;; 
  10. ;; GCL is distributed in the hope that it will be useful, but WITHOUT
  11. ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  12. ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  13. ;; License for more details.
  14. ;; 
  15. ;; You should have received a copy of the GNU Library General Public License 
  16. ;; along with GCL; see the file COPYING.  If not, write to the Free Software
  17. ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19.  
  20. ;;;;    module.lsp
  21. ;;;;
  22. ;;;;                            module routines
  23.  
  24.  
  25. (in-package 'lisp)
  26.  
  27. (export '(*modules* provide require))
  28. (export 'documentation)
  29. (export '(variable function structure type setf))
  30.  
  31. (in-package 'system)
  32.  
  33.  
  34. (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
  35.  
  36.  
  37. (defvar *modules* nil)
  38.  
  39.  
  40. (defun provide (module-name)
  41.   (setq *modules*
  42.         (adjoin (string module-name)
  43.                 *modules*
  44.                 :test #'string=)))
  45.  
  46.  
  47. (defun require (module-name
  48.                 &optional (pathname (string-downcase (string module-name))))
  49.   (let ((*default-pathname-defaults* #""))
  50.     (unless (member (string module-name)
  51.                     *modules*
  52.                     :test #'string=)
  53.             (if (atom pathname)
  54.                 (load pathname)
  55.                 (do ((p pathname (cdr p)))
  56.                     ((endp p))
  57.                   (load (car p)))))))
  58.           
  59.  
  60. (defun documentation (symbol doc-type)
  61.   (case doc-type
  62.     (variable (get symbol 'variable-documentation))
  63.     (function (get symbol 'function-documentation))
  64.     (structure (get symbol 'structure-documentation))
  65.     (type (get symbol 'type-documentation))
  66.     (setf (get symbol 'setf-documentation))
  67.     (t (error "~S is an illegal documentation type." doc-type))))
  68.  
  69.  
  70. (defun find-documentation (body)
  71.   (if (or (endp body) (endp (cdr body)))
  72.       nil
  73.       (let ((form (macroexpand (car body))))
  74.         (if (stringp form)
  75.             form
  76.             (if (and (consp form)
  77.                      (eq (car form) 'declare))
  78.                 (find-documentation (cdr body))
  79.                 nil)))))
  80.  
  81.  
  82.