Common Lisp 函數 require 和 provide 源代碼分析

時間 2019-11-12

標籤 common lisp 函數 require provide 源代碼分析简体版

原文原文鏈接

Common Lisp 函數 require 和 provide 源代碼分析

===app

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

===ide

0 概述

1 源代碼:

2 代碼分析

2.1 函數 provide 代碼分析

2.2 函數 require 代碼分析

2.3 其餘輔助函數

0 概述

require 使用場景, 使用 quicklisp 安裝好一個模塊後,該模塊實際上並未被自動加載到 lisp 映像中, 因此每次使用該模塊以前, 須要執行 (require 模塊名) 來加載該模塊.函數

provide 使用場景, 自定義模塊時, 須要在該模塊代碼最後一行執行 (provide 模塊名) 來保證該模塊被加載一次後就把模塊名導入到 *module* 列表中.ui

require 用來加載一個模塊到 lisp 映像, 若是它已經被加載過, 則保持原樣, 不會從新加載(看起來跟 load 函數相似, 不過 load 須要輸入文件路徑和文件名, 而 require 則只要提供模塊名就能夠了). 能夠指定加載路徑, HyperSpec 中有以下幾種形式:this

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*)

其實, 也能夠這麼寫:atom

(require :CALCULUS)

provide 原來把一個 module 名字加入到 *module* 列表中, 若是已經存在則不加.debug

Emacs 中查看函數源代碼方法: 在 REPL 中輸入 (require ), 而後把光標停在 require 上, 按下 M-. 就能夠打開 require 對應的源代碼.rest

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.code

主要代碼就是這條語句:

(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)