Common Lisp 函数 require 和 provide 源代码分析

===

涉及文件: l1-files.lisp l1-init.lisp 作者: FreeBlues 2013-08-19

===

0 概述

1 源代码:

2 代码分析

2.1 函数 provide 代码分析

2.2 函数 require 代码分析

2.3 其他辅助函数

0 概述

require 使用场景, 使用 quicklisp 安装好一个模块后,该模块实际上并未被自动加载到 lisp 映像中, 所以每次使用该模块之前, 需要执行 (require 模块名) 来加载该模块.

provide 使用场景, 自定义模块时, 需要在该模块代码最后一行执行 (provide 模块名) 来保证该模块被加载一次后就把模块名导入到 *module* 列表中.

require 用来加载一个模块到 lisp 映像, 如果它已经被加载过, 则保持原样, 不会重新加载(看起来跟 load 函数类似, 不过 load 需要输入文件路径和文件名, 而 require 则只要提供模块名就可以了). 可以指定加载路径, HyperSpec 中有如下几种形式:

Examples:

;;; This illustrates a nonportable use of REQUIRE, because it
;;; depends on the implementation-dependent file-loading mechanism.

(require "CALCULUS")

;;; This use of REQUIRE is nonportable because of the literal 
;;; physical pathname.  

(require "CALCULUS" "/usr/lib/lisp/calculus")

;;; One form of portable usage involves supplying a logical pathname,
;;; with appropriate translations defined elsewhere.

(require "CALCULUS" "lib:calculus")

;;; Another form of portable usage involves using a variable or
;;; table lookup function to determine the pathname, which again
;;; must be initialized elsewhere.

(require "CALCULUS" *calculus-module-pathname*)

其实, 也可以这么写:

    (require :CALCULUS)

provide 原来把一个 module 名字加入到 *module* 列表中, 如果已经存在则不加.

Emacs 中查看函数源代码方法: 在 REPL 中输入 (require ), 然后把光标停在 require 上, 按下 M-. 就可以打开 require 对应的源代码.

1 源代码:

