(defmacro pkgrec-category (pkgrec) ...)
(defmacro pkgrec-name (pkgrec) ...)
(defmacro pkgrec-version (pkgrec) ...)
(defmacro pkgrec-locaux (pkgrec) ...)
(defmacro pkgrec-grplst (pkgrec) ...)
(defmacro pkgrec-uselst (pkgrec) ...)
(defmacro pkgrec-iuse_effective (pkgrec) ...)
(defmacro pkgrec-slot-regular (pkgrec) ...)
(defmacro pkgrec-slot-sub (pkgrec) ...)
(defmacro pkgrec-depnode-bdep (pkgrec) ...)
(defmacro pkgrec-depnode-idep (pkgrec) ...)
(defmacro pkgrec-depnode-rdep (pkgrec) ...)
(defmacro pkgrec-depnode-pdep (pkgrec) ...)
(defmacro pkgrec-depnode (pkgrec class-idx) ...)
(defmacro pkgrec-reverse-bdep (pkgrec) ...)
(defmacro pkgrec-reverse-idep (pkgrec) ...)
(defmacro pkgrec-reverse-rdep (pkgrec) ...)
(defmacro pkgrec-reverse-pdep (pkgrec) ...)
(defmacro pkgrec-reverse (pkgrec class-idx) ...)
(defmacro pkgrec-status (pkgrec) ...)


;; <依赖说明符节点*> 成员索引宏：
(defmacro depnode-type (n)
  `(caar ,n))
(defmacro depnode-content (n)
  `(cdar ,n))
(defmacro depnode-match (n)
  `(cdr ,n))
;; <依赖说明符节点*> 创建宏：
(defmacro mk-depnode (stype content &optional (match nil))
  `(cons (cons ,stype ,content) ,match))


;; <反向匹配> 成员索引宏：
(defmacro revmatch-category (r)
  `(car ,r))
(defmacro revmatch-pkgname (r)
  `(cadr ,r))
(defmacro revmatch-version (r)
  `(caddr ,r))
(defmacro revmatch-pathlist (r)
  `(cadddr ,r))



;; 选中的仓库列表
(defparameter *selected-repo-list* ...)


;; ebuild 变量缓存
;  拉入 ebuild 得到的变量的记录表。
;  在搜索功能中用于承接从文件中读出的变量缓存，
;  在安装软件包时用于缓存每个 ebuild 被拉入得到的变量。
;  格式如下：
;  ((<软件包定位符> . <bash declare -p 列表>)...)
;  <软件包定位符>：
;	(<仓库名称> <类别名称> <非限定的软件包名称> <版本字符串> <形式>)
;	编码名称：locator。reponame，category，pkgname，vstr，form
(defparameter *ebuild-variable-cache* ...)
; 引用：
;	* search-package (find "DESCRIPTION" ...) 第二个参数
;	* install-op-cons 中 ebuild-env-vars 的第一次赋值
;	* install-op-cons 中拉入 ebuild 或环境脚本后对缓存的更新
;; [TODO] 将 parse-bash-declare 返回值的格式定义成 <bash declare -p 列表>：
;         (<declare>...)
;         <declare> --- (<属性选项> <变量名> <变量值>)
;         编码名称：declare，attribute，name，value



;; 满足应用标志依赖可以无视系统轮廓的应用标志控制
;  如果对于某个应用标志必须启用还是必须禁用，根据应用标志依赖和根据系统轮廓的应用标志控制作出的决策相悖，那么
;  当此变量为 nil 时，该项应用标志依赖无法满足
;  当此变量为 t 时，无视该项应用标志控制
; (defparameter *dep-use>pf-usectrl* t)

;; (易构建)软件包管理器给出的 EPREFIX 变量默认值
;  EPREFIX 变量正常情况下应该由系统轮廓的构建配置赋值，
;  在安装非二进制包时，如果系统轮廓的构建配置没有赋值，则使用软件包管理器给出的默认值
;  默认值是根目录，不以斜杠结尾，用空字符串表示
; (defconstant *eprefix-pm-default "")



;; 搜索软件包
;   找出仓库中所有非限定软件包名称
;   或描述（check-desc-p 为 nil 时忽略）
;   与模式相匹配的软件包。
;   匹配规则暂定有两种：字符串相等和字符串包含，
;   软件包名称的匹配规则根据参数选择，描述的匹配规则始终采用第二种。
;; 参数：
;;	repo		执行搜索的仓库名称列表，:selected 表示在 *selected-repo-list* 中搜索
;;	category	执行搜索的类别名称列表，nil 表示在所有类别中搜索
;;	pattern	模式字符串
;;	pkg-name-mr	软件包名称的匹配规则，取值为：
;;				:=	表示字符串相等
;;				:>	表示字符串包含
;;	check-desc-p	是否检查软件包的描述能否匹配
;; 返回值：
;;	一个 <软件包定位符> 列表
(defun search-package (repo category pattern pkg-name-mr &optional check-desc-p)
  ;; 将 repo 处理成 <仓库> 列表
  (if (eql repo :selected)
    (setf repo *selected-repo-list*)
    (let ((name repo))
      (setf repo nil)
      (dolist (n name)
        (setf repo (nconc repo (list (find n *repo-list* :key #'(lambda (r) (repo-name r)) :test #'string=)))))))
  ;;
  (if (eql pkg-name-mr :=)
    (setf pkg-name-mr #'string=)
    (setf pkg-name-mr #'kmp-search))
  (let (pkg-locator-list)
    (dolist (r repo pkg-locator-list)
      (dolist (cate (repo-categories r))
        (when (or (null category)
                  (string= (category-name cate) category))
          (dolist (d (category-pkgdirlist cate))
            (dolist (loc (pkgdir-locauxlist d))
              (let ((pkg-locator (list (repo-name r)
                                       (category-name cate)
                                       (pkgdir-name d)
                                       (locaux-form loc)
                                       (locaux-vstr loc))))
                (if (funcall pkg-name-mr (pkgdir-name d) pattern)
                  (setf pkg-locator-list (nconc pkg-locator-list (list pkg-locator)))
                  (when check-desc-p
                    (let ((desc (declare-value (find "DESCRIPTION"
                                                     (cdr (assoc pkg-locator *ebuild-variable-cache*
                                                                 :test #'equal))
                                                     :key #'(lambda (declare)
                                                              (declare-name declare))
                                                     :test #'string=))))
                      (when (and desc (kmp-search desc pattern))
                        (setf pkg-locator-list (nconc pkg-locator-list (list pkg-locator)))))))))))))))



;; 检查软件包是否屏蔽
;; 参数：
;;	repo		<仓库>
;;	category	类别
;;	pkgname	非限定的软件包名称
;;	version	<软件包版本>
;; 返回值：
;;	t 或 nil
(defun pkg-maskp (repo category pkgname version)
  (let ((pf (assoc (repo-active-profile repo)
                   (repo-profiles repo)
                   :test #'string=)))
    (mask-maskp (find-if #'(lambda (m)
                             (eql (depend*-match (mask-depspec m)
                                                 category pkgname version
                                                 nil nil nil nil)
                                  t))
                         (profile-package.mask pf)
                         :from-end t))))



;; [TODO,暂缓] 为数据结构的成员访问引宏 定义访问函数，名称为宏名后加“-f”
;; [TODO]
;  (defmacro category-name (c)
;    `(car ,c))
;  (defmacro category-pkgdirlist (c)
;    `(cdr ,c))
;; [TODO]
;  repo.txt：
-  <软件包目录> --- (<非限定的软件包名称> . ((<形式> . <版本字符串>)...))
+  <软件包目录> --- (<非限定的软件包名称> . (<软件包辅助定位信息>...))
+  <软件包辅助定位信息> --- (<形式> . <版本字符串>)
;; [TODO]
;  (defmacro pkgdir-name (d)
;    `(car ,d))
;  (defmacro pkgdir-locauxlist (d)
;    `(cdr ,d))
;  (defmacro mk-locaux (form vstr)
;    `(cons ,form ,vstr))
;  (defmacro locaux-form (loc)
;    `(car ,loc))
;  (defmacro locaux-vstr (loc)
;    `(cdr ,loc))
;; [TODO]
;  <软件包屏蔽列表> --- (<软件包屏蔽>...)，编码名称：package.mask
;  <软件包屏蔽> --- (<软件包依赖说明符> . <屏蔽?>)
;  (defmacro mask-depspec (m)
;    `(car ,m))
;  (defmacro mask-maskp (m)
;    `(cdr ,m))




;; 计算“子串最长公共前后缀长度”表
;; 参数：
;;	pattern	一个字符串
;; 返回值：
;;	一个向量
(defun kmp-next (pattern)
  (do* ((pattern-len (length pattern))
        (next (make-array pattern-len :initial-element 0))
        (idx 1)
        (max-common-len 0))
    ((>= idx pattern-len) next)
    (if (char= (char pattern idx)
               (char pattern max-common-len))
      (setf (svref next idx) (incf max-common-len)
            idx (1+ idx))
      (if (zerop max-common-len)
        (setf (svref next idx) 0
              idx (1+ idx))
        (setf max-common-len (svref next (1- max-common-len)))))))

;; 字符串搜索
;; 参数：
;;	text		待搜索的字符串
;;	pattern	目标字符串，非空
;;	start		搜索起始索引
;; 返回值：
;;	找到目标字符串则返回它的首字符索引，
;;	找不到则返回 nil
(defun kmp-search (text pattern &key (start 0))
  (do* ((text-len (length text))
        (pattern-len (length pattern))
        (next (kmp-next pattern))
        (i 0))
    ((or (>= start text-len)
         (= i pattern-len))
     (when (= i pattern-len)
       (- start pattern-len)))
    (if (char= (char text start) (char pattern i))
      (setf start (1+ start) i (1+ i))
      (if (zerop i)
        (incf start)
        (setf i (svref next (1- i)))))))



;; 限定的软件包名称转类别和非限定的软件包名称宏
(defmacro qpkgname-category (qpkgname)
  `(car (string-split ,qpkgname #\/)))
(defmacro qpkgname-pkgname (qpkgname)
  `(cadr (string-split ,qpkgname #\/)))

;; 构建操作创建宏
(defmacro mk-build-op (pkgrec)
  `(list :build ,pkgrec))
;; 合并操作创建宏
(defmacro mk-merge-op (pkgrec pkgrec-list)
  `(list :merge ,pkgrec ,pkgrec-list))
;; 配置软件包操作创建宏
(defmacro mk-config-op (pkgrec)
  `(list :config ,pkgrec))
;; 卸载操作创建宏
(defmacro mk-uninstall-op (pkgrec)
  `(list :uninstall ,pkgrec))



;; 软件包安装，升级，降级或重装操作构造
;; 参数：
;;	depspec*		<软件包依赖说明符*>
;;	install-root		软件包将要安装到的根目录的绝对路径(不以斜杠结尾)
;;	group-list		所属分组列表
;;	target			主调函数的目标
;;	pkgrlst			用于推演的 <软件包记录> 表
;;	post-list		推迟完成列表(每一项是一个<待完成节点>)
;;	install-pdep-p		是否安装弱运行依赖
;; 返回值：
;;	1. 主返回值
;;	2. <软件包记录> 表
;;	3. 指示符/<回滚函数>
;;	4. [仅成功返回]新推迟完成列表
;;
;;	* 第 3 个返回值等于 :error 表示函数执行失败，
;;	  此时主返回值是一个 <错误描述节点>，<软件包记录> 表是已回滚的 <软件包记录> 表，并且没有第 4 个返回值；
;;	  第 3 个返回值不等于 :error 表示函数执行成功，
;;	  此时主返回值是新构造出来的操作列表，<软件包记录> 表是推演得到的 <软件包记录> 表，第 3 个返回值是 <回滚函数>
;;	* <回滚函数> 是一个将软件包记录表回滚到推演前的状态的函数，
;;	  参数为一个待回滚的软件包记录表，返回值是回滚后的软件包记录表
(defun install-op-cons (depspec* install-root group-list target pkgrlst post-list &optional install-pdep-p)
  (let* ((category (qpkgname-category (depspec-qpkgname depspec*)))
         (pkgname (qpkgname-pkgname (depspec-qpkgname depspec*)))
         (hxlist (search-package :selected category pkgname := nil))
         error-lvl1)
    ;; 得到候选软件包列表
    ;  [!] 这里是从选中的仓库列表中搜索，因此主调函数须事先将 *selected-repo-list* 设为选中的仓库列表；
    ;      并且考虑到不同仓库中可能存在限定软件包名称和版本都相同的软件包，
    ;      主调函数必须确保 *selected-repo-list* 中的仓库是按照优先级降序排列，同时此处按照版本降序排序的时候使用的是稳定排序
    (dolist (hxpkg hxlist)
      (setf (cdr (last hxpkg)) (list (cons (parse-version (locator-vstr hxpkg))
                                           (find (locator-reponame hxpkg) *repo-list*
                                                 :key #'(lambda (r) (repo-name r)) :test #'string=)))))
    (setf hxlist (delete-if #'(lambda (p)
                                (let ((repo (car (last p))) ver (form (locator-form p)))
                                  (setf ver (car repo) repo (cdr repo))
                                  (or (pkg-maskp repo category pkgname ver)
                                      (not (eql (depend*-match depspec* category pkgname ver nil nil nil nil)
                                                t))
                                      (and (stringp form)
                                           (string/= form *host-architecture*)
                                           (string/= form *keyword-all)))))
                            hxlist))	; 剔除已屏蔽的和版本不满足要求的软件包，以及架构不匹配的二进制包
    (unless hxlist
      (return-from install-op-cons (values (mk-errnode depspec* :not-found nil) pkgrlst :error)))
    (setf hxlist (stable-sort hxlist #'(lambda (a b) (> (version-compare a b) 0)) :key #'(lambda (l) (caar (last l))))
          error-lvl1 (mk-errnode depspec* t nil))
    ;; 遍历候选软件包
    (dolist (hxpkg hxlist)
      (let ((repo (car (last hxpkg))) version (form (locator-form hxpkg)) ebuild-env-vars
            regular-slot sub-slot old-pkgrec-list iuse-effective use-enable-list
            error-lvl2)
        (do ((p hxpkg (cdr p)))
          ((eql (cadr p) repo) (setf (cdr p) nil)))
        (setf version (car repo)
              repo (cdr repo)
              error-lvl2 (mk-errnode hxpkg t nil))
        ;; EAPI 检查
        (unless (check-eapi hxpkg)
          (setf (errnode-errinfo error-lvl2) :unsupported-eapi		; 不支持的 EAPI
                (errnode-sublvldesc error-lvl1) (nconc (errnode-sublvldesc error-lvl1) (list error-lvl2)))
          (go hxpkg-level-end))
        ;; 拉入 ebuild 或环境脚本
        (unless (setf ebuild-env-vars (cdr (assoc hxpkg *ebuild-variable-cache* :test #'equal)))
          (if (stringp form)
            (setf ebuild-env-vars (source-binpkg-env (repo-name repo)
                                                     category
                                                     pkgname
                                                     (locator-vstr hxpkg)
                                                     form
                                                     install-root))
            (setf ebuild-env-vars (source-ebuild (repo-name repo)
                                                 category
                                                 pkgname
                                                 (locator-vstr hxpkg)
                                                 form
                                                 t)))
          (setf *ebuild-variable-cache* (nconc *ebuild-variable-cache* (list (cons hxpkg ebuild-env-vars)))))
        (when (eql ebuild-env-vars :error)
          (setf (errnode-errinfo error-lvl2) :source-error		; 拉入 ebuild 或环境脚本错误
                (errnode-sublvldesc error-lvl1) (nconc (errnode-sublvldesc error-lvl1) (list error-lvl2)))
          (go hxpkg-level-end))
        ;; 平台检查
        (let ((keywords (declare-value (find "KEYWORDS" ebuild-env-vars
                                             :key #'(lambda (d) (declare-name d))
                                             :test #'string=)))
              stability)
          (when (or (null keywords)
                    (eql (setf stability (pkg-stability keywords (repo-arch.list repo)))
                         :error))
            (setf (errnode-errinfo error-lvl2) :keywords-error	; KEYWORDS 错误
                  (errnode-sublvldesc error-lvl1) (nconc (errnode-sublvldesc error-lvl1) (list error-lvl2)))
            (go hxpkg-level-end))
          (unless (eql stability t)
            (setf (errnode-errinfo error-lvl2) :not-stable		; 候选软件包不是稳定版
                  (errnode-sublvldesc error-lvl1) (nconc (errnode-sublvldesc error-lvl1) (list error-lvl2)))
            (go hxpkg-level-end)))
        ;; [TODO]许可证检查
        ;; 检查是否有应替换的软件包记录
        (setf regular-slot (declare-value (find "SLOT" ebuild-env-vars
                                                :key #'(lambda (d) (declare-name d))
                                                :test #'string=)))
        (let ((p (position #\/ regular-slot :test #'char=)))
          (if p
            (setf sub-slot (subseq regular-slot (1+ p))
                  regular-slot (subseq regular-slot 0 p))
            (setf sub-slot regular-slot)))
        (setf old-pkgrec-list (mapcan #'(lambda (rec)
                                          (when (and (string= (concatenate 'string
                                                                           (pkgrec-category rec) "/"
                                                                           (pkgrec-name rec))
                                                              (depspec-qpkgname depspec*))
                                                     (string= (pkgrec-slot-regular rec) regular-slot))
                                            (list rec)))
                                      pkgrlst))
        (when (find-if #'(lambda (rec)
                           (not (eql (pkgrec-status rec)
                                     :installed)))
                       old-pkgrec-list)
          (setf (errnode-errinfo error-lvl2) :nrdep-loop	; 非强运行循环依赖
                (errnode-sublvldesc error-lvl1) (nconc (errnode-sublvldesc error-lvl1) (list error-lvl2)))
          (go hxpkg-level-end))
        ;; 计算启用的应用标志组合列表
        (let ((iuse (declare-value (find "IUSE" ebuild-env-vars
                                         :key #'(lambda (d) (declare-name d))
                                         :test #'string=)))
              (pf (assoc (repo-active-profile repo) (repo-profiles repo) :test #'string=)))
          (setf iuse-effective (calc-iuse-effective (if iuse iuse "") (profile-make.defaults pf)))
          (multiple-value-bind (use+ use-) (calc-use-bianjie depspec* pf iuse-effective t)
            (unless (listp use+)
              (setf (errnode-errinfo error-lvl2) :usedep-error		; 应用标志依赖无法满足或无效
                    (errnode-sublvldesc error-lvl1) (nconc (errnode-sublvldesc error-lvl1) (list error-lvl2)))
              (go hxpkg-level-end))
            (let* ((required-use (declare-value (find "REQUIRED_USE" ebuild-env-vars
                                                      :key #'(lambda (d) (declare-name d)) :test #'string=))))
              (if (stringp form)
                (setf use-enable-list (string-split
                                        (declare-value (find "USE" ebuild-env-vars
                                                             :key #'(lambda (d) (declare-name d))
                                                             :test #'string=))
                                        #\Space)
                      use-enable-list (if (or (nset-difference use+ use-enable-list :test #'string=)
                                              (nintersection use- use-enable-list :test #'string=))
                                        :cant-satisfy
                                        (list use-enable-list)))
                (setf use-enable-list (calc-use-enable (if required-use required-use "")
                                                       iuse-effective
                                                       use+
                                                       use-
                                                       (if iuse iuse "")))))))
        (unless (listp use-enable-list)
          (setf (errnode-errinfo error-lvl2) :usedep-error	; 应用标志依赖无法满足或无效
                (errnode-sublvldesc error-lvl1) (nconc (errnode-sublvldesc error-lvl1) (list error-lvl2)))
          (go hxpkg-level-end))
        ;; 遍历各个启用的应用标志组合
        (dolist (use-enable use-enable-list)
          ;; 检查是否和目标相悖
          (let ((blk-dep (mapcan #'(lambda (d) (if (depspec-blockp d) (list d) nil)) target)))
            (when (find-if #'(lambda (d) (eql (depend*-match d category pkgname version
                                                             regular-slot sub-slot
                                                             use-enable iuse-effective t)
                                              t))
                           blk-dep)
              (setf (errnode-sublvldesc error-lvl2)			; 与上层目标相悖
                    (nconc (errnode-sublvldesc error-lvl2)
                           (list (mk-errnode use-enable :target-conflict nil))))
              (go use-level-end)))
          ;; 执行 pkg_pretend
          (when (/= (run-pkg-pretend hxpkg use-enable ebuild-env-vars install-root) 0)
            (setf (errnode-sublvldesc error-lvl2)			; pkg_pretend 错误
                  (nconc (errnode-sublvldesc error-lvl2)
                         (list (mk-errnode use-enable :pkg_pretend-error nil))))
            (go use-level-end))
          ;;
          (let ((rollback-func #'identity) new-pkgrec new-op-list (error-lvl3 (mk-errnode use-enable t nil))
                xuankong-list new-post-list)
            ;; 从 <软件包记录> 表中删除将要被替换的软件包记录
            (dolist (rec old-pkgrec-list)
              (setf pkgrlst (delete-pkg-record pkgrlst rec))
              (let ((func rollback-func) (x rec))
                (setf rollback-func (lambda (rlst) (funcall func (cons x rlst))))))
            ;; 新增软件包记录
            (multiple-value-bind (a b) (new-pkg-record pkgrlst
                                                       category
                                                       pkgname
                                                       version
                                                       form
                                                       (locator-vstr hxpkg)
                                                       group-list
                                                       use-enable
                                                       iuse-effective
                                                       regular-slot
                                                       sub-slot
                                                       ebuild-env-vars)
              (unless b
                (setf (errnode-errinfo error-lvl3) :cons-pkgrec-failed		; <软件包记录> 构造失败
                      (errnode-sublvldesc error-lvl2) (nconc (errnode-sublvldesc error-lvl2) (list error-lvl3)))
                (setf pkgrlst (funcall rollback-func pkgrlst))
                (go use-level-end))
              (setf new-pkgrec a
                    pkgrlst b)
              (let ((func rollback-func))
                (setf rollback-func (lambda (rlst) (funcall func (delete-pkg-record rlst a))))))
            ;; 解除将要被替换的软件包记录的构建匹配关系
            (dolist (rec old-pkgrec-list)
              (free-match pkgrlst rec 0)
              (let ((func rollback-func) (x rec))
                (setf rollback-func (lambda (rlst) (establish-match rlst x 0) (funcall func rlst)))))
            ;; 为新软件包记录建立构建依赖的匹配关系
            (establish-match pkgrlst new-pkgrec 0)
            (let ((func rollback-func) (x new-pkgrec))
              (setf rollback-func (lambda (rlst) (free-match rlst x 0) (funcall func rlst))))
            ;; 满足构建依赖
            (when (stringp form)
              (go skip-build))
            (let (target-level-error)
              (dolist (bdep-target (dep-target-list (pkgrec-depnode-bdep new-pkgrec)))
                (let ((target-rollback-func #'identity) target-oplist)
                  (dolist (depspec bdep-target)
                    (let ((matched-pkgrec-list (mapcan #'(lambda (rec)
                                                           (if (eql (depend*-match
                                                                      depspec
                                                                      (pkgrec-category rec)
                                                                      (pkgrec-name rec)
                                                                      (pkgrec-version rec)
                                                                      (pkgrec-slot-regular rec)
                                                                      (pkgrec-slot-sub rec)
                                                                      (pkgrec-uselst rec)
                                                                      (pkgrec-iuse_effective rec)
                                                                      t)
                                                                    t)
                                                             (list rec)
                                                             nil))
                                                       pkgrlst)))
                      (if (depspec-blockp depspec)
                        ;带有阻塞符{
                        (dolist (pkgrec matched-pkgrec-list)
                          (when (member pkgrec pkgrlst)		; [!] 推演回滚过程中，若软件包记录删除重建，
									;     则同一个软件包前后用 2 个不同的 <软件包记录> 记录，
									;     此时使用 eql 就会作出错误的判断
                            (multiple-value-bind (oplst rlst func) (uninstall-op-cons
                                                                     pkgrec
                                                                     (append target bdep-target)
                                                                     pkgrlst
                                                                     nil
                                                                     t)
                              (if (eql func :error)
                                (progn
                                  (setf pkgrlst (funcall target-rollback-func rlst))
                                  (setf target-level-error
                                        (nconc target-level-error
                                               (list (mk-errnode (list bdep-target depspec)
                                                                 :blocked
                                                                 (list (mk-errnode pkgrec
                                                                                   :uninstall-failed
                                                                                   oplst))))))
                                  (go target-level-end))
                                (progn
                                  (setf pkgrlst rlst)
                                  (let ((f target-rollback-func))
                                    (setf target-rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                                  (setf target-oplist (nconc target-oplist oplst)))))))
                        ;}带有阻塞符
                        ;不带阻塞符{
                        (unless (find :installed matched-pkgrec-list
                                      :key #'(lambda (rec) (pkgrec-status rec)))
                          (multiple-value-bind (oplst rlst func) (install-op-cons
                                                                   depspec
                                                                   install-root
                                                                   (list "所有" "隐式安装")
                                                                   (append target bdep-target)
                                                                   pkgrlst
                                                                   nil
                                                                   nil)
                            (if (eql func :error)
                              (progn
                                (setf pkgrlst (funcall target-rollback-func rlst))
                                (setf target-level-error
                                      (nconc target-level-error
                                             (list (mk-errnode (list bdep-target depspec)
                                                               :install-failed
                                                               oplst))))
                                (go target-level-end))
                              (progn
                                (setf pkgrlst rlst)
                                (let ((f target-rollback-func))
                                  (setf target-rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                                (setf target-oplist (nconc target-oplist oplst))))))
                        ;}不带阻塞符
                        )))
                  (setf new-op-list target-oplist)
                  (let ((f rollback-func))
                    (setf rollback-func (lambda (rl) (funcall f (funcall target-rollback-func rl)))))
                  (setf target-level-error nil)
                  (return))
                target-level-end)
              (when target-level-error
                (setf (errnode-errinfo error-lvl3) :unsatisfied-bdep		; 构建依赖无法满足
                      (errnode-sublvldesc error-lvl3) target-level-error
                      (errnode-sublvldesc error-lvl2) (nconc (errnode-sublvldesc error-lvl2) (list error-lvl3)))
                (setf pkgrlst (funcall rollback-func pkgrlst))
                (go use-level-end)))
            ;; 添加新软件包的“构建”操作，将新软件包记录的状态改为“已编译”
            (setf new-op-list (nconc new-op-list (list (mk-build-op new-pkgrec)))
                  (pkgrec-status new-pkgrec) :built)
            ;; 为强运行依赖 插槽依赖中的“=”选择插槽
            (pick-slot pkgrlst (pkgrec-depnode-rdep new-pkgrec))
            skip-build
            ;; 解除将要被替换的软件包记录的安装匹配关系
            (dolist (rec old-pkgrec-list)
              (free-match pkgrlst rec 1)
              (let ((func rollback-func) (x rec))
                (setf rollback-func (lambda (rlst) (establish-match rlst x 1) (funcall func rlst)))))
            ;; 为新软件包记录建立安装依赖的匹配关系
            (establish-match pkgrlst new-pkgrec 1)
            (let ((func rollback-func) (x new-pkgrec))
              (setf rollback-func (lambda (rlst) (free-match rlst x 1) (funcall func rlst))))
            ;; 满足安装依赖
            (let (target-level-error)
              (dolist (idep-target (dep-target-list (pkgrec-depnode-idep new-pkgrec)))
                (let ((target-rollback-func #'identity) target-oplist)
                  (dolist (depspec idep-target)
                    (let ((matched-pkgrec-list (mapcan #'(lambda (rec)
                                                           (if (eql (depend*-match
                                                                      depspec
                                                                      (pkgrec-category rec)
                                                                      (pkgrec-name rec)
                                                                      (pkgrec-version rec)
                                                                      (pkgrec-slot-regular rec)
                                                                      (pkgrec-slot-sub rec)
                                                                      (pkgrec-uselst rec)
                                                                      (pkgrec-iuse_effective rec)
                                                                      t)
                                                                    t)
                                                             (list rec)
                                                             nil))
                                                       pkgrlst)))
                      (if (depspec-blockp depspec)
                        ;带有阻塞符{
                        (dolist (pkgrec matched-pkgrec-list)
                          (when (member pkgrec pkgrlst)		; [!] 推演回滚过程中，若软件包记录删除重建，
									;     则同一个软件包前后用 2 个不同的 <软件包记录> 记录，
									;     此时使用 eql 就会作出错误的判断
                            (multiple-value-bind (oplst rlst func) (uninstall-op-cons
                                                                     pkgrec
                                                                     (append target idep-target)
                                                                     pkgrlst
                                                                     nil
                                                                     t)
                              (if (eql func :error)
                                (progn
                                  (setf pkgrlst (funcall target-rollback-func rlst))
                                  (setf target-level-error
                                        (nconc target-level-error
                                               (list (mk-errnode (list idep-target depspec)
                                                                 :blocked
                                                                 (list (mk-errnode pkgrec
                                                                                   :uninstall-failed
                                                                                   oplst))))))
                                  (go target-level-end))
                                (progn
                                  (setf pkgrlst rlst)
                                  (let ((f target-rollback-func))
                                    (setf target-rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                                  (setf target-oplist (nconc target-oplist oplst)))))))
                        ;}带有阻塞符
                        ;不带阻塞符{
                        (unless (find :installed matched-pkgrec-list
                                      :key #'(lambda (rec) (pkgrec-status rec)))
                          (multiple-value-bind (oplst rlst func) (install-op-cons
                                                                   depspec
                                                                   install-root
                                                                   (list "所有" "隐式安装")
                                                                   (append target idep-target)
                                                                   pkgrlst
                                                                   nil
                                                                   nil)
                            (if (eql func :error)
                              (progn
                                (setf pkgrlst (funcall target-rollback-func rlst))
                                (setf target-level-error
                                      (nconc target-level-error
                                             (list (mk-errnode (list idep-target depspec)
                                                               :install-failed
                                                               oplst))))
                                (go target-level-end))
                              (progn
                                (setf pkgrlst rlst)
                                (let ((f target-rollback-func))
                                  (setf target-rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                                (setf target-oplist (nconc target-oplist oplst))))))
                        ;}不带阻塞符
                        )))
                  (setf new-op-list (nconc new-op-list target-oplist))
                  (let ((f rollback-func))
                    (setf rollback-func (lambda (rl) (funcall f (funcall target-rollback-func rl)))))
                  (setf target-level-error nil)
                  (return))
                target-level-end)
              (when target-level-error
                (setf (errnode-errinfo error-lvl3) :unsatisfied-idep		; 安装依赖无法满足
                      (errnode-sublvldesc error-lvl3) target-level-error
                      (errnode-sublvldesc error-lvl2) (nconc (errnode-sublvldesc error-lvl2) (list error-lvl3)))
                (setf pkgrlst (funcall rollback-func pkgrlst))
                (go use-level-end)))
            ;; 解除将要被替换的软件包记录的强运行反向匹配关系
            (dolist (rec old-pkgrec-list)
              (setf xuankong-list (nunion xuankong-list (free-rev-match pkgrlst rec 2)))
              (let ((func rollback-func) (x rec))
                (setf rollback-func (lambda (rlst) (establish-rev-match rlst x 2) (funcall func rlst)))))
            ;; 卸载被新软件包阻塞强运行依赖的软件包
            (dolist (rec (establish-rev-match pkgrlst new-pkgrec 2 t))
              (when (member rec pkgrlst)
                (multiple-value-bind (oplst rlst func) (uninstall-op-cons rec target pkgrlst nil t)
                  (if (eql func :error)
                    (progn
                      (setf pkgrlst (funcall rollback-func rlst))
                      (setf (errnode-errinfo error-lvl3) :pkg-conflict		; 被新软件包阻塞强运行依赖的软件包无法卸载
                            (errnode-sublvldesc error-lvl3) (list (mk-errnode rec :uninstall-failed oplst))
                            (errnode-sublvldesc error-lvl2) (nconc (errnode-sublvldesc error-lvl2) (list error-lvl3)))
                      (go use-level-end))
                    (progn
                      (setf pkgrlst rlst
                            new-op-list (nconc new-op-list oplst))
                      (let ((f rollback-func))
                        (setf rollback-func (lambda (rl) (funcall f (funcall func rl))))))))))
            ;; 添加新软件包的“合并”操作，将新软件包记录的状态改为“已合并”
            (setf new-op-list (nconc new-op-list (list (mk-merge-op new-pkgrec old-pkgrec-list)))
                  (pkgrec-status new-pkgrec) :merged)
            ;; 解除将要被替换的软件包记录的剩下三种反向匹配关系
            (dolist (idx '(0 1 3))
              (dolist (rec old-pkgrec-list)
                (free-rev-match pkgrlst rec idx nil)
                (let ((func rollback-func) (x rec) (i idx))
                  (setf rollback-func (lambda (rlst) (establish-rev-match rlst x i nil) (funcall func rlst))))))
            ;; 解除将要被替换的软件包记录的强运行匹配关系
            (dolist (rec old-pkgrec-list)
              (free-match pkgrlst rec 2)
              (let ((func rollback-func) (x rec))
                (setf rollback-func (lambda (rlst) (establish-match rlst x 2) (funcall func rlst)))))
            ;; 为新软件包记录建立强运行依赖的匹配关系
            (establish-match pkgrlst new-pkgrec 2)
            (let ((func rollback-func) (x new-pkgrec))
              (setf rollback-func (lambda (rlst) (free-match rlst x 2) (funcall func rlst))))
            ;; 赋值“新推迟完成列表”
            (let ((prop (declare-value (find "PROPERTIES" ebuild-env-vars
                                             :key #'(lambda (d) (declare-name d))
                                             :test #'string=)))
                  (configp (when prop
                             (if (member "config" (string-split prop #\Space)
                                         :test #'string=)
                               t
                               nil))))
              (setf new-post-list (append post-list (list (mk-todonode new-pkgrec xuankong-list configp)))))
            ;; 处理强运行依赖
            (let (target-level-error)
              (dolist (rdep-target (dep-target-list (pkgrec-depnode-rdep new-pkgrec)))
                (let ((target-rollback-func #'identity) target-oplist (target-post-list new-post-list))
                  (dolist (depspec rdep-target)
                    (let ((matched-pkgrec-list (mapcan #'(lambda (rec)
                                                           (if (eql (depend*-match
                                                                      depspec
                                                                      (pkgrec-category rec)
                                                                      (pkgrec-name rec)
                                                                      (pkgrec-version rec)
                                                                      (pkgrec-slot-regular rec)
                                                                      (pkgrec-slot-sub rec)
                                                                      (pkgrec-uselst rec)
                                                                      (pkgrec-iuse_effective rec)
                                                                      t)
                                                                    t)
                                                             (list rec)
                                                             nil))
                                                       pkgrlst)))
                      (if (depspec-blockp depspec)
                        ;带有阻塞符{
                        (dolist (pkgrec matched-pkgrec-list)
                          (when (member pkgrec pkgrlst)		; [!] 推演回滚过程中，若软件包记录删除重建，
									;     则同一个软件包前后用 2 个不同的 <软件包记录> 记录，
									;     此时使用 eql 就会作出错误的判断
                            (multiple-value-bind (oplst rlst func) (uninstall-op-cons
                                                                     pkgrec
                                                                     (append target rdep-target)
                                                                     pkgrlst
                                                                     nil
                                                                     t)
                              (if (eql func :error)
                                (progn
                                  (setf pkgrlst (funcall target-rollback-func rlst))
                                  (setf target-level-error
                                        (nconc target-level-error
                                               (list (mk-errnode (list rdep-target depspec)
                                                                 :blocked
                                                                 (list (mk-errnode pkgrec
                                                                                   :uninstall-failed
                                                                                   oplst))))))
                                  (go target-level-end))
                                (progn
                                  (setf pkgrlst rlst)
                                  (let ((f target-rollback-func))
                                    (setf target-rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                                  (setf target-oplist (nconc target-oplist oplst)))))))
                        ;}带有阻塞符
                        ;不带阻塞符{
                        (unless (or (find :installed matched-pkgrec-list
                                          :key #'(lambda (rec) (pkgrec-status rec)))
                                    (find-if #'(lambda (node)
                                                 (let ((rec (todonode-pkgrec node)))
                                                   (eql (depend*-match
                                                          depspec
                                                          (pkgrec-category rec)
                                                          (pkgrec-name rec)
                                                          (pkgrec-version rec)
                                                          (pkgrec-slot-regular rec)
                                                          (pkgrec-slot-sub rec)
                                                          (pkgrec-uselst rec)
                                                          (pkgrec-iuse_effective rec))
                                                        t)))
                                             target-post-list))
                          (multiple-value-bind (oplst rlst func plst) (install-op-cons
                                                                        depspec
                                                                        install-root
                                                                        (list "所有" "隐式安装")
                                                                        (append target rdep-target)
                                                                        pkgrlst
                                                                        target-post-list
                                                                        nil)
                            (if (eql func :error)
                              (progn
                                (setf pkgrlst (funcall target-rollback-func rlst))
                                (setf target-level-error
                                      (nconc target-level-error
                                             (list (mk-errnode (list rdep-target depspec)
                                                               :install-failed
                                                               oplst))))
                                (go target-level-end))
                              (progn
                                (setf pkgrlst rlst)
                                (let ((f target-rollback-func))
                                  (setf target-rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                                (setf target-oplist (nconc target-oplist oplst)
                                      target-post-list plst)))))
                        ;}不带阻塞符
                        )))
                  (setf new-op-list (nconc new-op-list target-oplist))
                  (let ((f rollback-func))
                    (setf rollback-func (lambda (rl) (funcall f (funcall target-rollback-func rl)))))
                  (setf new-post-list target-post-list)
                  (setf target-level-error nil)
                  (return))
                target-level-end)
              (when target-level-error
                (setf (errnode-errinfo error-lvl3) :unsatisfied-rdep		; 强运行依赖无法满足
                      (errnode-sublvldesc error-lvl3) target-level-error
                      (errnode-sublvldesc error-lvl2) (nconc (errnode-sublvldesc error-lvl2) (list error-lvl3)))
                (setf pkgrlst (funcall rollback-func pkgrlst))
                (go use-level-end)))
            ;; 解除将要被替换的软件包记录的弱运行匹配关系
            (dolist (rec old-pkgrec-list)
              (free-match pkgrlst rec 3)
              (let ((func rollback-func) (x rec))
                (setf rollback-func (lambda (rlst) (establish-match rlst x 3) (funcall func rlst)))))
            ;; 为新软件包记录建立弱运行依赖的匹配关系
            (establish-match pkgrlst new-pkgrec 3)
            (let ((func rollback-func) (x new-pkgrec))
              (setf rollback-func (lambda (rlst) (free-match rlst x 3) (funcall func rlst))))
            ;; 满足弱运行依赖
            (when install-pdep-p
              (dolist (pdep-target (dep-target-list (pkgrec-depnode-pdep new-pkgrec)))
                (let ((target-rollback-func #'identity) target-oplist)
                  (dolist (depspec pdep-target)
                    (unless (find-if #'(lambda (rec)
                                         (and (eql (depend*-match
                                                     depspec
                                                     (pkgrec-category rec)
                                                     (pkgrec-name rec)
                                                     (pkgrec-version rec)
                                                     (pkgrec-slot-regular rec)
                                                     (pkgrec-slot-sub rec)
                                                     (pkgrec-uselst rec)
                                                     (pkgrec-iuse_effective rec))
                                                   t)
                                              (eql (pkgrec-status rec) :installed)))
                                     pkgrlst)
                      (multiple-value-bind (oplst rlst func) (install-op-cons
                                                               depspec
                                                               install-root
                                                               (list "所有" "隐式安装")
                                                               (append target pdep-target)
                                                               pkgrlst
                                                               nil
                                                               nil)
                        (if (eql func :error)
                          (progn
                            (setf pkgrlst (funcall target-rollback-func rlst))
                            (go target-level-end))
                          (progn
                            (setf pkgrlst rlst)
                            (let ((f target-rollback-func))
                              (setf target-rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                            (setf target-oplist (nconc target-oplist oplst)))))))
                  (setf new-op-list (nconc new-op-list target-oplist))
                  (let ((f rollback-func))
                    (setf rollback-func (lambda (rl) (funcall f (funcall target-rollback-func rl)))))
                  (return))
                target-level-end))
            ;;
            (if post-list
              ;推迟{
              (return-from install-op-cons
                           (values new-op-list
                                   pkgrlst
                                   rollback-func
                                   new-post-list))
              ;}推迟
              ;不推迟{
              (progn		; 完成已推迟的<待完成节点>
                (dolist (todonode new-post-list)
                  ;; pkg_config
                  (if (todonode-config? todonode)
                    (setf new-op-list (nconc new-op-list (list (mk-config-op new-pkgrec)))))
                  ;; 将已推迟的软件包记录的状态改为“已安装”
                  (setf (pkgrec-status new-pkgrec) :installed)
                  ;; 为已推迟的软件包记录建立强运行依赖的反向匹配关系
                  (establish-rev-match pkgrlst (todonode-pkgrec todonode) 2)
                  (let ((func rollback-func) (x (todonode-pkgrec todonode)))
                    (setf rollback-func (lambda (rl) (free-rev-match rl x 2) (funcall func rl))))
                  ;; 卸载强运行依赖不满足的悬空软件包记录
                  (dolist (pkgrec (todonode-xuankong todonode))
                    (if (and (member pkgrec pkgrlst)
                             (not (satisfip (pkgrec-depnode-rdep pkgrec))))
                      (multiple-value-bind (oplst rlst func) (uninstall-op-cons pkgrec target pkgrlst nil t)
                        (if (eql func :error)
                          (progn
                            (setf pkgrlst (funcall rollback-func rlst))
                            (setf (errnode-errinfo error-lvl3) :dopost-error		; 完成已推迟的软件包安装失败
                                  (errnode-sublvldesc error-lvl3) (list (mk-errnode todonode :xkerr (list (mk-errnode pkgrec :uninstall-failed oplst))))
                                  (errnode-sublvldesc error-lvl2) (nconc (errnode-sublvldesc error-lvl2) (list error-lvl3)))
                            (go use-level-end))
                          (progn
                            (setf pkgrlst rlst)
                            (let ((f rollback-func))
                              (setf rollback-func (lambda (rl) (funcall f (funcall func rl)))))
                            (setf new-op-list (nconc new-op-list oplst)))))))
                  ;; 为已推迟的软件包记录建立剩下三种依赖的反向匹配关系
                  (dolist (idx '(0 1 3))
                    (establish-rev-match pkgrlst (todonode-pkgrec todonode) idx)
                    (let ((func rollback-func) (x (todonode-pkgrec todonode)) (i idx))
                      (setf rollback-func (lambda (rl) (free-rev-match rl x i) (funcall func rl))))))
                (return-from install-op-cons (values new-op-list
                                                     pkgrlst
                                                     rollback-func
                                                     nil)))
              ;}不推迟
              )
            )
        use-level-end)
        )
      hxpkg-level-end)
    (values error-lvl1 pkgrlst :error)
    ))


; [TODO] 最顶层操作构造完成后需要把操作构造过程中创建，
         但软件包没有出现在操作列表中的“构建目录”(<所在仓库名称>/<类别名称>/<软件包>-<版本>)删除




;; 软件包卸载操作构造
;; 参数：
;;	pkg-record		<软件包记录>
;;	target			主调函数的目标
;;	pkgrlst			用于推演的 <软件包记录> 表
;;	loop-check-list		强运行反向匹配循环检查列表。每一项是一个软件包记录，表示强运行反向匹配路径上的一个节点
;;	forcep			是否卸载强运行反向依赖。可选参数
;; 返回值：
;;	1. 主返回值
;;	2. <软件包记录> 表
;;	3. 指示符/<回滚函数>
;;
;;	* 第 3 个返回值等于 :error 表示函数执行失败，
;;	  此时主返回值是一个 <错误描述节点>，<软件包记录> 表是已回滚的 <软件包记录> 表；
;;	  第 3 个返回值不等于 :error 表示函数执行成功，
;;	  此时主返回值是新构造出来的操作列表，<软件包记录> 表是推演得到的 <软件包记录> 表，第 3 个返回值是 <回滚函数>
;;	* <回滚函数> 是一个将软件包记录表回滚到推演前的状态的函数，
;;	  参数为一个待回滚的软件包记录表，返回值是回滚后的软件包记录表
(defun uninstall-op-cons (pkg-record target pkgrlst loop-check-list &optional forcep)
  (when (member pkg-record loop-check-list)
    (return-from uninstall-op-cons (values nil pkgrlst #'identity)))
  (unless (uninstallable-p pkg-record pkgrlst)
    (return-from uninstall-op-cons (values (mk-errnode pkg-record :not-uninstallable nil)
                                           pkgrlst
                                           :error)))
  (dolist (depspec target)
    (when (and (not (depspec-blockp depspec))
               (eql (depend*-match depspec
                                   (pkgrec-category pkg-record)
                                   (pkgrec-name pkg-record)
                                   (pkgrec-version pkg-record)
                                   (pkgrec-slot-regular pkg-record)
                                   (pkgrec-slot-sub pkg-record)
                                   (pkgrec-uselst pkg-record)
                                   (pkgrec-iuse_effective pkg-record))
                    t))
      (return-from uninstall-op-cons (values (mk-errnode pkg-record :target-conflict nil)
                                             pkgrlst
                                             :error))))
  (let (rollback-func new-op-list (xuankong-rev-rdep (free-rev-match pkgrlst pkg-record 2 nil)))
    (let ((x pkg-record))
      (setf rollback-func (lambda (rlst) (establish-rev-match rlst x 2 nil) rlst)))
    (when xuankong-rev-rdep
      (unless forcep
        (return-from uninstall-op-cons (values (mk-errnode pkg-record :keep-rev-rdep nil)
                                               (funcall rollback-func pkgrlst)
                                               :error)))
      (let ((new-loop-check-list (append loop-check-list (list pkg-record))))
        (dolist (rec xuankong-rev-rdep)
          (when (member rec pkgrlst)
            (multiple-value-bind (oplst rlst func) (uninstall-op-cons rec target pkgrlst new-loop-check-list t)
              (if (eql func :error)
                (return-from uninstall-op-cons (values (mk-errnode pkg-record
                                                                   :recursive-failed
                                                                   (list (mk-errnode rec
                                                                                     :uninstall-failed
                                                                                     oplst)))
                                                       (funcall rollback-func rlst)
                                                       :error))
                (progn
                  (setf pkgrlst rlst
                        new-op-list (nconc new-op-list oplst))
                  (let ((f rollback-func))
                    (setf rollback-func (lambda (rl) (funcall f (funcall func rl))))))))))))
    (dolist (idx '(0 1 3))
      (free-rev-match pkgrlst pkg-record idx nil)
      (let ((func rollback-func) (x pkg-record) (i idx))
        (setf rollback-func (lambda (rlst) (establish-rev-match rlst x i nil) (funcall func rlst)))))
    (setf new-op-list (nconc new-op-list (list (mk-uninstall-op pkg-record))))
    (dotimes (idx 4)
      (free-match pkgrlst pkg-record idx)
      (let ((func rollback-func) (x pkg-record) (i idx))
        (setf rollback-func (lambda (rlst) (establish-match rlst x i) (funcall func rlst)))))
    (delete-pkg-record pkgrlst pkg-record)
    (let ((func rollback-func) (x pkg-record))
      (setf rollback-func (lambda (rlst) (funcall func (cons x rlst)))))
    (values new-op-list pkgrlst rollback-func)))




;; 运行软件包的 pkg_pretend 函数
;; 参数：
;;	pkg-locator		软件包定位符
;;	use			启用的应用标志列表，
;;				非二进制包必填，二进制包忽略
;;	ebuild-env-vars	一个 <bash declare -p 列表>，
;;				表示拉入 ebuild 得到的变量列表，
;;				非二进制包必填，二进制包忽略
;;	install-root		软件包合并到的根目录的绝对路径（ROOT 环境变量的值）
;;				非二进制包必填，二进制包忽略
;; 返回值：
;;	一个整数，表示 pkg_pretend 的退出状态
;; bash 命令：
;;	"source <所在仓库名称>/<类别名称>/<软件包>-<版本>/ENV/变量.sh
	 source <所在仓库名称>/<类别名称>/<软件包>-<版本>/ENV/pkg_pretend-rc.sh
	 source <所在仓库名称>/<类别名称>/<软件包>-<版本>/ENV/函数.sh
	 pkg_pretend
	"
(defun run-pkg-pretend (pkg-locator &optional use ebuild-env-vars install-root)
  (let* ((builddir (concatenate 'string *builddir-location* "/"
                                        (locator-reponame pkg-locator) "/"
                                        (locator-category pkg-locator) "/"
                                        (locator-pkgname pkg-locator) "-"
                                        (locator-vstr pkg-locator)))
         (rc-script (concatenate 'string builddir "/ENV/pkg_pretend-rc.sh")))
    (unless (uiop:file-exists-p rc-script)
      ;; 构造 pkg_pretend 函数的执行前脚本
      (let ((rc-vars (list (list "-rx" "EBUILD_PHASE" "pretend")
                           (list "-rx" "EBUILD_PHASE_FUNC" "pkg_pretend")))
            eprefix)
        (when (symbolp (locator-form pkg-locator))
          (unless (setf eprefix (declare-value (find "EPREFIX" ebuild-env-vars
                                                     :key #'(lambda (d) (declare-name d))
                                                     :test #'string=)))
            (setf eprefix *eprefix-pm-default)
            (push (list "-rx" "EPREFIX" eprefix) rc-vars))
          (push (list "-rx" "ROOT" install-root) rc-vars)
          (push (list "-rx" "EROOT" (if (string= eprefix "")
                                      install-root
                                      (concatenate 'string install-root eprefix)))
                rc-vars)
          (dolist (i '("T" "TMPDIR" "HOME"))
            (let ((path (concatenate 'string builddir "/" i)))
              (sb-posix:mkdir path *builddir-mode*)
              (push (list "-rx" i path) rc-vars)))
          (push (list "-x" "USE" (reduce #'(lambda (&optional a b)
                                             (if a (concatenate 'string a " " b) ""))
                                         use))
                rc-vars))
        (with-open-file (liu rc-script :direction :output)
          (dolist (v rc-vars)
            (format liu "declare ~A ~A" (declare-attribute v) (declare-name v))
            (if (declare-value v)
              (format liu "=~S~%" (declare-value v))
              (format liu "~%"))))))
    ;;
    (let* ((cmd (with-output-to-string (str)
                  ;; 构造 bash 命令
                  (format str "source ~A/ENV/变量.sh~%" builddir)
                  (format str "source ~A~%" rc-script)
                  (format str "source ~A/ENV/函数.sh~%" builddir)
                  (format str "pkg_pretend~%")))
           ;; 调用 bash（env -i --chdir=<WORKDIR> *bash-prog* --norc --noprofile -c <命令>）
           (proc (sb-ext:run-program *env-prog* (list "-i" (format nil "--chdir=~A/BUILD" builddir) *bash-prog* "--norc" "--noprofile" "-c" cmd) :wait t :input nil :output t :error t)))
      (sb-ext:process-exit-code proc))))



;; 计算必须启用的应用标志和必须禁用的应用标志
;; 参数：
;;	depspec*		<软件包依赖说明符*>
;;	pf			<系统轮廓*>
;;	iuse-effective		一个应用标志列表，代表软件包的 IUSE_EFFECTIVE
;;	stablep		软件包是稳定版
;; 返回值：
;;	成功：
;;	1. 必须启用的应用标志列表
;;	2. 必须禁用的应用标志列表
;;	应用标志依赖无法满足：
;;	1. :cant-satisfy
;;	2. 无法满足的应用标志
;;	应用标志依赖和系统轮廓的应用标志控制冲突，且应用标志控制不能无视：
;;	1. :conflict
;;	2. 冲突的应用标志列表
;;	依赖的应用标志不在 IUSE_EFFECTIVE 中且没有默认值：
;;	1. :not-effective
;;	2. 无效的应用标志
(defun calc-use-bianjie (depspec* pf iuse-effective &optional (stablep t))
  (let ((pf-use+- (list nil nil)) (dep-use+- (list nil nil)))
    ;; 合并系统轮廓的应用标志控制，得到必须启用和必须禁用的应用标志列表 pf-use+-
    (dotimes (i 8)
      (let* ((usectrl (nth (+ 3 i) (caddr pf)))
             (st (logand i #2r001))
             selected-use)
        (when (or (zerop (logand i #2r010)) stablep)	; 不是稳定版约束的应用标志控制或软件包是稳定版
          (if (zerop (logand i #2r100))	; 如果是全局范围的应用标志控制
            (setf selected-use usectrl)
            (dolist (ctrl usectrl)
              (when (eql (depend*-match (car ctrl)
                                        (qpkgname-category (depspec-qpkgname depspec*))
                                        (qpkgname-pkgname (depspec-qpkgname depspec*))
                                        (car (depspec-version* depspec*))
                                        nil nil nil nil)
                         t)
                (dolist (s (cdr ctrl))
                  (if (car s)
                    (setf selected-use (cons (cdr s) selected-use))
                    (setf selected-use (delete (cdr s) selected-use :test #'string=)))))))
          (dolist (flag selected-use)
            (when (find flag (nth (mod (1+ st) 2) pf-use+-) :test #'string=)
              (setf (nth (mod (1+ st) 2) pf-use+-) (delete flag (nth (mod (1+ st) 2) pf-use+-) :test #'string=)))
            (setf (nth st pf-use+-) (adjoin flag (nth st pf-use+-) :test #'string=))))))
    ;; 从 pf-use+- 中剔除不在 IUSE_EFFECTIVE 中的应用标志
    (setf (nth 0 pf-use+-) (nintersection (nth 0 pf-use+-) iuse-effective :test #'string=)
          (nth 1 pf-use+-) (nintersection (nth 1 pf-use+-) iuse-effective :test #'string=))
    ;; 将应用标志依赖合并为必须启用和必须禁用的应用标志列表 dep-use+-
    (dolist (ud+ (car (depspec*-usedep* depspec*)))
      (if (find (car ud+) iuse-effective :test #'string=)
        (setf (nth 0 dep-use+-) (adjoin (car ud+) (nth 0 dep-use+-) :test #'string=))
        (if (cdr ud+)
          (when (eql (cdr ud+) :-)
            (return-from calc-use-bianjie (values :cant-satisfy (car ud+))))		; 应用标志依赖无法满足
          (return-from calc-use-bianjie (values :not-effective (car ud+))))))	; 依赖的应用标志不在 IUSE_EFFECTIVE 中且没有默认值
    (dolist (ud- (cdr (depspec*-usedep* depspec*)))
      (if (find (car ud-) iuse-effective :test #'string=)
        (if (find (car ud-) (nth 0 dep-use+-) :test #'string=)
          (return-from calc-use-bianjie (values :cant-satisfy (car ud-)))		; 应用标志既要启用又要禁用，依赖无法满足
          (setf (nth 1 dep-use+-) (adjoin (car ud-) (nth 1 dep-use+-) :test #'string=)))
        (if (cdr ud-)
          (when (eql (cdr ud-) :+)
            (return-from calc-use-bianjie (values :cant-satisfy (car ud-))))		; 应用标志依赖无法满足
          (return-from calc-use-bianjie (values :not-effective (car ud-))))))	; 依赖的应用标志不在 IUSE_EFFECTIVE 中且没有默认值
    ;; 检查冲突并将 pf-use+- 合并到 dep-use+- 上
    (dotimes (i 2)
      (let ((conflict-use (intersection (nth (mod (1+ i) 2) dep-use+-) (nth i pf-use+-) :test #'string=)))
        (when conflict-use
          (if *dep-use>pf-usectrl*
            (setf (nth i pf-use+-) (nset-difference (nth i pf-use+-) conflict-use :test #'string=))
            (return-from calc-use-bianjie (values :conflict conflict-use)))))
      (setf (nth i dep-use+-) (nconc (nth i dep-use+-) (nth i pf-use+-))))
    ;; 将系统轮廓变量 USE 合并到 dep-use+- 上
    (dolist (flag (cdr (assoc "USE" (profile-make.defaults pf) :test #'string=)))
      (when (and (find flag iuse-effective :test #'string=)
                 (not (find flag (nth 1 dep-use+-) :test #'string=)))
        (setf (nth 0 dep-use+-) (adjoin flag (nth 0 dep-use+-) :test #'string=))))
    (values (nth 0 dep-use+-) (nth 1 dep-use+-))))




;; EAPI 检查
;; 参数：
;;	pkg-locator	软件包定位符
;; 返回值：
;;	如果软件包的 EAPI 能读出来并且支持，
;;	返回 EAPI 的值，否则返回 nil
(defun check-eapi (pkg-locator)
  (let* ((form (locator-form pkg-locator))
         (repo (find (locator-reponame pkg-locator) *repo-list* :key #'(lambda (r) (repo-name r)) :test #'string=))
         (location (path-join (repo-rootpath repo) (locator-category pkg-locator) (locator-pkgname pkg-locator)))
         (ebuild-fname (concatenate 'string
                                    (locator-pkgname pkg-locator) "-"
                                    (locator-vstr pkg-locator) ".ebuild"))
         eapi)
    (if (eql form :ebuild)
      (setf eapi (parse-eapi-file (concatenate 'string location "/" ebuild-fname)))
      (let* ((pkg-fname (concatenate 'string
                                     (locator-pkgname pkg-locator) "-"
                                     (locator-vstr pkg-locator)
                                     (if (eql form :src) ".src" (concatenate 'string "." form))
                                     ".ebuild"))
             (proc (sb-ext:run-program *tar-prog*
                                       (list "-xOf" "-" ebuild-fname)
                                       :input (concatenate 'string location "/" pkg-fname)
                                       :output :stream
                                       :wait t)))
        (unless (zerop (sb-ext:process-exit-code proc))
          (return-from check-eapi nil))
        (setf eapi (parse-eapi-stream (sb-ext:process-output proc)))
        (sb-ext:process-close proc)))
    (find eapi *supported-eapi :test #'string=)))