(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") (IL:FILECREATED "22-May-91 09:10:07" IL:|{DSK}sources>lispcore>sources>CMLMODULES.;2| 2865 IL:|previous| IL:|date:| "12-Jun-90 16:56:18" IL:|{DSK}sources>lispcore>sources>CMLMODULES.;1|) ; Copyright (c) 1986, 1987, 1988, 1990, 1991 by Venue & Xerox Corporation. All rights reserved. (IL:PRETTYCOMPRINT IL:CMLMODULESCOMS) (IL:RPAQQ IL:CMLMODULESCOMS ((IL:VARIABLES *MODULES*) (IL:FUNCTIONS PROVIDE REQUIRE) (IL:PROP IL:FILETYPE IL:CMLMODULES) (IL:PROP IL:MAKEFILE-ENVIRONMENT IL:CMLMODULES))) (DEFVAR *MODULES* NIL "A list of all modules currently provided to the system.") (DEFUN PROVIDE (MODULE-NAME) "Declare that module-name is provided to the system." (DECLARE (SPECIAL *MODULES*)) (IF (SYMBOLP MODULE-NAME) (SETQ MODULE-NAME (SYMBOL-NAME MODULE-NAME))) (PUSHNEW MODULE-NAME *MODULES* :TEST (FUNCTION STRING=)) MODULE-NAME) (DEFUN REQUIRE (MODULE-NAME &OPTIONAL (PATHNAME NIL)) "Declare that module-name is needed. If already loaded do nothing. If not, load using the pathname, which is a single pathname or list of pathnames. If pathname is not provided use the system default paths (*default-pathname-defaults* and directories)." (DECLARE (SPECIAL *MODULES* *DEFAULT-PATHNAME-DEFAULTS* IL:DIRECTORIES IL:*COMPILED-EXTENSIONS*)) (UNLESS (MEMBER MODULE-NAME *MODULES* :TEST (FUNCTION STRING=)) (LET (PATHNAMES) (LABELS ((TRY (PATHNAME) (OR (IL:* IL:\; "first look for a compiled file") (TRY-MANY PATHNAME IL:*COMPILED-EXTENSIONS*) (IL:* IL:\; "then for a source file") (TRY-MANY PATHNAME (LIST NIL)) (CERROR "Don't load file ~S~*." "Can't find file ~S for required module ~S." PATHNAME MODULE-NAME))) (TRY-MANY (PATHNAME TYPES) (IL:* IL:|;;| "look first on connected directory, then IL:DIRECTORIES") (DOLIST (DIRECTORY (CONS *DEFAULT-PATHNAME-DEFAULTS* IL:DIRECTORIES)) (DOLIST (TYPE TYPES) (WHEN (TRY-ONE (MERGE-PATHNAMES PATHNAME (MAKE-PATHNAME :TYPE TYPE :DEFAULTS DIRECTORY))) (RETURN-FROM TRY-MANY T))))) (TRY-ONE (PATHNAME) (IL:* IL:|;;| "don't try any pathname more than once") (UNLESS (MEMBER PATHNAME PATHNAMES :TEST (QUOTE EQUAL)) (PUSH PATHNAME PATHNAMES) (WHEN (PROBE-FILE PATHNAME) (UNLESS (FIND (IL:PACKFILENAME (QUOTE IL:DIRECTORY) (FORMAT NIL "{~a}~a" (PATHNAME-HOST PATHNAME) (PATHNAME-DIRECTORY PATHNAME)) (QUOTE IL:BODY) (PATHNAME-NAME PATHNAME) (QUOTE IL:VERSION) (PATHNAME-VERSION PATHNAME)) IL:LOADEDFILELST) (LOAD PATHNAME)) T)))) (DOLIST (PATHNAME (ETYPECASE PATHNAME (NULL (LIST MODULE-NAME)) ((OR SYMBOL STRING PATHNAME) (LIST PATHNAME)) (LIST PATHNAME)) T) (TRY PATHNAME)))))) (IL:PUTPROPS IL:CMLMODULES IL:FILETYPE :COMPILE-FILE) (IL:PUTPROPS IL:CMLMODULES IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE "LISP")) (IL:PUTPROPS IL:CMLMODULES IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991)) (IL:DECLARE\: IL:DONTCOPY (IL:FILEMAP (NIL))) IL:STOP