(defun provide (module)
  "Adds a new module name to *MODULES* indicating that it has been loaded.
   Module-name is a string designator"
  (pushnew (string module) *modules* :test #'string=)
  module)

(defparameter *loading-modules* () "Internal. Prevents circularity")
(defparameter *module-provider-functions* '(module-provide-search-path)
  "A list of functions called by REQUIRE to satisfy an unmet dependency.
Each function receives a module name as a single argument; if the function knows 	
how to load that module, it should do so, add the module's name as a string to 
*MODULES* (perhaps by calling PROVIDE) and return non-NIL."
  )

(defun module-provide-search-path (module)
  ;; (format *debug-io* "trying module-provide-search-path~%")
  (let* ((module-name (string module))
         (pathname (find-module-pathnames module-name)))
    (when pathname
      (if (consp pathname)
        (dolist (path pathname) (load path))
        (load pathname))
      (provide module))))
  
(defun require (module &optional pathname)
  "Loads a module, unless it already has been loaded. PATHNAMES, if supplied,
   is a designator for a list of pathnames to be loaded if the module
   needs to be. If PATHNAMES is not supplied, functions from the list
   *MODULE-PROVIDER-FUNCTIONS* are called in order with MODULE-NAME
   as an argument, until one of them returns non-NIL.  User code is
   responsible for calling PROVIDE to indicate a successful load of the
   module."
  (let* ((str (string module))
	 (original-modules (copy-list *modules*)))
    (unless (or (member str *modules* :test #'string=)
		(member str *loading-modules* :test #'string=))
      ;; The check of (and binding of) *LOADING-MODULES* is a
      ;; traditional defense against circularity.  (Another
      ;; defense is not having circularity, of course.)  The
      ;; effect is that if something's in the process of being
      ;; REQUIREd and it's REQUIREd again (transitively),
      ;; the inner REQUIRE is a no-op.
      (let ((*loading-modules* (cons str *loading-modules*)))
	(if pathname
	  (dolist (path (if (atom pathname) (list pathname) pathname))
	    (load path))
	  (unless (some (lambda (p) (funcall p module))
			*module-provider-functions*)
	    (error "Module ~A was not provided by any function on ~S." module '*module-provider-functions*)))))
    (values module
	    (set-difference *modules* original-modules))))     
	    
(defun find-module-pathnames (module)
  "Returns the file or list of files making up the module"
  (let ((mod-path (make-pathname :name (string-downcase module) :defaults nil)) path)
        (dolist (path-cand *module-search-path* nil)
	  (let ((mod-cand (merge-pathnames mod-path path-cand)))
	    (if (wild-pathname-p path-cand)
		(let* ((untyped-p (member (pathname-type mod-cand) '(nil :unspecific)))
		       (matches (if untyped-p
				    (or (directory (merge-pathnames mod-cand *.lisp-pathname*))
					(directory (merge-pathnames mod-cand *.fasl-pathname*)))
				    (directory mod-cand))))
		  (when (and matches (null (cdr matches)))
		    (return (if untyped-p
				(make-pathname :type nil :defaults (car matches))
				(car matches)))))
		(when (setq path (find-load-file (merge-pathnames mod-path path-cand)))
		  (return path)))))))

(defun wild-pathname-p (pathname &optional field-key)
  "Predicate for determining whether pathname contains any wildcards."
  (flet ((wild-p (name) (or (eq name :wild)
                            (eq name :wild-inferiors)
                            (and (stringp name) (%path-mem "*" name)))))
    (case field-key
      ((nil)
       (or (some #'wild-p (pathname-directory pathname))
           (wild-p (pathname-name pathname))
           (wild-p (pathname-type pathname))
           (wild-p (pathname-version pathname))))
      (:host nil)
      (:device nil)
      (:directory (some #'wild-p (pathname-directory pathname)))
      (:name (wild-p (pathname-name pathname)))
      (:type (wild-p (pathname-type pathname)))
      (:version (wild-p (pathname-version pathname)))
      (t (wild-pathname-p pathname
                          (require-type field-key 
                                        '(member nil :host :device 
                                          :directory :name :type :version)))))))

2 代码分析

2.1 函数 provide 代码分析

本函数功能是把一个 module 名字加入到 *module* 中, 用来指示该 module 已经被加载, 最后返回(provide module) 中的参数 module.

主要代码就是这条语句:

(pushnew (string module) *modules* :test #'string=)

本函数代码中一个重要的辅助函数是 pushnew, 该函数和 push 类似, 是把一个对象和一个位置的对应保存在一个类似栈的列表中, 如果该对象已经在列表中, 就不会执行, 后面这个 :test 用来选择用于比较的函数.

参考: 函数 pushnew 的代码:

(defmacro pushnew (value place &rest keys &environment env)
  "Takes an object and a location holding a list. If the object is
  already in the list, does nothing; otherwise, conses the object onto
  the list. Returns the modified list. If there is a :TEST keyword, this
  is used for the comparison."
  (if (not (consp place))
    `(setq ,place (adjoin ,value ,place ,@keys))
    (let ((valvar (gensym)))
      (multiple-value-bind (dummies vals store-var setter getter)
                           (get-setf-method place env)
        `(let* ((,valvar ,value)
                ,@(mapcar #'list dummies vals)
                (,(car store-var) (adjoin ,valvar ,getter ,@keys)))
           ,@dummies
           ,(car store-var)
           ,setter)))))

本函数中的重要变量 *module* 是专门为 provide 和 require 函数准备的一个空列表, 用来保存那些已经被加载到 lisp 映像中的 module 名字(大小写敏感), 它的源代码在 l1-init.lisp 中, 具体内容如下:

(defvar *modules* nil
"This is a list of module names that have been loaded into Lisp so far.
The names are case sensitive strings.  It is used by PROVIDE and REQUIRE.")

2.2 函数 require 代码分析

(defun require (module &optional pathname) …)

输入参数为 module 和可选的路径名.

(let* ((str (string module))
	 (original-modules (copy-list *modules*)))

首先, 设置两个词法变量 str 和 original-modules, str 是把参数 module 转换为字符串形式, original-modules 则是把列表 *module* 的内容复制保存.

(unless (or (member str *modules* :test #'string=)
		(member str *loading-modules* :test #'string=))

接着, 是一个预防性判断, 要求只有当输入的参数名 module 不在 *modules* 和 *loading-modules* 两个列表中时, 才继续进行下一步, 否则说明该 module 已经被加载, 就不需要加载了.

(let ((*loading-modules* (cons str *loading-modules*)))

如果经过上述判断, module 不在 *modules* 和 *loading-modules* 两个列表中, 就把 module 加入 *loading-modules* 中, 并将其值赋予词法变量 *loading-modules* (注意, 这个 *loading-modules* 的作用范围仅仅局限于这个 let 后面的区域).

(if pathname
	  (dolist (path (if (atom pathname) (list pathname) pathname))
	    (load path))
	  (unless (some (lambda (p) (funcall p module))
			*module-provider-functions*)
	    (error "Module ~A was not provided by any function on ~S." module '*module-provider-functions*)))))

如果输入了 pathname 参数, 那么根据这个参数去构造一个 path, 最后用 load 来加载; 如果没有输入 pathname 参数, 则利用 *module-provider-functions* 中的函数来调用 module, 如果出错则返回错误信息.

(values module
	    (set-difference *modules* original-modules))))

最后这条语句作为整个 require 函数最后的返回值, 它使用 values 来返回多个值, 第一个值是 module 参数, 第二个值是一个列表, 比较了加载完 module 之后的 *modules* 和加载之前的 original-modules 列表的差异.

函数 set-difference 的具体表现可以看看下面这段示例:

CL-USER> (defparameter *list1* '(1 2 3 4))
*LIST1*
CL-USER> *list1*
(1 2 3 4)
CL-USER> (defparameter *list2* '(1 2 3 4 5 6))
*LIST2*
CL-USER> *list2*
(1 2 3 4 5 6)
CL-USER> (set-difference *list1* *list2*)
NIL
CL-USER> *list2*
(1 2 3 4 5 6)
CL-USER> *list1*
(1 2 3 4)
CL-USER> (set-difference *list2* *list1*)
(6 5)
CL-USER> *list1*
(1 2 3 4)
CL-USER> *list2*
(1 2 3 4 5 6)