Commit 4a27b93a authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Transform some ugly macro with bad loop that warns under clisp into clean higher-order function.

Add TODO item.
parent fafade57
......@@ -8,5 +8,8 @@
why things depend on each other.
* rewrite ADG to use a fully instrumented code-walker + CL-in-CL implementation
so we don't have to approximate dependencies when we can trace them directly.
* rewrite ADG to use SB-COVER,
so we don't have to approximate dependencies when we can trace them
directly.
More difficult would be to writ your own fully instrumented
code-walker and coverage CL-in-CL implementation.
......@@ -172,14 +172,14 @@ to the base of the system."
"Component spec ~S in ~S didn't find a component."
compspec system)
(apply #'reinitialize-instance component args))))
(loop for (system compspec . initargs) in additional-initargs
do (assert (member (asdf::coerce-name system) systems
:key #'asdf::coerce-name
:test #'equal)
()
"Component translation in System ~A which is not a member of the ~
systems to merge." system)
do (add-initargs system compspec initargs))))
(loop :for (system compspec . initargs) in additional-initargs :do
(assert (member (asdf::coerce-name system) systems
:key #'asdf::coerce-name
:test #'equal)
()
"Component translation in System ~A which is not a member of the ~
systems to merge." system)
(add-initargs system compspec initargs))))
(defmethod asdf:perform ((op dependency-op) (c component-file))
(let ((tmp-file-name (format nil "~A-~A"
......@@ -231,10 +231,43 @@ to the base of the system."
;;; Reading the component list back into asdf defsystems
(defun %comp-file-reader (pathname system-names collector)
(with-open-file (f pathname :direction :input)
(let ((systems (read f))
(done-systems nil))
(labels ((do-1-system (system-name)
(unless (position system-name done-systems
:test #'string-equal)
(let ((system (assoc system-name systems
:test #'string-equal)))
(funcall collector system)
(push system-name done-systems)
(getf (cdr system) :depends-on)))))
(loop :while system-names :do
(let ((system-name (pop system-names)))
(setf system-names (append system-names (do-1-system system-name)))))))))
(defun read-component-file (pathname &rest system-names)
(let ((component-list nil))
(%comp-file-reader
pathname system-names
(lambda (system)
(setf component-list
(append component-list (getf (cdr system) :components)))))))
(defun systems-in-configuration (pathname &rest system-names)
(let ((component-names nil))
(%comp-file-reader
pathname system-names
(lambda (system)
(when system
(push (first system) component-names))))))
#|
;; Old macro-ish version by antifuchs:
(macrolet
((define-comp-file-reader (fname (1-system-var return-var)
&body 1-system-body)
(let ((system-name (gensym))
(system-names (gensym))
(done-systems (gensym))
......@@ -252,10 +285,10 @@ to the base of the system."
(progn ,@1-system-body)
(push ,system-name ,done-systems)
(getf (cdr ,1-system-var) :depends-on)))))
(loop while ,system-names
for ,system-name = (pop ,system-names)
do (setf ,system-names (append ,system-names
(do-1-system ,system-name))))
(loop :while ,system-names :do
(let ((,system-name (pop ,system-names)))
(setf ,system-names (append ,system-names
(do-1-system ,system-name)))))
,return-var)))))))
(define-comp-file-reader read-component-file (system component-list)
(setf component-list
......@@ -263,6 +296,7 @@ to the base of the system."
(define-comp-file-reader systems-in-configuration (system component-names)
(when system
(push (first system) component-names))))
|#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment