[Openmcl-cvs-notifications] r9211 - /trunk/source/tools/asdf.lisp
gb at clozure.com
gb at clozure.com
Sun Apr 20 07:00:40 EDT 2008
Author: gb
Date: Sun Apr 20 07:00:40 2008
New Revision: 9211
Log:
um, let's try that again
Modified:
trunk/source/tools/asdf.lisp
Modified: trunk/source/tools/asdf.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/tools/asdf.lisp (original)
+++ trunk/source/tools/asdf.lisp Sun Apr 20 07:00:40 2008
@@ -1,1424 +1,1319 @@
-
-
-
-
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
-"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns=3D"http://www.w3.org/1999/xhtml" xml:lang=3D"en" lang=3D"en">
-<!-- ViewVC - http://viewvc.org/
-by Greg Stein - mailto:gstein at lyra.org -->
-<head>
-<title>SourceForge.net Repository - [cclan] View of /asdf/asdf.lisp</title>
-<meta name=3D"generator" content=3D"ViewVC 1.0.3" />
-<link rel=3D"stylesheet" href=3D"/*docroot*/styles.css" type=3D"text/css" =
/>
-</head>
-<body>
-<table style=3D"padding:0.1em;">
-<tr>
-<td>
-<strong>
-
-<a href=3D"/cclan/">
-
-[cclan]</a>
-/
-
-<a href=3D"/cclan/asdf/">
-
-asdf</a>
-/
-
-<a href=3D"/cclan/asdf/asdf.lisp?view=3Dlog">
-
-asdf.lisp</a>
-
-
-</strong>
-
-</td>
-</tr>
-</table>
-
-
-<div style=3D"float: right; padding: 5px;"><a href=3D"http://sourceforge.n=
et"><img src=3D"/*docroot*/images/sflogo-210pxtrans.png" alt=3D"(logo)" bor=
der=3D0 width=3D210 height=3D62></a></div>
-<h1>View of /asdf/asdf.lisp</h1>
-
-<p style=3D"margin:0;">
-
-<a href=3D"/cclan/asdf/"><img src=3D"/*docroot*/images/back_small.png" wid=
th=3D"16" height=3D"16" alt=3D"Parent Directory" /> Parent Directory</a>
-
-| <a href=3D"/cclan/asdf/asdf.lisp?view=3Dlog#rev1.115"><img src=3D"/*docr=
oot*/images/log.png" width=3D"16" height=3D"16" alt=3D"Revision Log" /> Rev=
ision Log</a>
-
-
-
-
-</p>
-
-<hr />
-<div class=3D"vc_summary">
-Revision <strong>1.115</strong> -
-(<a href=3D"/*checkout*/cclan/asdf/asdf.lisp?revision=3D1.115"><strong>dow=
nload</strong></a>)
-
-(<a href=3D"/cclan/asdf/asdf.lisp?annotate=3D1.115"><strong>annotate</stro=
ng></a>)
-
-<br /><em>Fri Feb 15 12:14:48 2008 UTC</em>
-(2 months ago)
-by <em>demoss</em>
-
-
-<br />Branch: <strong>MAIN</strong>
-
-
-<br />CVS Tags: <strong>HEAD</strong>
-
-
-
-
-<br />Changes since <strong>1.114: +2 -2 lines</strong>
-
-
-
-
-
-<pre class=3D"vc_log">fix CVS revision magic in *asdf-revision*
-
- gah.
-</pre>
-
-</div>
-<div id=3D"vc_markup"><pre><a id=3D"l_1"></a><span class=3D"hl line"> 1=
</span><span class=3D"hl slc">;;; This is asdf: Another System Definition =
Facility. $Revision$</span>
-<a id=3D"l_2"></a><span class=3D"hl line"> 2 </span><span class=3D"hl s=
lc">;;;</span>
-<a id=3D"l_3"></a><span class=3D"hl line"> 3 </span><span class=3D"hl s=
lc">;;; Feedback, bug reports, and patches are all welcome: please mail to<=
/span>
-<a id=3D"l_4"></a><span class=3D"hl line"> 4 </span><span class=3D"hl s=
lc">;;; <cclan-list@lists.sf.net>. But note first that the canon=
ical</span>
-<a id=3D"l_5"></a><span class=3D"hl line"> 5 </span><span class=3D"hl s=
lc">;;; source for asdf is presently the cCLan CVS repository at</span>
-<a id=3D"l_6"></a><span class=3D"hl line"> 6 </span><span class=3D"hl s=
lc">;;; <URL:http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/&=
gt;</span>
-<a id=3D"l_7"></a><span class=3D"hl line"> 7 </span><span class=3D"hl s=
lc">;;;</span>
-<a id=3D"l_8"></a><span class=3D"hl line"> 8 </span><span class=3D"hl s=
lc">;;; If you obtained this copy from anywhere else, and you experience</s=
pan>
-<a id=3D"l_9"></a><span class=3D"hl line"> 9 </span><span class=3D"hl s=
lc">;;; trouble using it, or find bugs, you may want to check at the</span>
-<a id=3D"l_10"></a><span class=3D"hl line"> 10 </span><span class=3D"hl =
slc">;;; location above for a more recent version (and for documentation</s=
pan>
-<a id=3D"l_11"></a><span class=3D"hl line"> 11 </span><span class=3D"hl =
slc">;;; and test files, if your copy came without them) before reporting</=
span>
-<a id=3D"l_12"></a><span class=3D"hl line"> 12 </span><span class=3D"hl =
slc">;;; bugs. There are usually two "supported" revisions - the=
CVS HEAD</span>
-<a id=3D"l_13"></a><span class=3D"hl line"> 13 </span><span class=3D"hl =
slc">;;; is the latest development version, whereas the revision tagged</sp=
an>
-<a id=3D"l_14"></a><span class=3D"hl line"> 14 </span><span class=3D"hl =
slc">;;; RELEASE may be slightly older but is considered `stable'</span>
-<a id=3D"l_15"></a><span class=3D"hl line"> 15 </span>
-<a id=3D"l_16"></a><span class=3D"hl line"> 16 </span><span class=3D"hl =
slc">;;; Copyright (c) 2001-2007 Daniel Barlow and contributors</span>
-<a id=3D"l_17"></a><span class=3D"hl line"> 17 </span><span class=3D"hl =
slc">;;;</span>
-<a id=3D"l_18"></a><span class=3D"hl line"> 18 </span><span class=3D"hl =
slc">;;; Permission is hereby granted, free of charge, to any person obtain=
ing</span>
-<a id=3D"l_19"></a><span class=3D"hl line"> 19 </span><span class=3D"hl =
slc">;;; a copy of this software and associated documentation files (the</s=
pan>
-<a id=3D"l_20"></a><span class=3D"hl line"> 20 </span><span class=3D"hl =
slc">;;; "Software"), to deal in the Software without restriction=
, including</span>
-<a id=3D"l_21"></a><span class=3D"hl line"> 21 </span><span class=3D"hl =
slc">;;; without limitation the rights to use, copy, modify, merge, publish=
,</span>
-<a id=3D"l_22"></a><span class=3D"hl line"> 22 </span><span class=3D"hl =
slc">;;; distribute, sublicense, and/or sell copies of the Software, and to=
</span>
-<a id=3D"l_23"></a><span class=3D"hl line"> 23 </span><span class=3D"hl =
slc">;;; permit persons to whom the Software is furnished to do so, subject=
to</span>
-<a id=3D"l_24"></a><span class=3D"hl line"> 24 </span><span class=3D"hl =
slc">;;; the following conditions:</span>
-<a id=3D"l_25"></a><span class=3D"hl line"> 25 </span><span class=3D"hl =
slc">;;;</span>
-<a id=3D"l_26"></a><span class=3D"hl line"> 26 </span><span class=3D"hl =
slc">;;; The above copyright notice and this permission notice shall be</sp=
an>
-<a id=3D"l_27"></a><span class=3D"hl line"> 27 </span><span class=3D"hl =
slc">;;; included in all copies or substantial portions of the Software.</s=
pan>
-<a id=3D"l_28"></a><span class=3D"hl line"> 28 </span><span class=3D"hl =
slc">;;;</span>
-<a id=3D"l_29"></a><span class=3D"hl line"> 29 </span><span class=3D"hl =
slc">;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF AN=
Y KIND,</span>
-<a id=3D"l_30"></a><span class=3D"hl line"> 30 </span><span class=3D"hl =
slc">;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF=
</span>
-<a id=3D"l_31"></a><span class=3D"hl line"> 31 </span><span class=3D"hl =
slc">;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND</span>
-<a id=3D"l_32"></a><span class=3D"hl line"> 32 </span><span class=3D"hl =
slc">;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDER=
S BE</span>
-<a id=3D"l_33"></a><span class=3D"hl line"> 33 </span><span class=3D"hl =
slc">;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN AC=
TION</span>
-<a id=3D"l_34"></a><span class=3D"hl line"> 34 </span><span class=3D"hl =
slc">;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECT=
ION</span>
-<a id=3D"l_35"></a><span class=3D"hl line"> 35 </span><span class=3D"hl =
slc">;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.</s=
pan>
-<a id=3D"l_36"></a><span class=3D"hl line"> 36 </span>
-<a id=3D"l_37"></a><span class=3D"hl line"> 37 </span><span class=3D"hl =
slc">;;; the problem with writing a defsystem replacement is bootstrapping:=
</span>
-<a id=3D"l_38"></a><span class=3D"hl line"> 38 </span><span class=3D"hl =
slc">;;; we can't use defsystem to compile it. Hence, all in one file</spa=
n>
-<a id=3D"l_39"></a><span class=3D"hl line"> 39 </span>
-<a id=3D"l_40"></a><span class=3D"hl line"> 40 </span><span class=3D"hl =
sym">(</span>defpackage #<span class=3D"hl sym">:</span>asdf
-<a id=3D"l_41"></a><span class=3D"hl line"> 41 </span> <span class=3D"h=
l sym">(:</span>export #<span class=3D"hl sym">:</span>defsystem #<span cla=
ss=3D"hl sym">:</span>oos #<span class=3D"hl sym">:</span>operate #<span cl=
ass=3D"hl sym">:</span>find-system #<span class=3D"hl sym">:</span>run-shel=
l-<span class=3D"hl kwa">command</span>
-<a id=3D"l_42"></a><span class=3D"hl line"> 42 </span> #<span =
class=3D"hl sym">:</span>system-definition-pathname #<span class=3D"hl sym"=
>:</span>find-component <span class=3D"hl slc">; miscellaneous</span>
-<a id=3D"l_43"></a><span class=3D"hl line"> 43 </span> #<span =
class=3D"hl sym">:</span>hyperdocumentation #<span class=3D"hl sym">:</span=
>hyperdoc
-<a id=3D"l_44"></a><span class=3D"hl line"> 44 </span>
-<a id=3D"l_45"></a><span class=3D"hl line"> 45 </span> #<span =
class=3D"hl sym">:</span>compile-op #<span class=3D"hl sym">:</span><span c=
lass=3D"hl kwa">load</span>-op #<span class=3D"hl sym">:</span><span class=
=3D"hl kwa">load</span>-source-op #<span class=3D"hl sym">:</span>test-syst=
em-version
-<a id=3D"l_46"></a><span class=3D"hl line"> 46 </span> #<span =
class=3D"hl sym">:</span>test-op
-<a id=3D"l_47"></a><span class=3D"hl line"> 47 </span> #<span =
class=3D"hl sym">:</span>operation <span class=3D"hl slc">=
; operations</span>
-<a id=3D"l_48"></a><span class=3D"hl line"> 48 </span> #<span =
class=3D"hl sym">:</span>feature <span class=3D"hl slc">=
; sort-of operation</span>
-<a id=3D"l_49"></a><span class=3D"hl line"> 49 </span> #<span =
class=3D"hl sym">:</span>version <span class=3D"hl slc">=
; metaphorically sort-of an operation</span>
-<a id=3D"l_50"></a><span class=3D"hl line"> 50 </span>
-<a id=3D"l_51"></a><span class=3D"hl line"> 51 </span> #<span =
class=3D"hl sym">:</span>input-files #<span class=3D"hl sym">:</span>output=
-files #<span class=3D"hl sym">:</span>perform <span class=3D"hl slc"=
>; operation methods</span>
-<a id=3D"l_52"></a><span class=3D"hl line"> 52 </span> #<span =
class=3D"hl sym">:</span>operation-done-p #<span class=3D"hl sym">:</span>e=
xplain
-<a id=3D"l_53"></a><span class=3D"hl line"> 53 </span>
-<a id=3D"l_54"></a><span class=3D"hl line"> 54 </span> #<span =
class=3D"hl sym">:</span>component #<span class=3D"hl sym">:</span>source-f=
ile
-<a id=3D"l_55"></a><span class=3D"hl line"> 55 </span> #<span =
class=3D"hl sym">:</span>c-source-file #<span class=3D"hl sym">:</span>cl-s=
ource-file #<span class=3D"hl sym">:</span>java-source-file
-<a id=3D"l_56"></a><span class=3D"hl line"> 56 </span> #<span =
class=3D"hl sym">:</span>static-file
-<a id=3D"l_57"></a><span class=3D"hl line"> 57 </span> #<span =
class=3D"hl sym">:</span>doc-file
-<a id=3D"l_58"></a><span class=3D"hl line"> 58 </span> #<span =
class=3D"hl sym">:</span>html-file
-<a id=3D"l_59"></a><span class=3D"hl line"> 59 </span> #<span =
class=3D"hl sym">:</span>text-file
-<a id=3D"l_60"></a><span class=3D"hl line"> 60 </span> #<span =
class=3D"hl sym">:</span>source-file-<span class=3D"hl kwa">type</span>
-<a id=3D"l_61"></a><span class=3D"hl line"> 61 </span> #<span =
class=3D"hl sym">:</span>module <span class=3D"hl slc">=
; components</span>
-<a id=3D"l_62"></a><span class=3D"hl line"> 62 </span> #<span =
class=3D"hl sym">:</span>system
-<a id=3D"l_63"></a><span class=3D"hl line"> 63 </span> #<span =
class=3D"hl sym">:</span>unix-dso
-<a id=3D"l_64"></a><span class=3D"hl line"> 64 </span>
-<a id=3D"l_65"></a><span class=3D"hl line"> 65 </span> #<span =
class=3D"hl sym">:</span>module-components <span class=3D"hl slc">=
; component accessors</span>
-<a id=3D"l_66"></a><span class=3D"hl line"> 66 </span> #<span =
class=3D"hl sym">:</span>component-pathname
-<a id=3D"l_67"></a><span class=3D"hl line"> 67 </span> #<span =
class=3D"hl sym">:</span>component-relative-pathname
-<a id=3D"l_68"></a><span class=3D"hl line"> 68 </span> #<span =
class=3D"hl sym">:</span>component-name
-<a id=3D"l_69"></a><span class=3D"hl line"> 69 </span> #<span =
class=3D"hl sym">:</span>component-version
-<a id=3D"l_70"></a><span class=3D"hl line"> 70 </span> #<span =
class=3D"hl sym">:</span>component-parent
-<a id=3D"l_71"></a><span class=3D"hl line"> 71 </span> #<span =
class=3D"hl sym">:</span>component-property
-<a id=3D"l_72"></a><span class=3D"hl line"> 72 </span> #<span =
class=3D"hl sym">:</span>component-system
-<a id=3D"l_73"></a><span class=3D"hl line"> 73 </span>
-<a id=3D"l_74"></a><span class=3D"hl line"> 74 </span> #<span =
class=3D"hl sym">:</span>component-depends-on
-<a id=3D"l_75"></a><span class=3D"hl line"> 75 </span>
-<a id=3D"l_76"></a><span class=3D"hl line"> 76 </span> #<span =
class=3D"hl sym">:</span>system-description
-<a id=3D"l_77"></a><span class=3D"hl line"> 77 </span> #<span =
class=3D"hl sym">:</span>system-long-description
-<a id=3D"l_78"></a><span class=3D"hl line"> 78 </span> #<span =
class=3D"hl sym">:</span>system-author
-<a id=3D"l_79"></a><span class=3D"hl line"> 79 </span> #<span =
class=3D"hl sym">:</span>system-maintainer
-<a id=3D"l_80"></a><span class=3D"hl line"> 80 </span> #<span =
class=3D"hl sym">:</span>system-license
-<a id=3D"l_81"></a><span class=3D"hl line"> 81 </span> #<span =
class=3D"hl sym">:</span>system-licence
-<a id=3D"l_82"></a><span class=3D"hl line"> 82 </span> #<span =
class=3D"hl sym">:</span>system-source-file
-<a id=3D"l_83"></a><span class=3D"hl line"> 83 </span> #<span =
class=3D"hl sym">:</span>system-relative-pathname
-<a id=3D"l_84"></a><span class=3D"hl line"> 84 </span>
-<a id=3D"l_85"></a><span class=3D"hl line"> 85 </span> #<span =
class=3D"hl sym">:</span>operation-on-warnings
-<a id=3D"l_86"></a><span class=3D"hl line"> 86 </span> #<span =
class=3D"hl sym">:</span>operation-on-failure
-<a id=3D"l_87"></a><span class=3D"hl line"> 87 </span>
-<a id=3D"l_88"></a><span class=3D"hl line"> 88 </span> <span c=
lass=3D"hl slc">;#:*component-parent-pathname*</span>
-<a id=3D"l_89"></a><span class=3D"hl line"> 89 </span> #<span =
class=3D"hl sym">:*</span>system-definition-search-functions<span class=3D"=
hl sym">*</span>
-<a id=3D"l_90"></a><span class=3D"hl line"> 90 </span> #<span =
class=3D"hl sym">:*</span>central-registry<span class=3D"hl sym">*</span> =
<span class=3D"hl slc">; variables</span>
-<a id=3D"l_91"></a><span class=3D"hl line"> 91 </span> #<span =
class=3D"hl sym">:*</span>compile-file-warnings-behaviour<span class=3D"hl =
sym">*</span>
-<a id=3D"l_92"></a><span class=3D"hl line"> 92 </span> #<span =
class=3D"hl sym">:*</span>compile-file-failure-behaviour<span class=3D"hl s=
ym">*</span>
-<a id=3D"l_93"></a><span class=3D"hl line"> 93 </span> #<span =
class=3D"hl sym">:*</span>asdf-revision<span class=3D"hl sym">*</span>
-<a id=3D"l_94"></a><span class=3D"hl line"> 94 </span>
-<a id=3D"l_95"></a><span class=3D"hl line"> 95 </span> #<span =
class=3D"hl sym">:</span>operation-error #<span class=3D"hl sym">:</span>co=
mpile-failed #<span class=3D"hl sym">:</span>compile-warned #<span class=3D=
"hl sym">:</span>compile-error
-<a id=3D"l_96"></a><span class=3D"hl line"> 96 </span> #<span =
class=3D"hl sym">:</span>error-component #<span class=3D"hl sym">:</span>er=
ror-operation
-<a id=3D"l_97"></a><span class=3D"hl line"> 97 </span> #<span =
class=3D"hl sym">:</span>system-definition-error
-<a id=3D"l_98"></a><span class=3D"hl line"> 98 </span> #<span =
class=3D"hl sym">:</span>missing-component
-<a id=3D"l_99"></a><span class=3D"hl line"> 99 </span> #<span =
class=3D"hl sym">:</span>missing-dependency
-<a id=3D"l_100"></a><span class=3D"hl line"> 100 </span> #<span=
class=3D"hl sym">:</span>circular-dependency <span class=3D"hl slc"=
>; errors</span>
-<a id=3D"l_101"></a><span class=3D"hl line"> 101 </span> #<span=
class=3D"hl sym">:</span>duplicate-names
-<a id=3D"l_102"></a><span class=3D"hl line"> 102 </span>
-<a id=3D"l_103"></a><span class=3D"hl line"> 103 </span> #<span=
class=3D"hl sym">:</span>retry
-<a id=3D"l_104"></a><span class=3D"hl line"> 104 </span> #<span=
class=3D"hl sym">:</span>accept <span class=3D"hl slc"=
>; restarts</span>
-<a id=3D"l_105"></a><span class=3D"hl line"> 105 </span>
-<a id=3D"l_106"></a><span class=3D"hl line"> 106 </span> #<span=
class=3D"hl sym">:</span>preference-file-for-system<span class=3D"hl sym">=
/</span>operation
-<a id=3D"l_107"></a><span class=3D"hl line"> 107 </span> #<span=
class=3D"hl sym">:</span><span class=3D"hl kwa">load</span>-preferences
-<a id=3D"l_108"></a><span class=3D"hl line"> 108 </span> <span =
class=3D"hl sym">)</span>
-<a id=3D"l_109"></a><span class=3D"hl line"> 109 </span> <span class=3D"=
hl sym">(:</span>use <span class=3D"hl sym">:</span>cl<span class=3D"hl sym=
">))</span>
-<a id=3D"l_110"></a><span class=3D"hl line"> 110 </span>
-<a id=3D"l_111"></a><span class=3D"hl line"> 111 </span>
-<a id=3D"l_112"></a><span class=3D"hl line"> 112 </span>#<span class=3D"h=
l sym">+</span>nil
-<a id=3D"l_113"></a><span class=3D"hl line"> 113 </span><span class=3D"hl=
sym">(</span>error <span class=3D"hl str">"The author of this file ha=
bitually uses #+nil to comment out ~</span>
-<a id=3D"l_114"></a><span class=3D"hl line"> 114 </span><span class=3D"hl=
str"> forms. But don't worry, it was unlikely to work in the New ~<=
/span>
-<a id=3D"l_115"></a><span class=3D"hl line"> 115 </span><span class=3D"hl=
str"> Implementation of Lisp anyway"</span><span class=3D"hl s=
ym">)</span>
-<a id=3D"l_116"></a><span class=3D"hl line"> 116 </span>
-<a id=3D"l_117"></a><span class=3D"hl line"> 117 </span><span class=3D"hl=
sym">(</span>in-package #<span class=3D"hl sym">:</span>asdf<span class=3D=
"hl sym">)</span>
-<a id=3D"l_118"></a><span class=3D"hl line"> 118 </span>
-<a id=3D"l_119"></a><span class=3D"hl line"> 119 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>asdf-revision<span clas=
s=3D"hl sym">* (</span>let<span class=3D"hl sym">* ((</span>v <span class=
=3D"hl str">"$Revision$"</span><span class=3D"hl sym">)</span>
-<a id=3D"l_120"></a><span class=3D"hl line"> 120 </span> =
<span class=3D"hl sym">(</span>colon <span class=3D"hl sym">(=
</span><span class=3D"hl kwa">or</span> <span class=3D"hl sym">(</span>posi=
tion #\: v<span class=3D"hl sym">)</span> -<span class=3D"hl num">1</span><=
span class=3D"hl sym">))</span>
-<a id=3D"l_121"></a><span class=3D"hl line"> 121 </span> =
<span class=3D"hl sym">(</span>dot <span class=3D"hl sym">(</=
span>position #\. v<span class=3D"hl sym">)))</span>
-<a id=3D"l_122"></a><span class=3D"hl line"> 122 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">and</span> v=
colon dot
-<a id=3D"l_123"></a><span class=3D"hl line"> 123 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">list</s=
pan> <span class=3D"hl sym">(</span>parse-integer v <span class=3D"hl sym">=
:</span>start <span class=3D"hl sym">(</span><span class=3D"hl num">1</span=
><span class=3D"hl sym">+</span> colon<span class=3D"hl sym">)</span>
-<a id=3D"l_124"></a><span class=3D"hl line"> 124 </span> =
<span class=3D"hl sym">:</span>junk-al=
lowed t<span class=3D"hl sym">)</span>
-<a id=3D"l_125"></a><span class=3D"hl line"> 125 </span> =
<span class=3D"hl sym">(</span>parse-integer v <span cl=
ass=3D"hl sym">:</span>start <span class=3D"hl sym">(</span><span class=3D"=
hl num">1</span><span class=3D"hl sym">+</span> dot<span class=3D"hl sym">)=
</span>
-<a id=3D"l_126"></a><span class=3D"hl line"> 126 </span> =
<span class=3D"hl sym">:</span>junk-al=
lowed t<span class=3D"hl sym">)))))</span>
-<a id=3D"l_127"></a><span class=3D"hl line"> 127 </span>
-<a id=3D"l_128"></a><span class=3D"hl line"> 128 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>compile-file-warnings-b=
ehaviour<span class=3D"hl sym">* :</span>warn<span class=3D"hl sym">)</span>
-<a id=3D"l_129"></a><span class=3D"hl line"> 129 </span>
-<a id=3D"l_130"></a><span class=3D"hl line"> 130 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>compile-file-failure-be=
haviour<span class=3D"hl sym">*</span> #<span class=3D"hl sym">+</span>sbcl=
<span class=3D"hl sym">:</span>error #-sbcl <span class=3D"hl sym">:</span=
>warn<span class=3D"hl sym">)</span>
-<a id=3D"l_131"></a><span class=3D"hl line"> 131 </span>
-<a id=3D"l_132"></a><span class=3D"hl line"> 132 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>verbose-out<span class=
=3D"hl sym">*</span> nil<span class=3D"hl sym">)</span>
-<a id=3D"l_133"></a><span class=3D"hl line"> 133 </span>
-<a id=3D"l_134"></a><span class=3D"hl line"> 134 </span><span class=3D"hl=
sym">(</span>defparameter <span class=3D"hl sym">+</span>asdf-methods<span=
class=3D"hl sym">+</span>
-<a id=3D"l_135"></a><span class=3D"hl line"> 135 </span> <span class=3D"=
hl sym">'(</span>perform explain output-files operation-done-p<span class=
=3D"hl sym">))</span>
-<a id=3D"l_136"></a><span class=3D"hl line"> 136 </span>
-<a id=3D"l_137"></a><span class=3D"hl line"> 137 </span><span class=3D"hl=
slc">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</span>
-<a id=3D"l_138"></a><span class=3D"hl line"> 138 </span><span class=3D"hl=
slc">;; utility stuff</span>
-<a id=3D"l_139"></a><span class=3D"hl line"> 139 </span>
-<a id=3D"l_140"></a><span class=3D"hl line"> 140 </span><span class=3D"hl=
sym">(</span>defmacro aif <span class=3D"hl sym">(</span>test then <span c=
lass=3D"hl sym">&</span>optional else<span class=3D"hl sym">)</span>
-<a id=3D"l_141"></a><span class=3D"hl line"> 141 </span> `<span class=3D=
"hl sym">(</span>let <span class=3D"hl sym">((</span>it <span class=3D"hl s=
ym">,</span>test<span class=3D"hl sym">)) (</span><span class=3D"hl kwa">if=
</span> it <span class=3D"hl sym">,</span>then <span class=3D"hl sym">,</sp=
an>else<span class=3D"hl sym">)))</span>
-<a id=3D"l_142"></a><span class=3D"hl line"> 142 </span>
-<a id=3D"l_143"></a><span class=3D"hl line"> 143 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> pathname-sans-name<span c=
lass=3D"hl sym">+</span><span class=3D"hl kwa">type</span> <span class=3D"h=
l sym">(</span>pathname<span class=3D"hl sym">)</span>
-<a id=3D"l_144"></a><span class=3D"hl line"> 144 </span> <span class=3D"=
hl str">"Returns a new pathname with same HOST, DEVICE, DIRECTORY as P=
ATHNAME,</span>
-<a id=3D"l_145"></a><span class=3D"hl line"> 145 </span><span class=3D"hl=
str">and NIL NAME and TYPE components"</span>
-<a id=3D"l_146"></a><span class=3D"hl line"> 146 </span> <span class=3D"=
hl sym">(</span>make-pathname <span class=3D"hl sym">:</span>name nil <span=
class=3D"hl sym">:</span><span class=3D"hl kwa">type</span> nil <span clas=
s=3D"hl sym">:</span>defaults pathname<span class=3D"hl sym">))</span>
-<a id=3D"l_147"></a><span class=3D"hl line"> 147 </span>
-<a id=3D"l_148"></a><span class=3D"hl line"> 148 </span><span class=3D"hl=
sym">(</span>define-modify-macro appendf <span class=3D"hl sym">(&</sp=
an>rest args<span class=3D"hl sym">)</span>
-<a id=3D"l_149"></a><span class=3D"hl line"> 149 </span> <span class=3D"=
hl kwa">append</span> <span class=3D"hl str">"Append onto list"</=
span><span class=3D"hl sym">)</span>
-<a id=3D"l_150"></a><span class=3D"hl line"> 150 </span>
-<a id=3D"l_151"></a><span class=3D"hl line"> 151 </span><span class=3D"hl=
slc">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</span>
-<a id=3D"l_152"></a><span class=3D"hl line"> 152 </span><span class=3D"hl=
slc">;; classes, condiitons</span>
-<a id=3D"l_153"></a><span class=3D"hl line"> 153 </span>
-<a id=3D"l_154"></a><span class=3D"hl line"> 154 </span><span class=3D"hl=
sym">(</span>define-condition system-definition-error <span class=3D"hl sy=
m">(</span>error<span class=3D"hl sym">) ()</span>
-<a id=3D"l_155"></a><span class=3D"hl line"> 155 </span> <span class=3D"=
hl slc">;; [this use of :report should be redundant, but unfortunately it's=
not.</span>
-<a id=3D"l_156"></a><span class=3D"hl line"> 156 </span> <span class=3D"=
hl slc">;; cmucl's lisp::output-instance prefers the kernel:slot-class-prin=
t-function</span>
-<a id=3D"l_157"></a><span class=3D"hl line"> 157 </span> <span class=3D"=
hl slc">;; over print-object; this is always conditions::%print-condition f=
or</span>
-<a id=3D"l_158"></a><span class=3D"hl line"> 158 </span> <span class=3D"=
hl slc">;; condition objects, which in turn does inheritance of :report opt=
ions at</span>
-<a id=3D"l_159"></a><span class=3D"hl line"> 159 </span> <span class=3D"=
hl slc">;; run-time. fortunately, inheritance means we only need this klud=
ge here in</span>
-<a id=3D"l_160"></a><span class=3D"hl line"> 160 </span> <span class=3D"=
hl slc">;; order to fix all conditions that build on it. -- rgr, 28-Jul-02=
.]</span>
-<a id=3D"l_161"></a><span class=3D"hl line"> 161 </span> #<span class=3D=
"hl sym">+</span>cmu <span class=3D"hl sym">(:</span>report <span class=3D"=
hl kwa">print</span>-object<span class=3D"hl sym">))</span>
-<a id=3D"l_162"></a><span class=3D"hl line"> 162 </span>
-<a id=3D"l_163"></a><span class=3D"hl line"> 163 </span><span class=3D"hl=
sym">(</span>define-condition formatted-system-definition-error <span clas=
s=3D"hl sym">(</span>system-definition-error<span class=3D"hl sym">)</span>
-<a id=3D"l_164"></a><span class=3D"hl line"> 164 </span> <span class=3D"=
hl sym">((</span>format-control <span class=3D"hl sym">:</span>initarg <spa=
n class=3D"hl sym">:</span>format-control <span class=3D"hl sym">:</span>re=
ader format-control<span class=3D"hl sym">)</span>
-<a id=3D"l_165"></a><span class=3D"hl line"> 165 </span> <span class=3D=
"hl sym">(</span>format-arguments <span class=3D"hl sym">:</span>initarg <s=
pan class=3D"hl sym">:</span>format-arguments <span class=3D"hl sym">:</spa=
n>reader format-arguments<span class=3D"hl sym">))</span>
-<a id=3D"l_166"></a><span class=3D"hl line"> 166 </span> <span class=3D"=
hl sym">(:</span>report <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">lambda</span> <span class=3D"hl sym">(</span>c s<span class=3D"hl sym">)=
</span>
-<a id=3D"l_167"></a><span class=3D"hl line"> 167 </span> <spa=
n class=3D"hl sym">(</span><span class=3D"hl kwa">apply</span> #<span class=
=3D"hl sym">'</span>format s <span class=3D"hl sym">(</span>format-control =
c<span class=3D"hl sym">) (</span>format-arguments c<span class=3D"hl sym">=
)))))</span>
-<a id=3D"l_168"></a><span class=3D"hl line"> 168 </span>
-<a id=3D"l_169"></a><span class=3D"hl line"> 169 </span><span class=3D"hl=
sym">(</span>define-condition circular-dependency <span class=3D"hl sym">(=
</span>system-definition-error<span class=3D"hl sym">)</span>
-<a id=3D"l_170"></a><span class=3D"hl line"> 170 </span> <span class=3D"=
hl sym">((</span>components <span class=3D"hl sym">:</span>initarg <span cl=
ass=3D"hl sym">:</span>components <span class=3D"hl sym">:</span>reader cir=
cular-dependency-components<span class=3D"hl sym">)))</span>
-<a id=3D"l_171"></a><span class=3D"hl line"> 171 </span>
-<a id=3D"l_172"></a><span class=3D"hl line"> 172 </span><span class=3D"hl=
sym">(</span>define-condition duplicate-names <span class=3D"hl sym">(</sp=
an>system-definition-error<span class=3D"hl sym">)</span>
-<a id=3D"l_173"></a><span class=3D"hl line"> 173 </span> <span class=3D"=
hl sym">((</span>name <span class=3D"hl sym">:</span>initarg <span class=3D=
"hl sym">:</span>name <span class=3D"hl sym">:</span>reader duplicate-names=
-name<span class=3D"hl sym">)))</span>
-<a id=3D"l_174"></a><span class=3D"hl line"> 174 </span>
-<a id=3D"l_175"></a><span class=3D"hl line"> 175 </span><span class=3D"hl=
sym">(</span>define-condition missing-component <span class=3D"hl sym">(</=
span>system-definition-error<span class=3D"hl sym">)</span>
-<a id=3D"l_176"></a><span class=3D"hl line"> 176 </span> <span class=3D"=
hl sym">((</span>requires <span class=3D"hl sym">:</span>initform <span cla=
ss=3D"hl str">"(unnamed)"</span> <span class=3D"hl sym">:</span>r=
eader missing-requires <span class=3D"hl sym">:</span>initarg <span class=
=3D"hl sym">:</span>requires<span class=3D"hl sym">)</span>
-<a id=3D"l_177"></a><span class=3D"hl line"> 177 </span> <span class=3D=
"hl sym">(</span>version <span class=3D"hl sym">:</span>initform nil <span =
class=3D"hl sym">:</span>reader missing-version <span class=3D"hl sym">:</s=
pan>initarg <span class=3D"hl sym">:</span>version<span class=3D"hl sym">)<=
/span>
-<a id=3D"l_178"></a><span class=3D"hl line"> 178 </span> <span class=3D=
"hl sym">(</span>parent <span class=3D"hl sym">:</span>initform nil <span c=
lass=3D"hl sym">:</span>reader missing-parent <span class=3D"hl sym">:</spa=
n>initarg <span class=3D"hl sym">:</span>parent<span class=3D"hl sym">)))</=
span>
-<a id=3D"l_179"></a><span class=3D"hl line"> 179 </span>
-<a id=3D"l_180"></a><span class=3D"hl line"> 180 </span><span class=3D"hl=
sym">(</span>define-condition missing-dependency <span class=3D"hl sym">(<=
/span>missing-component<span class=3D"hl sym">)</span>
-<a id=3D"l_181"></a><span class=3D"hl line"> 181 </span> <span class=3D"=
hl sym">((</span>required-by <span class=3D"hl sym">:</span>initarg <span c=
lass=3D"hl sym">:</span>required-by <span class=3D"hl sym">:</span>reader m=
issing-required-by<span class=3D"hl sym">)))</span>
-<a id=3D"l_182"></a><span class=3D"hl line"> 182 </span>
-<a id=3D"l_183"></a><span class=3D"hl line"> 183 </span><span class=3D"hl=
sym">(</span>define-condition operation-error <span class=3D"hl sym">(</sp=
an>error<span class=3D"hl sym">)</span>
-<a id=3D"l_184"></a><span class=3D"hl line"> 184 </span> <span class=3D"=
hl sym">((</span>component <span class=3D"hl sym">:</span>reader error-comp=
onent <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span=
>component<span class=3D"hl sym">)</span>
-<a id=3D"l_185"></a><span class=3D"hl line"> 185 </span> <span class=3D=
"hl sym">(</span>operation <span class=3D"hl sym">:</span>reader error-oper=
ation <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span=
>operation<span class=3D"hl sym">))</span>
-<a id=3D"l_186"></a><span class=3D"hl line"> 186 </span> <span class=3D"=
hl sym">(:</span>report <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">lambda</span> <span class=3D"hl sym">(</span>c s<span class=3D"hl sym">)=
</span>
-<a id=3D"l_187"></a><span class=3D"hl line"> 187 </span> <spa=
n class=3D"hl sym">(</span>format s <span class=3D"hl str">"~@<=
erred while invoking ~A on ~A~@:>"</span>
-<a id=3D"l_188"></a><span class=3D"hl line"> 188 </span> =
<span class=3D"hl sym">(</span>error-operation c<span class=3D"hl sym">=
) (</span>error-component c<span class=3D"hl sym">)))))</span>
-<a id=3D"l_189"></a><span class=3D"hl line"> 189 </span><span class=3D"hl=
sym">(</span>define-condition compile-error <span class=3D"hl sym">(</span=
>operation-error<span class=3D"hl sym">) ())</span>
-<a id=3D"l_190"></a><span class=3D"hl line"> 190 </span><span class=3D"hl=
sym">(</span>define-condition compile-failed <span class=3D"hl sym">(</spa=
n>compile-error<span class=3D"hl sym">) ())</span>
-<a id=3D"l_191"></a><span class=3D"hl line"> 191 </span><span class=3D"hl=
sym">(</span>define-condition compile-warned <span class=3D"hl sym">(</spa=
n>compile-error<span class=3D"hl sym">) ())</span>
-<a id=3D"l_192"></a><span class=3D"hl line"> 192 </span>
-<a id=3D"l_193"></a><span class=3D"hl line"> 193 </span><span class=3D"hl=
sym">(</span>defclass component <span class=3D"hl sym">()</span>
-<a id=3D"l_194"></a><span class=3D"hl line"> 194 </span> <span class=3D"=
hl sym">((</span>name <span class=3D"hl sym">:</span>accessor component-nam=
e <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>nam=
e <span class=3D"hl sym">:</span>documentation
-<a id=3D"l_195"></a><span class=3D"hl line"> 195 </span> <span cl=
ass=3D"hl str">"Component name: designator for a string composed of po=
rtable pathname characters"</span><span class=3D"hl sym">)</span>
-<a id=3D"l_196"></a><span class=3D"hl line"> 196 </span> <span class=3D=
"hl sym">(</span>version <span class=3D"hl sym">:</span>accessor component-=
version <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</sp=
an>version<span class=3D"hl sym">)</span>
-<a id=3D"l_197"></a><span class=3D"hl line"> 197 </span> <span class=3D=
"hl sym">(</span>in-order-to <span class=3D"hl sym">:</span>initform nil <s=
pan class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>in-orde=
r-to<span class=3D"hl sym">)</span>
-<a id=3D"l_198"></a><span class=3D"hl line"> 198 </span> <span class=3D=
"hl slc">;; XXX crap name</span>
-<a id=3D"l_199"></a><span class=3D"hl line"> 199 </span> <span class=3D=
"hl sym">(</span>do-first <span class=3D"hl sym">:</span>initform nil <span=
class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>do-first<s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_200"></a><span class=3D"hl line"> 200 </span> <span class=3D=
"hl slc">;; methods defined using the "inline" style inside a def=
system form:</span>
-<a id=3D"l_201"></a><span class=3D"hl line"> 201 </span> <span class=3D=
"hl slc">;; need to store them somewhere so we can delete them when the sys=
tem</span>
-<a id=3D"l_202"></a><span class=3D"hl line"> 202 </span> <span class=3D=
"hl slc">;; is re-evaluated</span>
-<a id=3D"l_203"></a><span class=3D"hl line"> 203 </span> <span class=3D=
"hl sym">(</span>inline-methods <span class=3D"hl sym">:</span>accessor com=
ponent-inline-methods <span class=3D"hl sym">:</span>initform nil<span clas=
s=3D"hl sym">)</span>
-<a id=3D"l_204"></a><span class=3D"hl line"> 204 </span> <span class=3D=
"hl sym">(</span>parent <span class=3D"hl sym">:</span>initarg <span class=
=3D"hl sym">:</span>parent <span class=3D"hl sym">:</span>initform nil <spa=
n class=3D"hl sym">:</span>reader component-parent<span class=3D"hl sym">)<=
/span>
-<a id=3D"l_205"></a><span class=3D"hl line"> 205 </span> <span class=3D=
"hl slc">;; no direct accessor for pathname, we do this as a method to allo=
w</span>
-<a id=3D"l_206"></a><span class=3D"hl line"> 206 </span> <span class=3D=
"hl slc">;; it to default in funky ways if not supplied</span>
-<a id=3D"l_207"></a><span class=3D"hl line"> 207 </span> <span class=3D=
"hl sym">(</span>relative-pathname <span class=3D"hl sym">:</span>initarg <=
span class=3D"hl sym">:</span>pathname<span class=3D"hl sym">)</span>
-<a id=3D"l_208"></a><span class=3D"hl line"> 208 </span> <span class=3D=
"hl sym">(</span>operation-times <span class=3D"hl sym">:</span>initform <s=
pan class=3D"hl sym">(</span>make-hash-table <span class=3D"hl sym">)</span>
-<a id=3D"l_209"></a><span class=3D"hl line"> 209 </span> =
<span class=3D"hl sym">:</span>accessor component-operation-times<span c=
lass=3D"hl sym">)</span>
-<a id=3D"l_210"></a><span class=3D"hl line"> 210 </span> <span class=3D=
"hl slc">;; XXX we should provide some atomic interface for updating the</s=
pan>
-<a id=3D"l_211"></a><span class=3D"hl line"> 211 </span> <span class=3D=
"hl slc">;; component properties</span>
-<a id=3D"l_212"></a><span class=3D"hl line"> 212 </span> <span class=3D=
"hl sym">(</span>properties <span class=3D"hl sym">:</span>accessor compone=
nt-properties <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym"=
>:</span>properties
-<a id=3D"l_213"></a><span class=3D"hl line"> 213 </span> <s=
pan class=3D"hl sym">:</span>initform nil<span class=3D"hl sym">)))</span>
-<a id=3D"l_214"></a><span class=3D"hl line"> 214 </span>
-<a id=3D"l_215"></a><span class=3D"hl line"> 215 </span><span class=3D"hl=
slc">;;;; methods: conditions</span>
-<a id=3D"l_216"></a><span class=3D"hl line"> 216 </span>
-<a id=3D"l_217"></a><span class=3D"hl line"> 217 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl kwa">print</span>-object <span cl=
ass=3D"hl sym">((</span>c missing-dependency<span class=3D"hl sym">)</span>=
s<span class=3D"hl sym">)</span>
-<a id=3D"l_218"></a><span class=3D"hl line"> 218 </span> <span class=3D"=
hl sym">(</span>format s <span class=3D"hl str">"~@<~A, require=
d by ~A~@:>"</span>
-<a id=3D"l_219"></a><span class=3D"hl line"> 219 </span> <span c=
lass=3D"hl sym">(</span>call-next-method c nil<span class=3D"hl sym">) (</s=
pan>missing-required-by c<span class=3D"hl sym">)))</span>
-<a id=3D"l_220"></a><span class=3D"hl line"> 220 </span>
-<a id=3D"l_221"></a><span class=3D"hl line"> 221 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> sysdef-error <span class=
=3D"hl sym">(</span>format <span class=3D"hl sym">&</span>rest argument=
s<span class=3D"hl sym">)</span>
-<a id=3D"l_222"></a><span class=3D"hl line"> 222 </span> <span class=3D"=
hl sym">(</span>error <span class=3D"hl sym">'</span>formatted-system-defin=
ition-error <span class=3D"hl sym">:</span>format-control format <span clas=
s=3D"hl sym">:</span>format-arguments arguments<span class=3D"hl sym">))</s=
pan>
-<a id=3D"l_223"></a><span class=3D"hl line"> 223 </span>
-<a id=3D"l_224"></a><span class=3D"hl line"> 224 </span><span class=3D"hl=
slc">;;;; methods: components</span>
-<a id=3D"l_225"></a><span class=3D"hl line"> 225 </span>
-<a id=3D"l_226"></a><span class=3D"hl line"> 226 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl kwa">print</span>-object <span cl=
ass=3D"hl sym">((</span>c missing-component<span class=3D"hl sym">)</span> =
s<span class=3D"hl sym">)</span>
-<a id=3D"l_227"></a><span class=3D"hl line"> 227 </span> <span class=3D"=
hl sym">(</span>format s <span class=3D"hl str">"~@<component ~=
S not found~</span>
-<a id=3D"l_228"></a><span class=3D"hl line"> 228 </span><span class=3D"hl=
str"> ~@[ or does not match version ~A~]~</span>
-<a id=3D"l_229"></a><span class=3D"hl line"> 229 </span><span class=3D"hl=
str"> ~@[ in ~A~]~@:>"</span>
-<a id=3D"l_230"></a><span class=3D"hl line"> 230 </span> <span c=
lass=3D"hl sym">(</span>missing-requires c<span class=3D"hl sym">)</span>
-<a id=3D"l_231"></a><span class=3D"hl line"> 231 </span> <span c=
lass=3D"hl sym">(</span>missing-version c<span class=3D"hl sym">)</span>
-<a id=3D"l_232"></a><span class=3D"hl line"> 232 </span> <span c=
lass=3D"hl sym">(</span>when <span class=3D"hl sym">(</span>missing-parent =
c<span class=3D"hl sym">)</span>
-<a id=3D"l_233"></a><span class=3D"hl line"> 233 </span> <span=
class=3D"hl sym">(</span>component-name <span class=3D"hl sym">(</span>mis=
sing-parent c<span class=3D"hl sym">)))))</span>
-<a id=3D"l_234"></a><span class=3D"hl line"> 234 </span>
-<a id=3D"l_235"></a><span class=3D"hl line"> 235 </span><span class=3D"hl=
sym">(</span>defgeneric component-system <span class=3D"hl sym">(</span>co=
mponent<span class=3D"hl sym">)</span>
-<a id=3D"l_236"></a><span class=3D"hl line"> 236 </span> <span class=3D"=
hl sym">(:</span>documentation <span class=3D"hl str">"Find the top-le=
vel system containing COMPONENT"</span><span class=3D"hl sym">))</span>
-<a id=3D"l_237"></a><span class=3D"hl line"> 237 </span>
-<a id=3D"l_238"></a><span class=3D"hl line"> 238 </span><span class=3D"hl=
sym">(</span>defmethod component-system <span class=3D"hl sym">((</span>co=
mponent component<span class=3D"hl sym">))</span>
-<a id=3D"l_239"></a><span class=3D"hl line"> 239 </span> <span class=3D"=
hl sym">(</span>aif <span class=3D"hl sym">(</span>component-parent compone=
nt<span class=3D"hl sym">)</span>
-<a id=3D"l_240"></a><span class=3D"hl line"> 240 </span> <span clas=
s=3D"hl sym">(</span>component-system it<span class=3D"hl sym">)</span>
-<a id=3D"l_241"></a><span class=3D"hl line"> 241 </span> component<=
span class=3D"hl sym">))</span>
-<a id=3D"l_242"></a><span class=3D"hl line"> 242 </span>
-<a id=3D"l_243"></a><span class=3D"hl line"> 243 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl kwa">print</span>-object <span cl=
ass=3D"hl sym">((</span>c component<span class=3D"hl sym">)</span> stream<s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_244"></a><span class=3D"hl line"> 244 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">print</span>-unreadable-object <span=
class=3D"hl sym">(</span>c stream <span class=3D"hl sym">:</span><span cla=
ss=3D"hl kwa">type</span> t <span class=3D"hl sym">:</span>identity t<span =
class=3D"hl sym">)</span>
-<a id=3D"l_245"></a><span class=3D"hl line"> 245 </span> <span class=
=3D"hl sym">(</span>ignore-errors
-<a id=3D"l_246"></a><span class=3D"hl line"> 246 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">prin1</span> <span class=3D"hl s=
ym">(</span>component-name c<span class=3D"hl sym">)</span> stream<span cla=
ss=3D"hl sym">))))</span>
-<a id=3D"l_247"></a><span class=3D"hl line"> 247 </span>
-<a id=3D"l_248"></a><span class=3D"hl line"> 248 </span><span class=3D"hl=
sym">(</span>defclass module <span class=3D"hl sym">(</span>component<span=
class=3D"hl sym">)</span>
-<a id=3D"l_249"></a><span class=3D"hl line"> 249 </span> <span class=3D"=
hl sym">((</span>components <span class=3D"hl sym">:</span>initform nil <sp=
an class=3D"hl sym">:</span>accessor module-components <span class=3D"hl sy=
m">:</span>initarg <span class=3D"hl sym">:</span>components<span class=3D"=
hl sym">)</span>
-<a id=3D"l_250"></a><span class=3D"hl line"> 250 </span> <span class=3D=
"hl slc">;; what to do if we can't satisfy a dependency of one of this modu=
le's</span>
-<a id=3D"l_251"></a><span class=3D"hl line"> 251 </span> <span class=3D=
"hl slc">;; components. This allows a limited form of conditional processi=
ng</span>
-<a id=3D"l_252"></a><span class=3D"hl line"> 252 </span> <span class=3D=
"hl sym">(</span><span class=3D"hl kwa">if</span>-component-dep-fails <span=
class=3D"hl sym">:</span>initform <span class=3D"hl sym">:</span>fail
-<a id=3D"l_253"></a><span class=3D"hl line"> 253 </span> =
<span class=3D"hl sym">:</span>accessor module-<span class=3D"hl =
kwa">if</span>-component-dep-fails
-<a id=3D"l_254"></a><span class=3D"hl line"> 254 </span> =
<span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</=
span><span class=3D"hl kwa">if</span>-component-dep-fails<span class=3D"hl =
sym">)</span>
-<a id=3D"l_255"></a><span class=3D"hl line"> 255 </span> <span class=3D=
"hl sym">(</span>default-component-class <span class=3D"hl sym">:</span>acc=
essor module-default-component-class
-<a id=3D"l_256"></a><span class=3D"hl line"> 256 </span> <span class=
=3D"hl sym">:</span>initform <span class=3D"hl sym">'</span>cl-source-file =
<span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>defau=
lt-component-class<span class=3D"hl sym">)))</span>
-<a id=3D"l_257"></a><span class=3D"hl line"> 257 </span>
-<a id=3D"l_258"></a><span class=3D"hl line"> 258 </span><span class=3D"hl=
sym">(</span>defgeneric component-pathname <span class=3D"hl sym">(</span>=
component<span class=3D"hl sym">)</span>
-<a id=3D"l_259"></a><span class=3D"hl line"> 259 </span> <span class=3D"=
hl sym">(:</span>documentation <span class=3D"hl str">"Extracts the pa=
thname applicable for a particular component."</span><span class=3D"hl=
sym">))</span>
-<a id=3D"l_260"></a><span class=3D"hl line"> 260 </span>
-<a id=3D"l_261"></a><span class=3D"hl line"> 261 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> component-parent-pathname=
<span class=3D"hl sym">(</span>component<span class=3D"hl sym">)</span>
-<a id=3D"l_262"></a><span class=3D"hl line"> 262 </span> <span class=3D"=
hl sym">(</span>aif <span class=3D"hl sym">(</span>component-parent compone=
nt<span class=3D"hl sym">)</span>
-<a id=3D"l_263"></a><span class=3D"hl line"> 263 </span> <span clas=
s=3D"hl sym">(</span>component-pathname it<span class=3D"hl sym">)</span>
-<a id=3D"l_264"></a><span class=3D"hl line"> 264 </span> <span clas=
s=3D"hl sym">*</span>default-pathname-defaults<span class=3D"hl sym">*))</s=
pan>
-<a id=3D"l_265"></a><span class=3D"hl line"> 265 </span>
-<a id=3D"l_266"></a><span class=3D"hl line"> 266 </span><span class=3D"hl=
sym">(</span>defgeneric component-relative-pathname <span class=3D"hl sym"=
>(</span>component<span class=3D"hl sym">)</span>
-<a id=3D"l_267"></a><span class=3D"hl line"> 267 </span> <span class=3D"=
hl sym">(:</span>documentation <span class=3D"hl str">"Extracts the re=
lative pathname applicable for a particular component."</span><span cl=
ass=3D"hl sym">))</span>
-<a id=3D"l_268"></a><span class=3D"hl line"> 268 </span>
-<a id=3D"l_269"></a><span class=3D"hl line"> 269 </span><span class=3D"hl=
sym">(</span>defmethod component-relative-pathname <span class=3D"hl sym">=
((</span>component module<span class=3D"hl sym">))</span>
-<a id=3D"l_270"></a><span class=3D"hl line"> 270 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">or</span> <span class=3D"hl sym">(</=
span>slot-value component <span class=3D"hl sym">'</span>relative-pathname<=
span class=3D"hl sym">)</span>
-<a id=3D"l_271"></a><span class=3D"hl line"> 271 </span> <span class=
=3D"hl sym">(</span>make-pathname
-<a id=3D"l_272"></a><span class=3D"hl line"> 272 </span> <span clas=
s=3D"hl sym">:</span>directory `<span class=3D"hl sym">(:</span>relative <s=
pan class=3D"hl sym">,(</span>component-name component<span class=3D"hl sym=
">))</span>
-<a id=3D"l_273"></a><span class=3D"hl line"> 273 </span> <span clas=
s=3D"hl sym">:</span>host <span class=3D"hl sym">(</span>pathname-host <spa=
n class=3D"hl sym">(</span>component-parent-pathname component<span class=
=3D"hl sym">)))))</span>
-<a id=3D"l_274"></a><span class=3D"hl line"> 274 </span>
-<a id=3D"l_275"></a><span class=3D"hl line"> 275 </span><span class=3D"hl=
sym">(</span>defmethod component-pathname <span class=3D"hl sym">((</span>=
component component<span class=3D"hl sym">))</span>
-<a id=3D"l_276"></a><span class=3D"hl line"> 276 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((*</span>default-pathname-defau=
lts<span class=3D"hl sym">* (</span>component-parent-pathname component<spa=
n class=3D"hl sym">)))</span>
-<a id=3D"l_277"></a><span class=3D"hl line"> 277 </span> <span class=
=3D"hl sym">(</span>merge-pathnames <span class=3D"hl sym">(</span>componen=
t-relative-pathname component<span class=3D"hl sym">))))</span>
-<a id=3D"l_278"></a><span class=3D"hl line"> 278 </span>
-<a id=3D"l_279"></a><span class=3D"hl line"> 279 </span><span class=3D"hl=
sym">(</span>defgeneric component-property <span class=3D"hl sym">(</span>=
component property<span class=3D"hl sym">))</span>
-<a id=3D"l_280"></a><span class=3D"hl line"> 280 </span>
-<a id=3D"l_281"></a><span class=3D"hl line"> 281 </span><span class=3D"hl=
sym">(</span>defmethod component-property <span class=3D"hl sym">((</span>=
c component<span class=3D"hl sym">)</span> property<span class=3D"hl sym">)=
</span>
-<a id=3D"l_282"></a><span class=3D"hl line"> 282 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">cdr</span> <span class=3D"hl sym">(<=
/span><span class=3D"hl kwa">assoc</span> property <span class=3D"hl sym">(=
</span>slot-value c <span class=3D"hl sym">'</span>properties<span class=3D=
"hl sym">) :</span>test #<span class=3D"hl sym">'</span><span class=3D"hl k=
wa">equal</span><span class=3D"hl sym">)))</span>
-<a id=3D"l_283"></a><span class=3D"hl line"> 283 </span>
-<a id=3D"l_284"></a><span class=3D"hl line"> 284 </span><span class=3D"hl=
sym">(</span>defgeneric <span class=3D"hl sym">(</span>setf component-prop=
erty<span class=3D"hl sym">) (</span>new-value component property<span clas=
s=3D"hl sym">))</span>
-<a id=3D"l_285"></a><span class=3D"hl line"> 285 </span>
-<a id=3D"l_286"></a><span class=3D"hl line"> 286 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl sym">(</span>setf component-prope=
rty<span class=3D"hl sym">) (</span>new-value <span class=3D"hl sym">(</spa=
n>c component<span class=3D"hl sym">)</span> property<span class=3D"hl sym"=
>)</span>
-<a id=3D"l_287"></a><span class=3D"hl line"> 287 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>a <span class=3D"hl sym=
">(</span><span class=3D"hl kwa">assoc</span> property <span class=3D"hl sy=
m">(</span>slot-value c <span class=3D"hl sym">'</span>properties<span clas=
s=3D"hl sym">) :</span>test #<span class=3D"hl sym">'</span><span class=3D"=
hl kwa">equal</span><span class=3D"hl sym">)))</span>
-<a id=3D"l_288"></a><span class=3D"hl line"> 288 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> a
-<a id=3D"l_289"></a><span class=3D"hl line"> 289 </span> <span cla=
ss=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span><span class=3D"hl=
kwa">cdr</span> a<span class=3D"hl sym">)</span> new-value<span class=3D"h=
l sym">)</span>
-<a id=3D"l_290"></a><span class=3D"hl line"> 290 </span> <span cla=
ss=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>slot-value c <spa=
n class=3D"hl sym">'</span>properties<span class=3D"hl sym">)</span>
-<a id=3D"l_291"></a><span class=3D"hl line"> 291 </span> <sp=
an class=3D"hl sym">(</span>acons property new-value <span class=3D"hl sym"=
>(</span>slot-value c <span class=3D"hl sym">'</span>properties<span class=
=3D"hl sym">))))))</span>
-<a id=3D"l_292"></a><span class=3D"hl line"> 292 </span>
-<a id=3D"l_293"></a><span class=3D"hl line"> 293 </span><span class=3D"hl=
sym">(</span>defclass system <span class=3D"hl sym">(</span>module<span cl=
ass=3D"hl sym">)</span>
-<a id=3D"l_294"></a><span class=3D"hl line"> 294 </span> <span class=3D"=
hl sym">((</span>description <span class=3D"hl sym">:</span>accessor system=
-description <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">=
:</span>description<span class=3D"hl sym">)</span>
-<a id=3D"l_295"></a><span class=3D"hl line"> 295 </span> <span class=3D=
"hl sym">(</span>long-description
-<a id=3D"l_296"></a><span class=3D"hl line"> 296 </span> <span class=
=3D"hl sym">:</span>accessor system-long-description <span class=3D"hl sym"=
>:</span>initarg <span class=3D"hl sym">:</span>long-description<span class=
=3D"hl sym">)</span>
-<a id=3D"l_297"></a><span class=3D"hl line"> 297 </span> <span class=3D=
"hl sym">(</span>author <span class=3D"hl sym">:</span>accessor system-auth=
or <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>au=
thor<span class=3D"hl sym">)</span>
-<a id=3D"l_298"></a><span class=3D"hl line"> 298 </span> <span class=3D=
"hl sym">(</span>maintainer <span class=3D"hl sym">:</span>accessor system-=
maintainer <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:<=
/span>maintainer<span class=3D"hl sym">)</span>
-<a id=3D"l_299"></a><span class=3D"hl line"> 299 </span> <span class=3D=
"hl sym">(</span>licence <span class=3D"hl sym">:</span>accessor system-lic=
ence <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>=
licence
-<a id=3D"l_300"></a><span class=3D"hl line"> 300 </span> <span=
class=3D"hl sym">:</span>accessor system-license <span class=3D"hl sym">:<=
/span>initarg <span class=3D"hl sym">:</span>license<span class=3D"hl sym">=
)))</span>
-<a id=3D"l_301"></a><span class=3D"hl line"> 301 </span>
-<a id=3D"l_302"></a><span class=3D"hl line"> 302 </span><span class=3D"hl=
slc">;;; version-satisfies</span>
-<a id=3D"l_303"></a><span class=3D"hl line"> 303 </span>
-<a id=3D"l_304"></a><span class=3D"hl line"> 304 </span><span class=3D"hl=
slc">;;; with apologies to christophe rhodes ...</span>
-<a id=3D"l_305"></a><span class=3D"hl line"> 305 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> split <span class=3D"hl s=
ym">(</span>string <span class=3D"hl sym">&</span>optional <span class=
=3D"hl kwa">max</span> <span class=3D"hl sym">(</span>ws <span class=3D"hl =
sym">'(</span>#\Space #\Tab<span class=3D"hl sym">)))</span>
-<a id=3D"l_306"></a><span class=3D"hl line"> 306 </span> <span class=3D"=
hl sym">(</span>flet <span class=3D"hl sym">((</span>is-ws <span class=3D"h=
l sym">(</span>char<span class=3D"hl sym">) (</span>find char ws<span class=
=3D"hl sym">)))</span>
-<a id=3D"l_307"></a><span class=3D"hl line"> 307 </span> <span class=
=3D"hl sym">(</span>nreverse
-<a id=3D"l_308"></a><span class=3D"hl line"> 308 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span><span class=3D"hl k=
wa">list</span> nil<span class=3D"hl sym">) (</span>start <span class=3D"hl=
num">0</span><span class=3D"hl sym">) (</span>words <span class=3D"hl num"=
>0</span><span class=3D"hl sym">)</span> end<span class=3D"hl sym">)</span>
-<a id=3D"l_309"></a><span class=3D"hl line"> 309 </span> <span clas=
s=3D"hl sym">(</span>loop
-<a id=3D"l_310"></a><span class=3D"hl line"> 310 </span> <span cl=
ass=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"h=
l kwa">and max</span> <span class=3D"hl sym">(>=3D</span> words <span cl=
ass=3D"hl sym">(</span><span class=3D"hl num">1</span>- <span class=3D"hl k=
wa">max</span><span class=3D"hl sym">)))</span>
-<a id=3D"l_311"></a><span class=3D"hl line"> 311 </span> <span =
class=3D"hl sym">(</span>return <span class=3D"hl sym">(</span><span class=
=3D"hl kwa">cons</span> <span class=3D"hl sym">(</span>subseq string start<=
span class=3D"hl sym">)</span> <span class=3D"hl kwa">list</span><span clas=
s=3D"hl sym">)))</span>
-<a id=3D"l_312"></a><span class=3D"hl line"> 312 </span> <span cl=
ass=3D"hl sym">(</span>setf end <span class=3D"hl sym">(</span>position-<sp=
an class=3D"hl kwa">if</span> #<span class=3D"hl sym">'</span>is-ws string =
<span class=3D"hl sym">:</span>start start<span class=3D"hl sym">))</span>
-<a id=3D"l_313"></a><span class=3D"hl line"> 313 </span> <span cl=
ass=3D"hl sym">(</span>push <span class=3D"hl sym">(</span>subseq string st=
art end<span class=3D"hl sym">)</span> <span class=3D"hl kwa">list</span><s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_314"></a><span class=3D"hl line"> 314 </span> <span cl=
ass=3D"hl sym">(</span>incf words<span class=3D"hl sym">)</span>
-<a id=3D"l_315"></a><span class=3D"hl line"> 315 </span> <span cl=
ass=3D"hl sym">(</span>unless end <span class=3D"hl sym">(</span>return <sp=
an class=3D"hl kwa">list</span><span class=3D"hl sym">))</span>
-<a id=3D"l_316"></a><span class=3D"hl line"> 316 </span> <span cl=
ass=3D"hl sym">(</span>setf start <span class=3D"hl sym">(</span><span clas=
s=3D"hl num">1</span><span class=3D"hl sym">+</span> end<span class=3D"hl s=
ym">)))))))</span>
-<a id=3D"l_317"></a><span class=3D"hl line"> 317 </span>
-<a id=3D"l_318"></a><span class=3D"hl line"> 318 </span><span class=3D"hl=
sym">(</span>defgeneric version-satisfies <span class=3D"hl sym">(</span>c=
omponent version<span class=3D"hl sym">))</span>
-<a id=3D"l_319"></a><span class=3D"hl line"> 319 </span>
-<a id=3D"l_320"></a><span class=3D"hl line"> 320 </span><span class=3D"hl=
sym">(</span>defmethod version-satisfies <span class=3D"hl sym">((</span>c=
component<span class=3D"hl sym">)</span> version<span class=3D"hl sym">)</=
span>
-<a id=3D"l_321"></a><span class=3D"hl line"> 321 </span> <span class=3D"=
hl sym">(</span>unless <span class=3D"hl sym">(</span><span class=3D"hl kwa=
">and</span> version <span class=3D"hl sym">(</span>slot-<span class=3D"hl =
kwa">boundp</span> c <span class=3D"hl sym">'</span>version<span class=3D"h=
l sym">))</span>
-<a id=3D"l_322"></a><span class=3D"hl line"> 322 </span> <span class=
=3D"hl sym">(</span>return-from version-satisfies t<span class=3D"hl sym">)=
)</span>
-<a id=3D"l_323"></a><span class=3D"hl line"> 323 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>x <span class=3D"hl sym=
">(</span><span class=3D"hl kwa">mapcar</span> #<span class=3D"hl sym">'</s=
pan>parse-integer
-<a id=3D"l_324"></a><span class=3D"hl line"> 324 </span> =
<span class=3D"hl sym">(</span>split <span class=3D"hl sym">(</span>compo=
nent-version c<span class=3D"hl sym">)</span> nil <span class=3D"hl sym">'(=
</span>#\.<span class=3D"hl sym">))))</span>
-<a id=3D"l_325"></a><span class=3D"hl line"> 325 </span> <span cla=
ss=3D"hl sym">(</span>y <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">mapcar</span> #<span class=3D"hl sym">'</span>parse-integer
-<a id=3D"l_326"></a><span class=3D"hl line"> 326 </span> =
<span class=3D"hl sym">(</span>split version nil <span class=3D"hl sym">'=
(</span>#\.<span class=3D"hl sym">)))))</span>
-<a id=3D"l_327"></a><span class=3D"hl line"> 327 </span> <span class=
=3D"hl sym">(</span>labels <span class=3D"hl sym">((</span>bigger <span cla=
ss=3D"hl sym">(</span>x y<span class=3D"hl sym">)</span>
-<a id=3D"l_328"></a><span class=3D"hl line"> 328 </span> <s=
pan class=3D"hl sym">(</span><span class=3D"hl kwa">cond</span> <span class=
=3D"hl sym">((</span><span class=3D"hl kwa">not</span> y<span class=3D"hl s=
ym">)</span> t<span class=3D"hl sym">)</span>
-<a id=3D"l_329"></a><span class=3D"hl line"> 329 </span> =
<span class=3D"hl sym">((</span><span class=3D"hl kwa">not</span> x<spa=
n class=3D"hl sym">)</span> nil<span class=3D"hl sym">)</span>
-<a id=3D"l_330"></a><span class=3D"hl line"> 330 </span> =
<span class=3D"hl sym">((> (</span><span class=3D"hl kwa">car</span>=
x<span class=3D"hl sym">) (</span><span class=3D"hl kwa">car</span> y<span=
class=3D"hl sym">))</span> t<span class=3D"hl sym">)</span>
-<a id=3D"l_331"></a><span class=3D"hl line"> 331 </span> =
<span class=3D"hl sym">((=3D (</span><span class=3D"hl kwa">car</span> =
x<span class=3D"hl sym">) (</span><span class=3D"hl kwa">car</span> y<span =
class=3D"hl sym">))</span>
-<a id=3D"l_332"></a><span class=3D"hl line"> 332 </span> =
<span class=3D"hl sym">(</span>bigger <span class=3D"hl sym">(</span><=
span class=3D"hl kwa">cdr</span> x<span class=3D"hl sym">) (</span><span cl=
ass=3D"hl kwa">cdr</span> y<span class=3D"hl sym">))))))</span>
-<a id=3D"l_333"></a><span class=3D"hl line"> 333 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">and</span> <span class=3D"hl sym=
">(=3D (</span><span class=3D"hl kwa">car</span> x<span class=3D"hl sym">) =
(</span><span class=3D"hl kwa">car</span> y<span class=3D"hl sym">))</span>
-<a id=3D"l_334"></a><span class=3D"hl line"> 334 </span> <span =
class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> <span class=3D"hl=
sym">(</span><span class=3D"hl kwa">not</span> <span class=3D"hl sym">(</s=
pan><span class=3D"hl kwa">cdr</span> y<span class=3D"hl sym">)) (</span>bi=
gger <span class=3D"hl sym">(</span><span class=3D"hl kwa">cdr</span> x<spa=
n class=3D"hl sym">) (</span><span class=3D"hl kwa">cdr</span> y<span class=
=3D"hl sym">)))))))</span>
-<a id=3D"l_335"></a><span class=3D"hl line"> 335 </span>
-<a id=3D"l_336"></a><span class=3D"hl line"> 336 </span><span class=3D"hl=
slc">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</span>
-<a id=3D"l_337"></a><span class=3D"hl line"> 337 </span><span class=3D"hl=
slc">;;; finding systems</span>
-<a id=3D"l_338"></a><span class=3D"hl line"> 338 </span>
-<a id=3D"l_339"></a><span class=3D"hl line"> 339 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>defined-systems<span cl=
ass=3D"hl sym">* (</span>make-hash-table <span class=3D"hl sym">:</span>tes=
t <span class=3D"hl sym">'</span><span class=3D"hl kwa">equal</span><span c=
lass=3D"hl sym">))</span>
-<a id=3D"l_340"></a><span class=3D"hl line"> 340 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> coerce-name <span class=
=3D"hl sym">(</span>name<span class=3D"hl sym">)</span>
-<a id=3D"l_341"></a><span class=3D"hl line"> 341 </span> <span class=3D"=
hl sym">(</span>typecase name
-<a id=3D"l_342"></a><span class=3D"hl line"> 342 </span> <span class=
=3D"hl sym">(</span>component <span class=3D"hl sym">(</span>component-name=
name<span class=3D"hl sym">))</span>
-<a id=3D"l_343"></a><span class=3D"hl line"> 343 </span> <span class=
=3D"hl sym">(</span>symbol <span class=3D"hl sym">(</span>string-downcase <=
span class=3D"hl sym">(</span>symbol-name name<span class=3D"hl sym">)))</s=
pan>
-<a id=3D"l_344"></a><span class=3D"hl line"> 344 </span> <span class=
=3D"hl sym">(</span>string name<span class=3D"hl sym">)</span>
-<a id=3D"l_345"></a><span class=3D"hl line"> 345 </span> <span class=
=3D"hl sym">(</span>t <span class=3D"hl sym">(</span>sysdef-error <span cla=
ss=3D"hl str">"~@<invalid component designator ~A~@:>&qu=
ot;</span> name<span class=3D"hl sym">))))</span>
-<a id=3D"l_346"></a><span class=3D"hl line"> 346 </span>
-<a id=3D"l_347"></a><span class=3D"hl line"> 347 </span><span class=3D"hl=
slc">;;; for the sake of keeping things reasonably neat, we adopt a</span>
-<a id=3D"l_348"></a><span class=3D"hl line"> 348 </span><span class=3D"hl=
slc">;;; convention that functions in this list are prefixed SYSDEF-</span>
-<a id=3D"l_349"></a><span class=3D"hl line"> 349 </span>
-<a id=3D"l_350"></a><span class=3D"hl line"> 350 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>system-definition-searc=
h-functions<span class=3D"hl sym">*</span>
-<a id=3D"l_351"></a><span class=3D"hl line"> 351 </span> <span class=3D"=
hl sym">'(</span>sysdef-central-registry-search<span class=3D"hl sym">))</s=
pan>
-<a id=3D"l_352"></a><span class=3D"hl line"> 352 </span>
-<a id=3D"l_353"></a><span class=3D"hl line"> 353 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> system-definition-pathnam=
e <span class=3D"hl sym">(</span>system<span class=3D"hl sym">)</span>
-<a id=3D"l_354"></a><span class=3D"hl line"> 354 </span> <span class=3D"=
hl sym">(</span>some <span class=3D"hl sym">(</span><span class=3D"hl kwa">=
lambda</span> <span class=3D"hl sym">(</span>x<span class=3D"hl sym">) (</s=
pan>funcall x system<span class=3D"hl sym">))</span>
-<a id=3D"l_355"></a><span class=3D"hl line"> 355 </span> <span cla=
ss=3D"hl sym">*</span>system-definition-search-functions<span class=3D"hl s=
ym">*))</span>
-<a id=3D"l_356"></a><span class=3D"hl line"> 356 </span>
-<a id=3D"l_357"></a><span class=3D"hl line"> 357 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>central-registry<span c=
lass=3D"hl sym">*</span>
-<a id=3D"l_358"></a><span class=3D"hl line"> 358 </span> <span class=3D"=
hl sym">'(*</span>default-pathname-defaults<span class=3D"hl sym">*</span>
-<a id=3D"l_359"></a><span class=3D"hl line"> 359 </span> #<span class=
=3D"hl sym">+</span>nil <span class=3D"hl str">"/home/dan/src/sourcefo=
rge/cclan/asdf/systems/"</span>
-<a id=3D"l_360"></a><span class=3D"hl line"> 360 </span> #<span class=
=3D"hl sym">+</span>nil <span class=3D"hl str">"telent:asdf;systems;&q=
uot;</span><span class=3D"hl sym">))</span>
-<a id=3D"l_361"></a><span class=3D"hl line"> 361 </span>
-<a id=3D"l_362"></a><span class=3D"hl line"> 362 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> sysdef-central-registry-s=
earch <span class=3D"hl sym">(</span>system<span class=3D"hl sym">)</span>
-<a id=3D"l_363"></a><span class=3D"hl line"> 363 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>name <span class=3D"hl =
sym">(</span>coerce-name system<span class=3D"hl sym">)))</span>
-<a id=3D"l_364"></a><span class=3D"hl line"> 364 </span> <span class=
=3D"hl sym">(</span>block nil
-<a id=3D"l_365"></a><span class=3D"hl line"> 365 </span> <span class=
=3D"hl sym">(</span>dolist <span class=3D"hl sym">(</span>dir <span class=
=3D"hl sym">*</span>central-registry<span class=3D"hl sym">*)</span>
-<a id=3D"l_366"></a><span class=3D"hl line"> 366 </span> <span cla=
ss=3D"hl sym">(</span>let<span class=3D"hl sym">* ((</span>defaults <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">eval</span> dir<span class=
=3D"hl sym">))</span>
-<a id=3D"l_367"></a><span class=3D"hl line"> 367 </span> <s=
pan class=3D"hl sym">(</span>file <span class=3D"hl sym">(</span><span clas=
s=3D"hl kwa">and</span> defaults
-<a id=3D"l_368"></a><span class=3D"hl line"> 368 </span> =
<span class=3D"hl sym">(</span>make-pathname
-<a id=3D"l_369"></a><span class=3D"hl line"> 369 </span> =
<span class=3D"hl sym">:</span>defaults defaults <span class=3D"h=
l sym">:</span>version <span class=3D"hl sym">:</span>newest
-<a id=3D"l_370"></a><span class=3D"hl line"> 370 </span> =
<span class=3D"hl sym">:</span>name name <span class=3D"hl sym">:=
</span><span class=3D"hl kwa">type</span> <span class=3D"hl str">"asd&=
quot;</span> <span class=3D"hl sym">:</span>case <span class=3D"hl sym">:</=
span>local<span class=3D"hl sym">))))</span>
-<a id=3D"l_371"></a><span class=3D"hl line"> 371 </span> <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D"hl =
sym">(</span><span class=3D"hl kwa">and</span> file <span class=3D"hl sym">=
(</span>probe-file file<span class=3D"hl sym">))</span>
-<a id=3D"l_372"></a><span class=3D"hl line"> 372 </span> <sp=
an class=3D"hl sym">(</span>return file<span class=3D"hl sym">)))))))</span>
-<a id=3D"l_373"></a><span class=3D"hl line"> 373 </span>
-<a id=3D"l_374"></a><span class=3D"hl line"> 374 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> make-temporary-package <s=
pan class=3D"hl sym">()</span>
-<a id=3D"l_375"></a><span class=3D"hl line"> 375 </span> <span class=3D"=
hl sym">(</span>flet <span class=3D"hl sym">((</span>try <span class=3D"hl =
sym">(</span>counter<span class=3D"hl sym">)</span>
-<a id=3D"l_376"></a><span class=3D"hl line"> 376 </span> <span =
class=3D"hl sym">(</span>ignore-errors
-<a id=3D"l_377"></a><span class=3D"hl line"> 377 </span> <spa=
n class=3D"hl sym">(</span>make-package <span class=3D"hl sym">(</span>form=
at nil <span class=3D"hl str">"ASDF~D"</span> counter<span class=
=3D"hl sym">)</span>
-<a id=3D"l_378"></a><span class=3D"hl line"> 378 </span> =
<span class=3D"hl sym">:</span>use <span class=3D"hl sym">'(:</sp=
an>cl <span class=3D"hl sym">:</span>asdf<span class=3D"hl sym">)))))</span>
-<a id=3D"l_379"></a><span class=3D"hl line"> 379 </span> <span class=
=3D"hl sym">(</span>do<span class=3D"hl sym">* ((</span>counter <span class=
=3D"hl num">0</span> <span class=3D"hl sym">(+</span> counter <span class=
=3D"hl num">1</span><span class=3D"hl sym">))</span>
-<a id=3D"l_380"></a><span class=3D"hl line"> 380 </span> <span c=
lass=3D"hl sym">(</span>package <span class=3D"hl sym">(</span>try counter<=
span class=3D"hl sym">) (</span>try counter<span class=3D"hl sym">)))</span>
-<a id=3D"l_381"></a><span class=3D"hl line"> 381 </span> <span cl=
ass=3D"hl sym">(</span>package package<span class=3D"hl sym">))))</span>
-<a id=3D"l_382"></a><span class=3D"hl line"> 382 </span>
-<a id=3D"l_383"></a><span class=3D"hl line"> 383 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> find-system <span class=
=3D"hl sym">(</span>name <span class=3D"hl sym">&</span>optional <span =
class=3D"hl sym">(</span>error-p t<span class=3D"hl sym">))</span>
-<a id=3D"l_384"></a><span class=3D"hl line"> 384 </span> <span class=3D"=
hl sym">(</span>let<span class=3D"hl sym">* ((</span>name <span class=3D"hl=
sym">(</span>coerce-name name<span class=3D"hl sym">))</span>
-<a id=3D"l_385"></a><span class=3D"hl line"> 385 </span> <span cl=
ass=3D"hl sym">(</span>in-memory <span class=3D"hl sym">(</span>gethash nam=
e <span class=3D"hl sym">*</span>defined-systems<span class=3D"hl sym">*))<=
/span>
-<a id=3D"l_386"></a><span class=3D"hl line"> 386 </span> <span cl=
ass=3D"hl sym">(</span>on-disk <span class=3D"hl sym">(</span>system-defini=
tion-pathname name<span class=3D"hl sym">)))</span>
-<a id=3D"l_387"></a><span class=3D"hl line"> 387 </span> <span class=
=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"hl k=
wa">and</span> on-disk
-<a id=3D"l_388"></a><span class=3D"hl line"> 388 </span> <s=
pan class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">not</span> in-memory<span class=
=3D"hl sym">)</span>
-<a id=3D"l_389"></a><span class=3D"hl line"> 389 </span> =
<span class=3D"hl sym">(< (</span><span class=3D"hl kwa">car</span> in=
-memory<span class=3D"hl sym">) (</span>file-write-date on-disk<span class=
=3D"hl sym">))))</span>
-<a id=3D"l_390"></a><span class=3D"hl line"> 390 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>package <span class=
=3D"hl sym">(</span>make-temporary-package<span class=3D"hl sym">)))</span>
-<a id=3D"l_391"></a><span class=3D"hl line"> 391 </span> <span cla=
ss=3D"hl sym">(</span>unwind-protect
-<a id=3D"l_392"></a><span class=3D"hl line"> 392 </span> <spa=
n class=3D"hl sym">(</span>let <span class=3D"hl sym">((*</span>package<spa=
n class=3D"hl sym">*</span> package<span class=3D"hl sym">))</span>
-<a id=3D"l_393"></a><span class=3D"hl line"> 393 </span> <s=
pan class=3D"hl sym">(</span>format
-<a id=3D"l_394"></a><span class=3D"hl line"> 394 </span> <=
span class=3D"hl sym">*</span>verbose-out<span class=3D"hl sym">*</span>
-<a id=3D"l_395"></a><span class=3D"hl line"> 395 </span> <=
span class=3D"hl str">"~&~@<; ~@;loading system definit=
ion from ~A into ~A~@:>~%"</span>
-<a id=3D"l_396"></a><span class=3D"hl line"> 396 </span> <=
span class=3D"hl slc">;; FIXME: This wants to be (ENOUGH-NAMESTRING</span>
-<a id=3D"l_397"></a><span class=3D"hl line"> 397 </span> <=
span class=3D"hl slc">;; ON-DISK), but CMUCL barfs on that.</span>
-<a id=3D"l_398"></a><span class=3D"hl line"> 398 </span> o=
n-disk
-<a id=3D"l_399"></a><span class=3D"hl line"> 399 </span> <=
span class=3D"hl sym">*</span>package<span class=3D"hl sym">*)</span>
-<a id=3D"l_400"></a><span class=3D"hl line"> 400 </span> <s=
pan class=3D"hl sym">(</span><span class=3D"hl kwa">load</span> on-disk<spa=
n class=3D"hl sym">))</span>
-<a id=3D"l_401"></a><span class=3D"hl line"> 401 </span> <span c=
lass=3D"hl sym">(</span>delete-package package<span class=3D"hl sym">))))</=
span>
-<a id=3D"l_402"></a><span class=3D"hl line"> 402 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>in-memory <span cla=
ss=3D"hl sym">(</span>gethash name <span class=3D"hl sym">*</span>defined-s=
ystems<span class=3D"hl sym">*)))</span>
-<a id=3D"l_403"></a><span class=3D"hl line"> 403 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> in-memory
-<a id=3D"l_404"></a><span class=3D"hl line"> 404 </span> <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">progn</span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">if</span> on-disk <span class=3D"hl =
sym">(</span>setf <span class=3D"hl sym">(</span><span class=3D"hl kwa">car=
</span> in-memory<span class=3D"hl sym">) (</span>file-write-date on-disk<s=
pan class=3D"hl sym">)))</span>
-<a id=3D"l_405"></a><span class=3D"hl line"> 405 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">cdr</span> in-memory<=
span class=3D"hl sym">))</span>
-<a id=3D"l_406"></a><span class=3D"hl line"> 406 </span> <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">if</span> error-p <span clas=
s=3D"hl sym">(</span>error <span class=3D"hl sym">'</span>missing-component=
<span class=3D"hl sym">:</span>requires name<span class=3D"hl sym">))))))<=
/span>
-<a id=3D"l_407"></a><span class=3D"hl line"> 407 </span>
-<a id=3D"l_408"></a><span class=3D"hl line"> 408 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> register-system <span cla=
ss=3D"hl sym">(</span>name system<span class=3D"hl sym">)</span>
-<a id=3D"l_409"></a><span class=3D"hl line"> 409 </span> <span class=3D"=
hl sym">(</span>format <span class=3D"hl sym">*</span>verbose-out<span clas=
s=3D"hl sym">*</span> <span class=3D"hl str">"~&~@<; ~@=
;registering ~A as ~A~@:>~%"</span> system name<span class=3D"h=
l sym">)</span>
-<a id=3D"l_410"></a><span class=3D"hl line"> 410 </span> <span class=3D"=
hl sym">(</span>setf <span class=3D"hl sym">(</span>gethash <span class=3D"=
hl sym">(</span>coerce-name name<span class=3D"hl sym">) *</span>defined-s=
ystems<span class=3D"hl sym">*)</span>
-<a id=3D"l_411"></a><span class=3D"hl line"> 411 </span> <span cla=
ss=3D"hl sym">(</span><span class=3D"hl kwa">cons</span> <span class=3D"hl =
sym">(</span>get-universal-time<span class=3D"hl sym">)</span> system<span =
class=3D"hl sym">)))</span>
-<a id=3D"l_412"></a><span class=3D"hl line"> 412 </span>
-<a id=3D"l_413"></a><span class=3D"hl line"> 413 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> system-registered-p <span=
class=3D"hl sym">(</span>name<span class=3D"hl sym">)</span>
-<a id=3D"l_414"></a><span class=3D"hl line"> 414 </span> <span class=3D"=
hl sym">(</span>gethash <span class=3D"hl sym">(</span>coerce-name name<spa=
n class=3D"hl sym">) *</span>defined-systems<span class=3D"hl sym">*))</spa=
n>
-<a id=3D"l_415"></a><span class=3D"hl line"> 415 </span>
-<a id=3D"l_416"></a><span class=3D"hl line"> 416 </span><span class=3D"hl=
slc">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</span>
-<a id=3D"l_417"></a><span class=3D"hl line"> 417 </span><span class=3D"hl=
slc">;;; finding components</span>
-<a id=3D"l_418"></a><span class=3D"hl line"> 418 </span>
-<a id=3D"l_419"></a><span class=3D"hl line"> 419 </span><span class=3D"hl=
sym">(</span>defgeneric find-component <span class=3D"hl sym">(</span>modu=
le name <span class=3D"hl sym">&</span>optional version<span class=3D"h=
l sym">)</span>
-<a id=3D"l_420"></a><span class=3D"hl line"> 420 </span> <span class=3D"=
hl sym">(:</span>documentation <span class=3D"hl str">"Finds the compo=
nent with name NAME present in the</span>
-<a id=3D"l_421"></a><span class=3D"hl line"> 421 </span><span class=3D"hl=
str">MODULE module; if MODULE is nil, then the component is assumed to be =
a</span>
-<a id=3D"l_422"></a><span class=3D"hl line"> 422 </span><span class=3D"hl=
str">system."</span><span class=3D"hl sym">))</span>
-<a id=3D"l_423"></a><span class=3D"hl line"> 423 </span>
-<a id=3D"l_424"></a><span class=3D"hl line"> 424 </span><span class=3D"hl=
sym">(</span>defmethod find-component <span class=3D"hl sym">((</span>modu=
le module<span class=3D"hl sym">)</span> name <span class=3D"hl sym">&<=
/span>optional version<span class=3D"hl sym">)</span>
-<a id=3D"l_425"></a><span class=3D"hl line"> 425 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D"hl sym">(</=
span>slot-<span class=3D"hl kwa">boundp</span> module <span class=3D"hl sym=
">'</span>components<span class=3D"hl sym">)</span>
-<a id=3D"l_426"></a><span class=3D"hl line"> 426 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>m <span class=3D"hl=
sym">(</span>find name <span class=3D"hl sym">(</span>module-components mo=
dule<span class=3D"hl sym">)</span>
-<a id=3D"l_427"></a><span class=3D"hl line"> 427 </span> =
<span class=3D"hl sym">:</span>test #<span class=3D"hl sym">'</span><sp=
an class=3D"hl kwa">equal</span> <span class=3D"hl sym">:</span>key #<span =
class=3D"hl sym">'</span>component-name<span class=3D"hl sym">)))</span>
-<a id=3D"l_428"></a><span class=3D"hl line"> 428 </span> <span cla=
ss=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D"hl sy=
m">(</span><span class=3D"hl kwa">and</span> m <span class=3D"hl sym">(</sp=
an>version-satisfies m version<span class=3D"hl sym">))</span> m<span class=
=3D"hl sym">))))</span>
-<a id=3D"l_429"></a><span class=3D"hl line"> 429 </span>
-<a id=3D"l_430"></a><span class=3D"hl line"> 430 </span>
-<a id=3D"l_431"></a><span class=3D"hl line"> 431 </span><span class=3D"hl=
slc">;;; a component with no parent is a system</span>
-<a id=3D"l_432"></a><span class=3D"hl line"> 432 </span><span class=3D"hl=
sym">(</span>defmethod find-component <span class=3D"hl sym">((</span>modu=
le <span class=3D"hl sym">(</span>eql nil<span class=3D"hl sym">))</span> n=
ame <span class=3D"hl sym">&</span>optional version<span class=3D"hl sy=
m">)</span>
-<a id=3D"l_433"></a><span class=3D"hl line"> 433 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>m <span class=3D"hl sym=
">(</span>find-system name nil<span class=3D"hl sym">)))</span>
-<a id=3D"l_434"></a><span class=3D"hl line"> 434 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D"hl sym"=
>(</span><span class=3D"hl kwa">and</span> m <span class=3D"hl sym">(</span=
>version-satisfies m version<span class=3D"hl sym">))</span> m<span class=
=3D"hl sym">)))</span>
-<a id=3D"l_435"></a><span class=3D"hl line"> 435 </span>
-<a id=3D"l_436"></a><span class=3D"hl line"> 436 </span><span class=3D"hl=
slc">;;; component subclasses</span>
-<a id=3D"l_437"></a><span class=3D"hl line"> 437 </span>
-<a id=3D"l_438"></a><span class=3D"hl line"> 438 </span><span class=3D"hl=
sym">(</span>defclass source-file <span class=3D"hl sym">(</span>component=
<span class=3D"hl sym">) ())</span>
-<a id=3D"l_439"></a><span class=3D"hl line"> 439 </span>
-<a id=3D"l_440"></a><span class=3D"hl line"> 440 </span><span class=3D"hl=
sym">(</span>defclass cl-source-file <span class=3D"hl sym">(</span>source=
-file<span class=3D"hl sym">) ())</span>
-<a id=3D"l_441"></a><span class=3D"hl line"> 441 </span><span class=3D"hl=
sym">(</span>defclass c-source-file <span class=3D"hl sym">(</span>source-=
file<span class=3D"hl sym">) ())</span>
-<a id=3D"l_442"></a><span class=3D"hl line"> 442 </span><span class=3D"hl=
sym">(</span>defclass java-source-file <span class=3D"hl sym">(</span>sour=
ce-file<span class=3D"hl sym">) ())</span>
-<a id=3D"l_443"></a><span class=3D"hl line"> 443 </span><span class=3D"hl=
sym">(</span>defclass static-file <span class=3D"hl sym">(</span>source-fi=
le<span class=3D"hl sym">) ())</span>
-<a id=3D"l_444"></a><span class=3D"hl line"> 444 </span><span class=3D"hl=
sym">(</span>defclass doc-file <span class=3D"hl sym">(</span>static-file<=
span class=3D"hl sym">) ())</span>
-<a id=3D"l_445"></a><span class=3D"hl line"> 445 </span><span class=3D"hl=
sym">(</span>defclass html-file <span class=3D"hl sym">(</span>doc-file<sp=
an class=3D"hl sym">) ())</span>
-<a id=3D"l_446"></a><span class=3D"hl line"> 446 </span>
-<a id=3D"l_447"></a><span class=3D"hl line"> 447 </span><span class=3D"hl=
sym">(</span>defgeneric source-file-<span class=3D"hl kwa">type</span> <sp=
an class=3D"hl sym">(</span>component system<span class=3D"hl sym">))</span>
-<a id=3D"l_448"></a><span class=3D"hl line"> 448 </span><span class=3D"hl=
sym">(</span>defmethod source-file-<span class=3D"hl kwa">type</span> <spa=
n class=3D"hl sym">((</span>c cl-source-file<span class=3D"hl sym">) (</spa=
n>s module<span class=3D"hl sym">))</span> <span class=3D"hl str">"lis=
p"</span><span class=3D"hl sym">)</span>
-<a id=3D"l_449"></a><span class=3D"hl line"> 449 </span><span class=3D"hl=
sym">(</span>defmethod source-file-<span class=3D"hl kwa">type</span> <spa=
n class=3D"hl sym">((</span>c c-source-file<span class=3D"hl sym">) (</span=
>s module<span class=3D"hl sym">))</span> <span class=3D"hl str">"c&qu=
ot;</span><span class=3D"hl sym">)</span>
-<a id=3D"l_450"></a><span class=3D"hl line"> 450 </span><span class=3D"hl=
sym">(</span>defmethod source-file-<span class=3D"hl kwa">type</span> <spa=
n class=3D"hl sym">((</span>c java-source-file<span class=3D"hl sym">) (</s=
pan>s module<span class=3D"hl sym">))</span> <span class=3D"hl str">"j=
ava"</span><span class=3D"hl sym">)</span>
-<a id=3D"l_451"></a><span class=3D"hl line"> 451 </span><span class=3D"hl=
sym">(</span>defmethod source-file-<span class=3D"hl kwa">type</span> <spa=
n class=3D"hl sym">((</span>c html-file<span class=3D"hl sym">) (</span>s m=
odule<span class=3D"hl sym">))</span> <span class=3D"hl str">"html&quo=
t;</span><span class=3D"hl sym">)</span>
-<a id=3D"l_452"></a><span class=3D"hl line"> 452 </span><span class=3D"hl=
sym">(</span>defmethod source-file-<span class=3D"hl kwa">type</span> <spa=
n class=3D"hl sym">((</span>c static-file<span class=3D"hl sym">) (</span>s=
module<span class=3D"hl sym">))</span> nil<span class=3D"hl sym">)</span>
-<a id=3D"l_453"></a><span class=3D"hl line"> 453 </span>
-<a id=3D"l_454"></a><span class=3D"hl line"> 454 </span><span class=3D"hl=
sym">(</span>defmethod component-relative-pathname <span class=3D"hl sym">=
((</span>component source-file<span class=3D"hl sym">))</span>
-<a id=3D"l_455"></a><span class=3D"hl line"> 455 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>relative-pathname <span=
class=3D"hl sym">(</span>slot-value component <span class=3D"hl sym">'</sp=
an>relative-pathname<span class=3D"hl sym">)))</span>
-<a id=3D"l_456"></a><span class=3D"hl line"> 456 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> relative-pathname
-<a id=3D"l_457"></a><span class=3D"hl line"> 457 </span> <span cla=
ss=3D"hl sym">(</span>merge-pathnames
-<a id=3D"l_458"></a><span class=3D"hl line"> 458 </span> relative=
-pathname
-<a id=3D"l_459"></a><span class=3D"hl line"> 459 </span> <span cl=
ass=3D"hl sym">(</span>make-pathname
-<a id=3D"l_460"></a><span class=3D"hl line"> 460 </span> <span c=
lass=3D"hl sym">:</span><span class=3D"hl kwa">type</span> <span class=3D"h=
l sym">(</span>source-file-<span class=3D"hl kwa">type</span> component <sp=
an class=3D"hl sym">(</span>component-system component<span class=3D"hl sym=
">))))</span>
-<a id=3D"l_461"></a><span class=3D"hl line"> 461 </span> <span cla=
ss=3D"hl sym">(</span>let<span class=3D"hl sym">* ((*</span>default-pathnam=
e-defaults<span class=3D"hl sym">*</span>
-<a id=3D"l_462"></a><span class=3D"hl line"> 462 </span> <=
span class=3D"hl sym">(</span>component-parent-pathname component<span clas=
s=3D"hl sym">))</span>
-<a id=3D"l_463"></a><span class=3D"hl line"> 463 </span> <s=
pan class=3D"hl sym">(</span>name-<span class=3D"hl kwa">type</span>
-<a id=3D"l_464"></a><span class=3D"hl line"> 464 </span> <=
span class=3D"hl sym">(</span>make-pathname
-<a id=3D"l_465"></a><span class=3D"hl line"> 465 </span> =
<span class=3D"hl sym">:</span>name <span class=3D"hl sym">(</span>componen=
t-name component<span class=3D"hl sym">)</span>
-<a id=3D"l_466"></a><span class=3D"hl line"> 466 </span> =
<span class=3D"hl sym">:</span><span class=3D"hl kwa">type</span> <span cla=
ss=3D"hl sym">(</span>source-file-<span class=3D"hl kwa">type</span> compon=
ent
-<a id=3D"l_467"></a><span class=3D"hl line"> 467 </span> =
<span class=3D"hl sym">(</span>component-system com=
ponent<span class=3D"hl sym">)))))</span>
-<a id=3D"l_468"></a><span class=3D"hl line"> 468 </span> name-<s=
pan class=3D"hl kwa">type</span><span class=3D"hl sym">))))</span>
-<a id=3D"l_469"></a><span class=3D"hl line"> 469 </span>
-<a id=3D"l_470"></a><span class=3D"hl line"> 470 </span><span class=3D"hl=
slc">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</span>
-<a id=3D"l_471"></a><span class=3D"hl line"> 471 </span><span class=3D"hl=
slc">;;; operations</span>
-<a id=3D"l_472"></a><span class=3D"hl line"> 472 </span>
-<a id=3D"l_473"></a><span class=3D"hl line"> 473 </span><span class=3D"hl=
slc">;;; one of these is instantiated whenever (operate ) is called</span>
-<a id=3D"l_474"></a><span class=3D"hl line"> 474 </span>
-<a id=3D"l_475"></a><span class=3D"hl line"> 475 </span><span class=3D"hl=
sym">(</span>defclass operation <span class=3D"hl sym">()</span>
-<a id=3D"l_476"></a><span class=3D"hl line"> 476 </span> <span class=3D"=
hl sym">((</span>forced <span class=3D"hl sym">:</span>initform nil <span c=
lass=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>force <span =
class=3D"hl sym">:</span>accessor operation-forced<span class=3D"hl sym">)<=
/span>
-<a id=3D"l_477"></a><span class=3D"hl line"> 477 </span> <span class=3D=
"hl sym">(</span>original-initargs <span class=3D"hl sym">:</span>initform =
nil <span class=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>o=
riginal-initargs
-<a id=3D"l_478"></a><span class=3D"hl line"> 478 </span> =
<span class=3D"hl sym">:</span>accessor operation-original-initargs<sp=
an class=3D"hl sym">)</span>
-<a id=3D"l_479"></a><span class=3D"hl line"> 479 </span> <span class=3D=
"hl sym">(</span>visited-nodes <span class=3D"hl sym">:</span>initform nil =
<span class=3D"hl sym">:</span>accessor operation-visited-nodes<span class=
=3D"hl sym">)</span>
-<a id=3D"l_480"></a><span class=3D"hl line"> 480 </span> <span class=3D=
"hl sym">(</span>visiting-nodes <span class=3D"hl sym">:</span>initform nil=
<span class=3D"hl sym">:</span>accessor operation-visiting-nodes<span clas=
s=3D"hl sym">)</span>
-<a id=3D"l_481"></a><span class=3D"hl line"> 481 </span> <span class=3D=
"hl sym">(</span>parent <span class=3D"hl sym">:</span>initform nil <span c=
lass=3D"hl sym">:</span>initarg <span class=3D"hl sym">:</span>parent <span=
class=3D"hl sym">:</span>accessor operation-parent<span class=3D"hl sym">)=
))</span>
-<a id=3D"l_482"></a><span class=3D"hl line"> 482 </span>
-<a id=3D"l_483"></a><span class=3D"hl line"> 483 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl kwa">print</span>-object <span cl=
ass=3D"hl sym">((</span>o operation<span class=3D"hl sym">)</span> stream<s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_484"></a><span class=3D"hl line"> 484 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">print</span>-unreadable-object <span=
class=3D"hl sym">(</span>o stream <span class=3D"hl sym">:</span><span cla=
ss=3D"hl kwa">type</span> t <span class=3D"hl sym">:</span>identity t<span =
class=3D"hl sym">)</span>
-<a id=3D"l_485"></a><span class=3D"hl line"> 485 </span> <span class=
=3D"hl sym">(</span>ignore-errors
-<a id=3D"l_486"></a><span class=3D"hl line"> 486 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">prin1</span> <span class=3D"hl s=
ym">(</span>operation-original-initargs o<span class=3D"hl sym">)</span> st=
ream<span class=3D"hl sym">))))</span>
-<a id=3D"l_487"></a><span class=3D"hl line"> 487 </span>
-<a id=3D"l_488"></a><span class=3D"hl line"> 488 </span><span class=3D"hl=
sym">(</span>defmethod shared-initialize <span class=3D"hl sym">:</span>af=
ter <span class=3D"hl sym">((</span>operation operation<span class=3D"hl sy=
m">)</span> slot-names
-<a id=3D"l_489"></a><span class=3D"hl line"> 489 </span> =
<span class=3D"hl sym">&</span>key force
-<a id=3D"l_490"></a><span class=3D"hl line"> 490 </span> =
<span class=3D"hl sym">&</span>allow-other-keys<spa=
n class=3D"hl sym">)</span>
-<a id=3D"l_491"></a><span class=3D"hl line"> 491 </span> <span class=3D"=
hl sym">(</span>declare <span class=3D"hl sym">(</span>ignore slot-names fo=
rce<span class=3D"hl sym">))</span>
-<a id=3D"l_492"></a><span class=3D"hl line"> 492 </span> <span class=3D"=
hl slc">;; empty method to disable initarg validity checking</span>
-<a id=3D"l_493"></a><span class=3D"hl line"> 493 </span> <span class=3D"=
hl sym">)</span>
-<a id=3D"l_494"></a><span class=3D"hl line"> 494 </span>
-<a id=3D"l_495"></a><span class=3D"hl line"> 495 </span><span class=3D"hl=
sym">(</span>defgeneric perform <span class=3D"hl sym">(</span>operation c=
omponent<span class=3D"hl sym">))</span>
-<a id=3D"l_496"></a><span class=3D"hl line"> 496 </span><span class=3D"hl=
sym">(</span>defgeneric operation-done-p <span class=3D"hl sym">(</span>op=
eration component<span class=3D"hl sym">))</span>
-<a id=3D"l_497"></a><span class=3D"hl line"> 497 </span><span class=3D"hl=
sym">(</span>defgeneric explain <span class=3D"hl sym">(</span>operation c=
omponent<span class=3D"hl sym">))</span>
-<a id=3D"l_498"></a><span class=3D"hl line"> 498 </span><span class=3D"hl=
sym">(</span>defgeneric output-files <span class=3D"hl sym">(</span>operat=
ion component<span class=3D"hl sym">))</span>
-<a id=3D"l_499"></a><span class=3D"hl line"> 499 </span><span class=3D"hl=
sym">(</span>defgeneric input-files <span class=3D"hl sym">(</span>operati=
on component<span class=3D"hl sym">))</span>
-<a id=3D"l_500"></a><span class=3D"hl line"> 500 </span>
-<a id=3D"l_501"></a><span class=3D"hl line"> 501 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> node-for <span class=3D"h=
l sym">(</span>o c<span class=3D"hl sym">)</span>
-<a id=3D"l_502"></a><span class=3D"hl line"> 502 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">cons</span> <span class=3D"hl sym">(=
</span>class-name <span class=3D"hl sym">(</span>class-of o<span class=3D"h=
l sym">))</span> c<span class=3D"hl sym">))</span>
-<a id=3D"l_503"></a><span class=3D"hl line"> 503 </span>
-<a id=3D"l_504"></a><span class=3D"hl line"> 504 </span><span class=3D"hl=
sym">(</span>defgeneric operation-ancestor <span class=3D"hl sym">(</span>=
operation<span class=3D"hl sym">)</span>
-<a id=3D"l_505"></a><span class=3D"hl line"> 505 </span> <span class=3D"=
hl sym">(:</span>documentation
-<a id=3D"l_506"></a><span class=3D"hl line"> 506 </span> <span class=3D=
"hl str">"Recursively chase the operation's parent pointer until we ge=
t to</span>
-<a id=3D"l_507"></a><span class=3D"hl line"> 507 </span><span class=3D"hl=
str">the head of the tree"</span><span class=3D"hl sym">))</span>
-<a id=3D"l_508"></a><span class=3D"hl line"> 508 </span>
-<a id=3D"l_509"></a><span class=3D"hl line"> 509 </span><span class=3D"hl=
sym">(</span>defmethod operation-ancestor <span class=3D"hl sym">((</span>=
operation operation<span class=3D"hl sym">))</span>
-<a id=3D"l_510"></a><span class=3D"hl line"> 510 </span> <span class=3D"=
hl sym">(</span>aif <span class=3D"hl sym">(</span>operation-parent operati=
on<span class=3D"hl sym">)</span>
-<a id=3D"l_511"></a><span class=3D"hl line"> 511 </span> <span clas=
s=3D"hl sym">(</span>operation-ancestor it<span class=3D"hl sym">)</span>
-<a id=3D"l_512"></a><span class=3D"hl line"> 512 </span> operation<=
span class=3D"hl sym">))</span>
-<a id=3D"l_513"></a><span class=3D"hl line"> 513 </span>
-<a id=3D"l_514"></a><span class=3D"hl line"> 514 </span>
-<a id=3D"l_515"></a><span class=3D"hl line"> 515 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> make-sub-operation <span =
class=3D"hl sym">(</span>c o dep-c dep-o<span class=3D"hl sym">)</span>
-<a id=3D"l_516"></a><span class=3D"hl line"> 516 </span> <span class=3D"=
hl sym">(</span>let<span class=3D"hl sym">* ((</span>args <span class=3D"hl=
sym">(</span>copy-<span class=3D"hl kwa">list</span> <span class=3D"hl sym=
">(</span>operation-original-initargs o<span class=3D"hl sym">)))</span>
-<a id=3D"l_517"></a><span class=3D"hl line"> 517 </span> <span cl=
ass=3D"hl sym">(</span>force-p <span class=3D"hl sym">(</span>getf args <sp=
an class=3D"hl sym">:</span>force<span class=3D"hl sym">)))</span>
-<a id=3D"l_518"></a><span class=3D"hl line"> 518 </span> <span class=
=3D"hl slc">;; note explicit comparison with T: any other non-NIL force val=
ue</span>
-<a id=3D"l_519"></a><span class=3D"hl line"> 519 </span> <span class=
=3D"hl slc">;; (e.g. :recursive) will pass through</span>
-<a id=3D"l_520"></a><span class=3D"hl line"> 520 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">cond</span> <span class=3D"hl sy=
m">((</span><span class=3D"hl kwa">and</span> <span class=3D"hl sym">(</spa=
n><span class=3D"hl kwa">null</span> <span class=3D"hl sym">(</span>compone=
nt-parent c<span class=3D"hl sym">))</span>
-<a id=3D"l_521"></a><span class=3D"hl line"> 521 </span> <=
span class=3D"hl sym">(</span><span class=3D"hl kwa">null</span> <span clas=
s=3D"hl sym">(</span>component-parent dep-c<span class=3D"hl sym">))</span>
-<a id=3D"l_522"></a><span class=3D"hl line"> 522 </span> <=
span class=3D"hl sym">(</span><span class=3D"hl kwa">not</span> <span class=
=3D"hl sym">(</span>eql c dep-c<span class=3D"hl sym">)))</span>
-<a id=3D"l_523"></a><span class=3D"hl line"> 523 </span> <span =
class=3D"hl sym">(</span>when <span class=3D"hl sym">(</span>eql force-p t<=
span class=3D"hl sym">)</span>
-<a id=3D"l_524"></a><span class=3D"hl line"> 524 </span> <spa=
n class=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>getf args <s=
pan class=3D"hl sym">:</span>force<span class=3D"hl sym">)</span> nil<span =
class=3D"hl sym">))</span>
-<a id=3D"l_525"></a><span class=3D"hl line"> 525 </span> <span =
class=3D"hl sym">(</span><span class=3D"hl kwa">apply</span> #<span class=
=3D"hl sym">'</span>make-instance dep-o
-<a id=3D"l_526"></a><span class=3D"hl line"> 526 </span> =
<span class=3D"hl sym">:</span>parent o
-<a id=3D"l_527"></a><span class=3D"hl line"> 527 </span> =
<span class=3D"hl sym">:</span>original-initargs args args<span class=3D"h=
l sym">))</span>
-<a id=3D"l_528"></a><span class=3D"hl line"> 528 </span> <span c=
lass=3D"hl sym">((</span>subtypep <span class=3D"hl sym">(</span><span clas=
s=3D"hl kwa">type</span>-of o<span class=3D"hl sym">)</span> dep-o<span cla=
ss=3D"hl sym">)</span>
-<a id=3D"l_529"></a><span class=3D"hl line"> 529 </span> o<span=
class=3D"hl sym">)</span>
-<a id=3D"l_530"></a><span class=3D"hl line"> 530 </span> <span c=
lass=3D"hl sym">(</span>t
-<a id=3D"l_531"></a><span class=3D"hl line"> 531 </span> <span =
class=3D"hl sym">(</span><span class=3D"hl kwa">apply</span> #<span class=
=3D"hl sym">'</span>make-instance dep-o
-<a id=3D"l_532"></a><span class=3D"hl line"> 532 </span> =
<span class=3D"hl sym">:</span>parent o <span class=3D"hl sym">:</span>ori=
ginal-initargs args args<span class=3D"hl sym">)))))</span>
-<a id=3D"l_533"></a><span class=3D"hl line"> 533 </span>
-<a id=3D"l_534"></a><span class=3D"hl line"> 534 </span>
-<a id=3D"l_535"></a><span class=3D"hl line"> 535 </span><span class=3D"hl=
sym">(</span>defgeneric visit-component <span class=3D"hl sym">(</span>ope=
ration component data<span class=3D"hl sym">))</span>
-<a id=3D"l_536"></a><span class=3D"hl line"> 536 </span>
-<a id=3D"l_537"></a><span class=3D"hl line"> 537 </span><span class=3D"hl=
sym">(</span>defmethod visit-component <span class=3D"hl sym">((</span>o o=
peration<span class=3D"hl sym">) (</span>c component<span class=3D"hl sym">=
)</span> data<span class=3D"hl sym">)</span>
-<a id=3D"l_538"></a><span class=3D"hl line"> 538 </span> <span class=3D"=
hl sym">(</span>unless <span class=3D"hl sym">(</span>component-visited-p o=
c<span class=3D"hl sym">)</span>
-<a id=3D"l_539"></a><span class=3D"hl line"> 539 </span> <span class=
=3D"hl sym">(</span>push <span class=3D"hl sym">(</span><span class=3D"hl k=
wa">cons</span> <span class=3D"hl sym">(</span>node-for o c<span class=3D"h=
l sym">)</span> data<span class=3D"hl sym">)</span>
-<a id=3D"l_540"></a><span class=3D"hl line"> 540 </span> <span c=
lass=3D"hl sym">(</span>operation-visited-nodes <span class=3D"hl sym">(</s=
pan>operation-ancestor o<span class=3D"hl sym">)))))</span>
-<a id=3D"l_541"></a><span class=3D"hl line"> 541 </span>
-<a id=3D"l_542"></a><span class=3D"hl line"> 542 </span><span class=3D"hl=
sym">(</span>defgeneric component-visited-p <span class=3D"hl sym">(</span=
>operation component<span class=3D"hl sym">))</span>
-<a id=3D"l_543"></a><span class=3D"hl line"> 543 </span>
-<a id=3D"l_544"></a><span class=3D"hl line"> 544 </span><span class=3D"hl=
sym">(</span>defmethod component-visited-p <span class=3D"hl sym">((</span=
>o operation<span class=3D"hl sym">) (</span>c component<span class=3D"hl s=
ym">))</span>
-<a id=3D"l_545"></a><span class=3D"hl line"> 545 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">assoc</span> <span class=3D"hl sym">=
(</span>node-for o c<span class=3D"hl sym">)</span>
-<a id=3D"l_546"></a><span class=3D"hl line"> 546 </span> <span cl=
ass=3D"hl sym">(</span>operation-visited-nodes <span class=3D"hl sym">(</sp=
an>operation-ancestor o<span class=3D"hl sym">))</span>
-<a id=3D"l_547"></a><span class=3D"hl line"> 547 </span> <span cl=
ass=3D"hl sym">:</span>test <span class=3D"hl sym">'</span><span class=3D"h=
l kwa">equal</span><span class=3D"hl sym">))</span>
-<a id=3D"l_548"></a><span class=3D"hl line"> 548 </span>
-<a id=3D"l_549"></a><span class=3D"hl line"> 549 </span><span class=3D"hl=
sym">(</span>defgeneric <span class=3D"hl sym">(</span>setf visiting-compo=
nent<span class=3D"hl sym">) (</span>new-value operation component<span cla=
ss=3D"hl sym">))</span>
-<a id=3D"l_550"></a><span class=3D"hl line"> 550 </span>
-<a id=3D"l_551"></a><span class=3D"hl line"> 551 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl sym">(</span>setf visiting-compon=
ent<span class=3D"hl sym">) (</span>new-value operation component<span clas=
s=3D"hl sym">)</span>
-<a id=3D"l_552"></a><span class=3D"hl line"> 552 </span> <span class=3D"=
hl slc">;; MCL complains about unused lexical variables</span>
-<a id=3D"l_553"></a><span class=3D"hl line"> 553 </span> <span class=3D"=
hl sym">(</span>declare <span class=3D"hl sym">(</span>ignorable new-value =
operation component<span class=3D"hl sym">)))</span>
-<a id=3D"l_554"></a><span class=3D"hl line"> 554 </span>
-<a id=3D"l_555"></a><span class=3D"hl line"> 555 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl sym">(</span>setf visiting-compon=
ent<span class=3D"hl sym">) (</span>new-value <span class=3D"hl sym">(</spa=
n>o operation<span class=3D"hl sym">) (</span>c component<span class=3D"hl =
sym">))</span>
-<a id=3D"l_556"></a><span class=3D"hl line"> 556 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>node <span class=3D"hl =
sym">(</span>node-for o c<span class=3D"hl sym">))</span>
-<a id=3D"l_557"></a><span class=3D"hl line"> 557 </span> <span cla=
ss=3D"hl sym">(</span>a <span class=3D"hl sym">(</span>operation-ancestor o=
<span class=3D"hl sym">)))</span>
-<a id=3D"l_558"></a><span class=3D"hl line"> 558 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> new-value
-<a id=3D"l_559"></a><span class=3D"hl line"> 559 </span> <span cla=
ss=3D"hl sym">(</span>pushnew node <span class=3D"hl sym">(</span>operation=
-visiting-nodes a<span class=3D"hl sym">) :</span>test <span class=3D"hl sy=
m">'</span><span class=3D"hl kwa">equal</span><span class=3D"hl sym">)</spa=
n>
-<a id=3D"l_560"></a><span class=3D"hl line"> 560 </span> <span cla=
ss=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>operation-visitin=
g-nodes a<span class=3D"hl sym">)</span>
-<a id=3D"l_561"></a><span class=3D"hl line"> 561 </span> <sp=
an class=3D"hl sym">(</span>remove node <span class=3D"hl sym">(</span>ope=
ration-visiting-nodes a<span class=3D"hl sym">) :</span>test <span class=3D=
"hl sym">'</span><span class=3D"hl kwa">equal</span><span class=3D"hl sym">=
)))))</span>
-<a id=3D"l_562"></a><span class=3D"hl line"> 562 </span>
-<a id=3D"l_563"></a><span class=3D"hl line"> 563 </span><span class=3D"hl=
sym">(</span>defgeneric component-visiting-p <span class=3D"hl sym">(</spa=
n>operation component<span class=3D"hl sym">))</span>
-<a id=3D"l_564"></a><span class=3D"hl line"> 564 </span>
-<a id=3D"l_565"></a><span class=3D"hl line"> 565 </span><span class=3D"hl=
sym">(</span>defmethod component-visiting-p <span class=3D"hl sym">((</spa=
n>o operation<span class=3D"hl sym">) (</span>c component<span class=3D"hl =
sym">))</span>
-<a id=3D"l_566"></a><span class=3D"hl line"> 566 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>node <span class=3D"hl =
sym">(</span><span class=3D"hl kwa">cons</span> o c<span class=3D"hl sym">)=
))</span>
-<a id=3D"l_567"></a><span class=3D"hl line"> 567 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">member</span> node <span class=
=3D"hl sym">(</span>operation-visiting-nodes <span class=3D"hl sym">(</span=
>operation-ancestor o<span class=3D"hl sym">))</span>
-<a id=3D"l_568"></a><span class=3D"hl line"> 568 </span> <span=
class=3D"hl sym">:</span>test <span class=3D"hl sym">'</span><span class=
=3D"hl kwa">equal</span><span class=3D"hl sym">)))</span>
-<a id=3D"l_569"></a><span class=3D"hl line"> 569 </span>
-<a id=3D"l_570"></a><span class=3D"hl line"> 570 </span><span class=3D"hl=
sym">(</span>defgeneric component-depends-on <span class=3D"hl sym">(</spa=
n>operation component<span class=3D"hl sym">)</span>
-<a id=3D"l_571"></a><span class=3D"hl line"> 571 </span> <span class=3D"=
hl sym">(:</span>documentation
-<a id=3D"l_572"></a><span class=3D"hl line"> 572 </span> <span class=3D=
"hl str">"Returns a list of dependencies needed by the component to pe=
rform</span>
-<a id=3D"l_573"></a><span class=3D"hl line"> 573 </span><span class=3D"hl=
str"> the operation. A dependency has one of the following forms:</spa=
n>
-<a id=3D"l_574"></a><span class=3D"hl line"> 574 </span><span class=3D"hl=
str"></span>
-<a id=3D"l_575"></a><span class=3D"hl line"> 575 </span><span class=3D"hl=
str"> (<operation> <component>*), where <operation>=
is a class</span>
-<a id=3D"l_576"></a><span class=3D"hl line"> 576 </span><span class=3D"hl=
str"> designator and each <component> is a component</span>
-<a id=3D"l_577"></a><span class=3D"hl line"> 577 </span><span class=3D"hl=
str"> designator, which means that the component depends on</span>
-<a id=3D"l_578"></a><span class=3D"hl line"> 578 </span><span class=3D"hl=
str"> <operation> having been performed on each <component=
>; or</span>
-<a id=3D"l_579"></a><span class=3D"hl line"> 579 </span><span class=3D"hl=
str"></span>
-<a id=3D"l_580"></a><span class=3D"hl line"> 580 </span><span class=3D"hl=
str"> (FEATURE <feature>), which means that the component depen=
ds</span>
-<a id=3D"l_581"></a><span class=3D"hl line"> 581 </span><span class=3D"hl=
str"> on <feature>'s presence in *FEATURES*.</span>
-<a id=3D"l_582"></a><span class=3D"hl line"> 582 </span><span class=3D"hl=
str"></span>
-<a id=3D"l_583"></a><span class=3D"hl line"> 583 </span><span class=3D"hl=
str"> Methods specialized on subclasses of existing component types</sp=
an>
-<a id=3D"l_584"></a><span class=3D"hl line"> 584 </span><span class=3D"hl=
str"> should usually append the results of CALL-NEXT-METHOD to the</spa=
n>
-<a id=3D"l_585"></a><span class=3D"hl line"> 585 </span><span class=3D"hl=
str"> list."</span><span class=3D"hl sym">))</span>
-<a id=3D"l_586"></a><span class=3D"hl line"> 586 </span>
-<a id=3D"l_587"></a><span class=3D"hl line"> 587 </span><span class=3D"hl=
sym">(</span>defmethod component-depends-on <span class=3D"hl sym">((</spa=
n>op-spec symbol<span class=3D"hl sym">) (</span>c component<span class=3D"=
hl sym">))</span>
-<a id=3D"l_588"></a><span class=3D"hl line"> 588 </span> <span class=3D"=
hl sym">(</span>component-depends-on <span class=3D"hl sym">(</span>make-in=
stance op-spec<span class=3D"hl sym">)</span> c<span class=3D"hl sym">))</s=
pan>
-<a id=3D"l_589"></a><span class=3D"hl line"> 589 </span>
-<a id=3D"l_590"></a><span class=3D"hl line"> 590 </span><span class=3D"hl=
sym">(</span>defmethod component-depends-on <span class=3D"hl sym">((</spa=
n>o operation<span class=3D"hl sym">) (</span>c component<span class=3D"hl =
sym">))</span>
-<a id=3D"l_591"></a><span class=3D"hl line"> 591 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">cdr</span> <span class=3D"hl sym">(<=
/span><span class=3D"hl kwa">assoc</span> <span class=3D"hl sym">(</span>cl=
ass-name <span class=3D"hl sym">(</span>class-of o<span class=3D"hl sym">))=
</span>
-<a id=3D"l_592"></a><span class=3D"hl line"> 592 </span> <sp=
an class=3D"hl sym">(</span>slot-value c <span class=3D"hl sym">'</span>in-=
order-to<span class=3D"hl sym">))))</span>
-<a id=3D"l_593"></a><span class=3D"hl line"> 593 </span>
-<a id=3D"l_594"></a><span class=3D"hl line"> 594 </span><span class=3D"hl=
sym">(</span>defgeneric component-self-dependencies <span class=3D"hl sym"=
>(</span>operation component<span class=3D"hl sym">))</span>
-<a id=3D"l_595"></a><span class=3D"hl line"> 595 </span>
-<a id=3D"l_596"></a><span class=3D"hl line"> 596 </span><span class=3D"hl=
sym">(</span>defmethod component-self-dependencies <span class=3D"hl sym">=
((</span>o operation<span class=3D"hl sym">) (</span>c component<span class=
=3D"hl sym">))</span>
-<a id=3D"l_597"></a><span class=3D"hl line"> 597 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>all-deps <span class=3D=
"hl sym">(</span>component-depends-on o c<span class=3D"hl sym">)))</span>
-<a id=3D"l_598"></a><span class=3D"hl line"> 598 </span> <span class=
=3D"hl sym">(</span>remove-<span class=3D"hl kwa">if</span>-<span class=3D"=
hl kwa">not</span> <span class=3D"hl sym">(</span><span class=3D"hl kwa">la=
mbda</span> <span class=3D"hl sym">(</span>x<span class=3D"hl sym">)</span>
-<a id=3D"l_599"></a><span class=3D"hl line"> 599 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">member</span> <sp=
an class=3D"hl sym">(</span>component-name c<span class=3D"hl sym">) (</spa=
n><span class=3D"hl kwa">cdr</span> x<span class=3D"hl sym">) :</span>test =
#<span class=3D"hl sym">'</span>string<span class=3D"hl sym">=3D))</span>
-<a id=3D"l_600"></a><span class=3D"hl line"> 600 </span> =
all-deps<span class=3D"hl sym">)))</span>
-<a id=3D"l_601"></a><span class=3D"hl line"> 601 </span>
-<a id=3D"l_602"></a><span class=3D"hl line"> 602 </span><span class=3D"hl=
sym">(</span>defmethod input-files <span class=3D"hl sym">((</span>operati=
on operation<span class=3D"hl sym">) (</span>c component<span class=3D"hl s=
ym">))</span>
-<a id=3D"l_603"></a><span class=3D"hl line"> 603 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>parent <span class=3D"h=
l sym">(</span>component-parent c<span class=3D"hl sym">))</span>
-<a id=3D"l_604"></a><span class=3D"hl line"> 604 </span> <span cla=
ss=3D"hl sym">(</span>self-deps <span class=3D"hl sym">(</span>component-se=
lf-dependencies operation c<span class=3D"hl sym">)))</span>
-<a id=3D"l_605"></a><span class=3D"hl line"> 605 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> self-deps
-<a id=3D"l_606"></a><span class=3D"hl line"> 606 </span> <span cla=
ss=3D"hl sym">(</span>mapcan <span class=3D"hl sym">(</span><span class=3D"=
hl kwa">lambda</span> <span class=3D"hl sym">(</span>dep<span class=3D"hl s=
ym">)</span>
-<a id=3D"l_607"></a><span class=3D"hl line"> 607 </span> =
<span class=3D"hl sym">(</span>destructuring-bind <span class=3D"hl sym">(=
</span>op name<span class=3D"hl sym">)</span> dep
-<a id=3D"l_608"></a><span class=3D"hl line"> 608 </span> =
<span class=3D"hl sym">(</span>output-files <span class=3D"hl sym">(</sp=
an>make-instance op<span class=3D"hl sym">)</span>
-<a id=3D"l_609"></a><span class=3D"hl line"> 609 </span> =
<span class=3D"hl sym">(</span>find-component parent name<=
span class=3D"hl sym">))))</span>
-<a id=3D"l_610"></a><span class=3D"hl line"> 610 </span> s=
elf-deps<span class=3D"hl sym">)</span>
-<a id=3D"l_611"></a><span class=3D"hl line"> 611 </span> <span cla=
ss=3D"hl slc">;; no previous operations needed? I guess we work with the</=
span>
-<a id=3D"l_612"></a><span class=3D"hl line"> 612 </span> <span cla=
ss=3D"hl slc">;; original source file, then</span>
-<a id=3D"l_613"></a><span class=3D"hl line"> 613 </span> <span cla=
ss=3D"hl sym">(</span><span class=3D"hl kwa">list</span> <span class=3D"hl =
sym">(</span>component-pathname c<span class=3D"hl sym">)))))</span>
-<a id=3D"l_614"></a><span class=3D"hl line"> 614 </span>
-<a id=3D"l_615"></a><span class=3D"hl line"> 615 </span><span class=3D"hl=
sym">(</span>defmethod input-files <span class=3D"hl sym">((</span>operati=
on operation<span class=3D"hl sym">) (</span>c module<span class=3D"hl sym"=
>))</span> nil<span class=3D"hl sym">)</span>
-<a id=3D"l_616"></a><span class=3D"hl line"> 616 </span>
-<a id=3D"l_617"></a><span class=3D"hl line"> 617 </span><span class=3D"hl=
sym">(</span>defmethod operation-done-p <span class=3D"hl sym">((</span>o =
operation<span class=3D"hl sym">) (</span>c component<span class=3D"hl sym"=
>))</span>
-<a id=3D"l_618"></a><span class=3D"hl line"> 618 </span> <span class=3D"=
hl sym">(</span>flet <span class=3D"hl sym">((</span>fwd-<span class=3D"hl =
kwa">or</span>-return-t <span class=3D"hl sym">(</span>file<span class=3D"h=
l sym">)</span>
-<a id=3D"l_619"></a><span class=3D"hl line"> 619 </span> <span =
class=3D"hl slc">;; if FILE-WRITE-DATE returns NIL, it's possible that the<=
/span>
-<a id=3D"l_620"></a><span class=3D"hl line"> 620 </span> <span =
class=3D"hl slc">;; user or some other agent has deleted an input file. If=
</span>
-<a id=3D"l_621"></a><span class=3D"hl line"> 621 </span> <span =
class=3D"hl slc">;; that's the case, well, that's not good, but as long as<=
/span>
-<a id=3D"l_622"></a><span class=3D"hl line"> 622 </span> <span =
class=3D"hl slc">;; the operation is otherwise considered to be done we</sp=
an>
-<a id=3D"l_623"></a><span class=3D"hl line"> 623 </span> <span =
class=3D"hl slc">;; could continue and survive.</span>
-<a id=3D"l_624"></a><span class=3D"hl line"> 624 </span> <span =
class=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>date <span cla=
ss=3D"hl sym">(</span>file-write-date file<span class=3D"hl sym">)))</span>
-<a id=3D"l_625"></a><span class=3D"hl line"> 625 </span> <spa=
n class=3D"hl sym">(</span><span class=3D"hl kwa">cond</span>
-<a id=3D"l_626"></a><span class=3D"hl line"> 626 </span> <s=
pan class=3D"hl sym">(</span>date<span class=3D"hl sym">)</span>
-<a id=3D"l_627"></a><span class=3D"hl line"> 627 </span> <s=
pan class=3D"hl sym">(</span>t
-<a id=3D"l_628"></a><span class=3D"hl line"> 628 </span> <=
span class=3D"hl sym">(</span>warn <span class=3D"hl str">"~@<M=
issing FILE-WRITE-DATE for ~S: treating ~</span>
-<a id=3D"l_629"></a><span class=3D"hl line"> 629 </span><span class=3D"hl=
str"> operation ~S on component ~S as done.~@:&g=
t;"</span>
-<a id=3D"l_630"></a><span class=3D"hl line"> 630 </span> =
file o c<span class=3D"hl sym">)</span>
-<a id=3D"l_631"></a><span class=3D"hl line"> 631 </span> <=
span class=3D"hl sym">(</span>return-from operation-done-p t<span class=3D"=
hl sym">))))))</span>
-<a id=3D"l_632"></a><span class=3D"hl line"> 632 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>out-files <span cla=
ss=3D"hl sym">(</span>output-files o c<span class=3D"hl sym">))</span>
-<a id=3D"l_633"></a><span class=3D"hl line"> 633 </span> <span c=
lass=3D"hl sym">(</span>in-files <span class=3D"hl sym">(</span>input-files=
o c<span class=3D"hl sym">)))</span>
-<a id=3D"l_634"></a><span class=3D"hl line"> 634 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">cond</span> <span class=3D"hl sy=
m">((</span><span class=3D"hl kwa">and</span> <span class=3D"hl sym">(</spa=
n><span class=3D"hl kwa">not</span> in-files<span class=3D"hl sym">) (</spa=
n><span class=3D"hl kwa">not</span> out-files<span class=3D"hl sym">))</spa=
n>
-<a id=3D"l_635"></a><span class=3D"hl line"> 635 </span> <spa=
n class=3D"hl slc">;; arbitrary decision: an operation that uses nothing to=
</span>
-<a id=3D"l_636"></a><span class=3D"hl line"> 636 </span> <spa=
n class=3D"hl slc">;; produce nothing probably isn't doing much</span>
-<a id=3D"l_637"></a><span class=3D"hl line"> 637 </span> t<sp=
an class=3D"hl sym">)</span>
-<a id=3D"l_638"></a><span class=3D"hl line"> 638 </span> <span=
class=3D"hl sym">((</span><span class=3D"hl kwa">not</span> out-files<span=
class=3D"hl sym">)</span>
-<a id=3D"l_639"></a><span class=3D"hl line"> 639 </span> <spa=
n class=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>op-done
-<a id=3D"l_640"></a><span class=3D"hl line"> 640 </span> =
<span class=3D"hl sym">(</span>gethash <span class=3D"hl sym">(</span><s=
pan class=3D"hl kwa">type</span>-of o<span class=3D"hl sym">)</span>
-<a id=3D"l_641"></a><span class=3D"hl line"> 641 </span> =
<span class=3D"hl sym">(</span>component-operation-times c<span=
class=3D"hl sym">))))</span>
-<a id=3D"l_642"></a><span class=3D"hl line"> 642 </span> <s=
pan class=3D"hl sym">(</span><span class=3D"hl kwa">and</span> op-done
-<a id=3D"l_643"></a><span class=3D"hl line"> 643 </span> =
<span class=3D"hl sym">(>=3D</span> op-done
-<a id=3D"l_644"></a><span class=3D"hl line"> 644 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">apply</span> #=
<span class=3D"hl sym">'</span><span class=3D"hl kwa">max</span>
-<a id=3D"l_645"></a><span class=3D"hl line"> 645 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">mapcar<=
/span> #<span class=3D"hl sym">'</span>fwd-<span class=3D"hl kwa">or</span>=
-return-t in-files<span class=3D"hl sym">))))))</span>
-<a id=3D"l_646"></a><span class=3D"hl line"> 646 </span> <span=
class=3D"hl sym">((</span><span class=3D"hl kwa">not</span> in-files<span =
class=3D"hl sym">)</span> nil<span class=3D"hl sym">)</span>
-<a id=3D"l_647"></a><span class=3D"hl line"> 647 </span> <span=
class=3D"hl sym">(</span>t
-<a id=3D"l_648"></a><span class=3D"hl line"> 648 </span> <spa=
n class=3D"hl sym">(</span><span class=3D"hl kwa">and</span>
-<a id=3D"l_649"></a><span class=3D"hl line"> 649 </span> <sp=
an class=3D"hl sym">(</span>every #<span class=3D"hl sym">'</span>probe-fil=
e out-files<span class=3D"hl sym">)</span>
-<a id=3D"l_650"></a><span class=3D"hl line"> 650 </span> <sp=
an class=3D"hl sym">(> (</span><span class=3D"hl kwa">apply</span> #<spa=
n class=3D"hl sym">'</span><span class=3D"hl kwa">min</span> <span class=3D=
"hl sym">(</span><span class=3D"hl kwa">mapcar</span> #<span class=3D"hl sy=
m">'</span>file-write-date out-files<span class=3D"hl sym">))</span>
-<a id=3D"l_651"></a><span class=3D"hl line"> 651 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">apply</span> #<span c=
lass=3D"hl sym">'</span><span class=3D"hl kwa">max</span> <span class=3D"hl=
sym">(</span><span class=3D"hl kwa">mapcar</span> #<span class=3D"hl sym">=
'</span>fwd-<span class=3D"hl kwa">or</span>-return-t in-files<span class=
=3D"hl sym">)))))))))</span>
-<a id=3D"l_652"></a><span class=3D"hl line"> 652 </span>
-<a id=3D"l_653"></a><span class=3D"hl line"> 653 </span><span class=3D"hl=
slc">;;; So you look at this code and think "why isn't it a bunch of<=
/span>
-<a id=3D"l_654"></a><span class=3D"hl line"> 654 </span><span class=3D"hl=
slc">;;; methods". And the answer is, because standard method combin=
ation</span>
-<a id=3D"l_655"></a><span class=3D"hl line"> 655 </span><span class=3D"hl=
slc">;;; runs :before methods most->least-specific, which is back to fr=
ont</span>
-<a id=3D"l_656"></a><span class=3D"hl line"> 656 </span><span class=3D"hl=
slc">;;; for our purposes. And CLISP doesn't have non-standard method</sp=
an>
-<a id=3D"l_657"></a><span class=3D"hl line"> 657 </span><span class=3D"hl=
slc">;;; combinations, so let's keep it simple and aspire to portability</=
span>
-<a id=3D"l_658"></a><span class=3D"hl line"> 658 </span>
-<a id=3D"l_659"></a><span class=3D"hl line"> 659 </span><span class=3D"hl=
sym">(</span>defgeneric traverse <span class=3D"hl sym">(</span>operation =
component<span class=3D"hl sym">))</span>
-<a id=3D"l_660"></a><span class=3D"hl line"> 660 </span><span class=3D"hl=
sym">(</span>defmethod traverse <span class=3D"hl sym">((</span>operation =
operation<span class=3D"hl sym">) (</span>c component<span class=3D"hl sym"=
>))</span>
-<a id=3D"l_661"></a><span class=3D"hl line"> 661 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>forced nil<span class=
=3D"hl sym">))</span>
-<a id=3D"l_662"></a><span class=3D"hl line"> 662 </span> <span class=
=3D"hl sym">(</span>labels <span class=3D"hl sym">((</span>do-one-dep <span=
class=3D"hl sym">(</span>required-op required-c required-v<span class=3D"h=
l sym">)</span>
-<a id=3D"l_663"></a><span class=3D"hl line"> 663 </span> <s=
pan class=3D"hl sym">(</span>let<span class=3D"hl sym">* ((</span>dep-c <sp=
an class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> <span class=3D=
"hl sym">(</span>find-component
-<a id=3D"l_664"></a><span class=3D"hl line"> 664 </span> =
<span class=3D"hl sym">(</span>component-parent c<span cla=
ss=3D"hl sym">)</span>
-<a id=3D"l_665"></a><span class=3D"hl line"> 665 </span> =
<span class=3D"hl slc">;; XXX tacky. really we should bui=
ld the</span>
-<a id=3D"l_666"></a><span class=3D"hl line"> 666 </span> =
<span class=3D"hl slc">;; in-order-to slot with canonicali=
zed</span>
-<a id=3D"l_667"></a><span class=3D"hl line"> 667 </span> =
<span class=3D"hl slc">;; names instead of coercing this l=
ate</span>
-<a id=3D"l_668"></a><span class=3D"hl line"> 668 </span> =
<span class=3D"hl sym">(</span>coerce-name required-c<span=
class=3D"hl sym">)</span> required-v<span class=3D"hl sym">)</span>
-<a id=3D"l_669"></a><span class=3D"hl line"> 669 </span> =
<span class=3D"hl sym">(</span>error <span class=3D"hl sym"=
>'</span>missing-dependency
-<a id=3D"l_670"></a><span class=3D"hl line"> 670 </span> =
<span class=3D"hl sym">:</span>required-by c
-<a id=3D"l_671"></a><span class=3D"hl line"> 671 </span> =
<span class=3D"hl sym">:</span>version required-v
-<a id=3D"l_672"></a><span class=3D"hl line"> 672 </span> =
<span class=3D"hl sym">:</span>requires required-c<s=
pan class=3D"hl sym">)))</span>
-<a id=3D"l_673"></a><span class=3D"hl line"> 673 </span> =
<span class=3D"hl sym">(</span>op <span class=3D"hl sym">(</span>make-=
sub-operation c operation dep-c required-op<span class=3D"hl sym">)))</span>
-<a id=3D"l_674"></a><span class=3D"hl line"> 674 </span> =
<span class=3D"hl sym">(</span>traverse op dep-c<span class=3D"hl sym">)))<=
/span>
-<a id=3D"l_675"></a><span class=3D"hl line"> 675 </span> <spa=
n class=3D"hl sym">(</span>do-dep <span class=3D"hl sym">(</span>op dep<spa=
n class=3D"hl sym">)</span>
-<a id=3D"l_676"></a><span class=3D"hl line"> 676 </span> <s=
pan class=3D"hl sym">(</span><span class=3D"hl kwa">cond</span> <span class=
=3D"hl sym">((</span><span class=3D"hl kwa">eq</span> op <span class=3D"hl =
sym">'</span>feature<span class=3D"hl sym">)</span>
-<a id=3D"l_677"></a><span class=3D"hl line"> 677 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> <span =
class=3D"hl sym">(</span><span class=3D"hl kwa">member</span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">car</span> dep<span class=3D"hl =
sym">) *</span>features<span class=3D"hl sym">*)</span>
-<a id=3D"l_678"></a><span class=3D"hl line"> 678 </span> =
<span class=3D"hl sym">(</span>error <span class=3D"hl sym">'</spa=
n>missing-dependency
-<a id=3D"l_679"></a><span class=3D"hl line"> 679 </span> =
<span class=3D"hl sym">:</span>required-by c
-<a id=3D"l_680"></a><span class=3D"hl line"> 680 </span> =
<span class=3D"hl sym">:</span>requires <span class=3D"hl s=
ym">(</span><span class=3D"hl kwa">car</span> dep<span class=3D"hl sym">)</=
span>
-<a id=3D"l_681"></a><span class=3D"hl line"> 681 </span> =
<span class=3D"hl sym">:</span>version nil<span class=3D"hl=
sym">)))</span>
-<a id=3D"l_682"></a><span class=3D"hl line"> 682 </span> =
<span class=3D"hl sym">(</span>t
-<a id=3D"l_683"></a><span class=3D"hl line"> 683 </span> =
<span class=3D"hl sym">(</span>dolist <span class=3D"hl sym">(</span>d=
dep<span class=3D"hl sym">)</span>
-<a id=3D"l_684"></a><span class=3D"hl line"> 684 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">cond</span> <s=
pan class=3D"hl sym">((</span>consp d<span class=3D"hl sym">)</span>
-<a id=3D"l_685"></a><span class=3D"hl line"> 685 </span> =
<span class=3D"hl sym">(</span>assert <span class=3D"hl sym">=
(</span>string-<span class=3D"hl kwa">equal</span>
-<a id=3D"l_686"></a><span class=3D"hl line"> 686 </span> =
<span class=3D"hl sym">(</span>symbol-name <span cla=
ss=3D"hl sym">(</span>first d<span class=3D"hl sym">))</span>
-<a id=3D"l_687"></a><span class=3D"hl line"> 687 </span> =
<span class=3D"hl str">"VERSION"</span><sp=
an class=3D"hl sym">))</span>
-<a id=3D"l_688"></a><span class=3D"hl line"> 688 </span> =
<span class=3D"hl sym">(</span>appendf forced
-<a id=3D"l_689"></a><span class=3D"hl line"> 689 </span> =
<span class=3D"hl sym">(</span>do-one-dep op <span c=
lass=3D"hl sym">(</span>second d<span class=3D"hl sym">) (</span>third d<sp=
an class=3D"hl sym">))))</span>
-<a id=3D"l_690"></a><span class=3D"hl line"> 690 </span> =
<span class=3D"hl sym">(</span>t
-<a id=3D"l_691"></a><span class=3D"hl line"> 691 </span> =
<span class=3D"hl sym">(</span>appendf forced <span class=3D"=
hl sym">(</span>do-one-dep op d nil<span class=3D"hl sym">)))))))))</span>
-<a id=3D"l_692"></a><span class=3D"hl line"> 692 </span> <span class=
=3D"hl sym">(</span>aif <span class=3D"hl sym">(</span>component-visited-p =
operation c<span class=3D"hl sym">)</span>
-<a id=3D"l_693"></a><span class=3D"hl line"> 693 </span> <span =
class=3D"hl sym">(</span>return-from traverse
-<a id=3D"l_694"></a><span class=3D"hl line"> 694 </span> <spa=
n class=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">cdr</span> it<span class=3D"hl sym">=
) (</span><span class=3D"hl kwa">list</span> <span class=3D"hl sym">(</span=
><span class=3D"hl kwa">cons</span> <span class=3D"hl sym">'</span>pruned-o=
p c<span class=3D"hl sym">))</span> nil<span class=3D"hl sym">)))</span>
-<a id=3D"l_695"></a><span class=3D"hl line"> 695 </span> <span class=
=3D"hl slc">;; dependencies</span>
-<a id=3D"l_696"></a><span class=3D"hl line"> 696 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D"hl sym"=
>(</span>component-visiting-p operation c<span class=3D"hl sym">)</span>
-<a id=3D"l_697"></a><span class=3D"hl line"> 697 </span> <span c=
lass=3D"hl sym">(</span>error <span class=3D"hl sym">'</span>circular-depen=
dency <span class=3D"hl sym">:</span>components <span class=3D"hl sym">(</s=
pan><span class=3D"hl kwa">list</span> c<span class=3D"hl sym">)))</span>
-<a id=3D"l_698"></a><span class=3D"hl line"> 698 </span> <span class=
=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>visiting-component =
operation c<span class=3D"hl sym">)</span> t<span class=3D"hl sym">)</span>
-<a id=3D"l_699"></a><span class=3D"hl line"> 699 </span> <span class=
=3D"hl sym">(</span>loop for <span class=3D"hl sym">(</span>required-op . d=
eps<span class=3D"hl sym">)</span> in <span class=3D"hl sym">(</span>compon=
ent-depends-on operation c<span class=3D"hl sym">)</span>
-<a id=3D"l_700"></a><span class=3D"hl line"> 700 </span> do <s=
pan class=3D"hl sym">(</span>do-dep required-op deps<span class=3D"hl sym">=
))</span>
-<a id=3D"l_701"></a><span class=3D"hl line"> 701 </span> <span class=
=3D"hl slc">;; constituent bits</span>
-<a id=3D"l_702"></a><span class=3D"hl line"> 702 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>module-ops
-<a id=3D"l_703"></a><span class=3D"hl line"> 703 </span> <spa=
n class=3D"hl sym">(</span>when <span class=3D"hl sym">(</span>typep c <spa=
n class=3D"hl sym">'</span>module<span class=3D"hl sym">)</span>
-<a id=3D"l_704"></a><span class=3D"hl line"> 704 </span> <s=
pan class=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>at-least-o=
ne nil<span class=3D"hl sym">)</span>
-<a id=3D"l_705"></a><span class=3D"hl line"> 705 </span> =
<span class=3D"hl sym">(</span>forced nil<span class=3D"hl sym">)</span>
-<a id=3D"l_706"></a><span class=3D"hl line"> 706 </span> =
<span class=3D"hl sym">(</span>error nil<span class=3D"hl sym">))</span>
-<a id=3D"l_707"></a><span class=3D"hl line"> 707 </span> =
<span class=3D"hl sym">(</span>loop for kid in <span class=3D"hl sym">(</sp=
an>module-components c<span class=3D"hl sym">)</span>
-<a id=3D"l_708"></a><span class=3D"hl line"> 708 </span> =
do <span class=3D"hl sym">(</span>handler-case
-<a id=3D"l_709"></a><span class=3D"hl line"> 709 </span> =
<span class=3D"hl sym">(</span>appendf forced <span class=3D"h=
l sym">(</span>traverse operation kid <span class=3D"hl sym">))</span>
-<a id=3D"l_710"></a><span class=3D"hl line"> 710 </span> =
<span class=3D"hl sym">(</span>missing-dependency <span class=3D=
"hl sym">(</span>condition<span class=3D"hl sym">)</span>
-<a id=3D"l_711"></a><span class=3D"hl line"> 711 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">if</span=
> <span class=3D"hl sym">(</span><span class=3D"hl kwa">eq</span> <span cla=
ss=3D"hl sym">(</span>module-<span class=3D"hl kwa">if</span>-component-dep=
-fails c<span class=3D"hl sym">) :</span>fail<span class=3D"hl sym">)</span>
-<a id=3D"l_712"></a><span class=3D"hl line"> 712 </span> =
<span class=3D"hl sym">(</span>error condition<span class=
=3D"hl sym">))</span>
-<a id=3D"l_713"></a><span class=3D"hl line"> 713 </span> =
<span class=3D"hl sym">(</span>setf error condition<span class=
=3D"hl sym">))</span>
-<a id=3D"l_714"></a><span class=3D"hl line"> 714 </span> =
<span class=3D"hl sym">(:</span>no-error <span class=3D"hl sym">=
(</span>c<span class=3D"hl sym">)</span>
-<a id=3D"l_715"></a><span class=3D"hl line"> 715 </span> =
<span class=3D"hl sym">(</span>declare <span class=3D"hl sym">=
(</span>ignore c<span class=3D"hl sym">))</span>
-<a id=3D"l_716"></a><span class=3D"hl line"> 716 </span> =
<span class=3D"hl sym">(</span>setf at-least-one t<span class=
=3D"hl sym">))))</span>
-<a id=3D"l_717"></a><span class=3D"hl line"> 717 </span> =
<span class=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span cl=
ass=3D"hl kwa">and</span> <span class=3D"hl sym">(</span><span class=3D"hl =
kwa">eq</span> <span class=3D"hl sym">(</span>module-<span class=3D"hl kwa"=
>if</span>-component-dep-fails c<span class=3D"hl sym">) :</span>try-next<s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_718"></a><span class=3D"hl line"> 718 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">not</span>=
at-least-one<span class=3D"hl sym">))</span>
-<a id=3D"l_719"></a><span class=3D"hl line"> 719 </span> =
<span class=3D"hl sym">(</span>error error<span class=3D"hl sym">))</span>
-<a id=3D"l_720"></a><span class=3D"hl line"> 720 </span> =
forced<span class=3D"hl sym">))))</span>
-<a id=3D"l_721"></a><span class=3D"hl line"> 721 </span> <span cla=
ss=3D"hl slc">;; now the thing itself</span>
-<a id=3D"l_722"></a><span class=3D"hl line"> 722 </span> <span cla=
ss=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"hl=
kwa">or</span> forced module-ops
-<a id=3D"l_723"></a><span class=3D"hl line"> 723 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">not</span> <span cla=
ss=3D"hl sym">(</span>operation-done-p operation c<span class=3D"hl sym">))=
</span>
-<a id=3D"l_724"></a><span class=3D"hl line"> 724 </span> =
<span class=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>f <span=
class=3D"hl sym">(</span>operation-forced <span class=3D"hl sym">(</span>o=
peration-ancestor operation<span class=3D"hl sym">))))</span>
-<a id=3D"l_725"></a><span class=3D"hl line"> 725 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">and</span> f <span=
class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> <span class=3D"h=
l sym">(</span><span class=3D"hl kwa">not</span> <span class=3D"hl sym">(</=
span>consp f<span class=3D"hl sym">))</span>
-<a id=3D"l_726"></a><span class=3D"hl line"> 726 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">member<=
/span> <span class=3D"hl sym">(</span>component-name
-<a id=3D"l_727"></a><span class=3D"hl line"> 727 </span> =
<span class=3D"hl sym">(</span>operation-ancestor op=
eration<span class=3D"hl sym">))</span>
-<a id=3D"l_728"></a><span class=3D"hl line"> 728 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa"=
>mapcar</span> #<span class=3D"hl sym">'</span>coerce-name f<span class=3D"=
hl sym">)</span>
-<a id=3D"l_729"></a><span class=3D"hl line"> 729 </span> =
<span class=3D"hl sym">:</span>test #<span class=3D"h=
l sym">'</span>string<span class=3D"hl sym">=3D)))))</span>
-<a id=3D"l_730"></a><span class=3D"hl line"> 730 </span> <span c=
lass=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>do-first <span =
class=3D"hl sym">(</span><span class=3D"hl kwa">cdr</span> <span class=3D"h=
l sym">(</span><span class=3D"hl kwa">assoc</span> <span class=3D"hl sym">(=
</span>class-name <span class=3D"hl sym">(</span>class-of operation<span cl=
ass=3D"hl sym">))</span>
-<a id=3D"l_731"></a><span class=3D"hl line"> 731 </span> =
<span class=3D"hl sym">(</span>slot-value c <span clas=
s=3D"hl sym">'</span>do-first<span class=3D"hl sym">)))))</span>
-<a id=3D"l_732"></a><span class=3D"hl line"> 732 </span> <span=
class=3D"hl sym">(</span>loop for <span class=3D"hl sym">(</span>required-=
op . deps<span class=3D"hl sym">)</span> in do-first
-<a id=3D"l_733"></a><span class=3D"hl line"> 733 </span> =
do <span class=3D"hl sym">(</span>do-dep required-op deps<span class=3D"hl=
sym">)))</span>
-<a id=3D"l_734"></a><span class=3D"hl line"> 734 </span> <span c=
lass=3D"hl sym">(</span>setf forced <span class=3D"hl sym">(</span><span cl=
ass=3D"hl kwa">append</span> <span class=3D"hl sym">(</span>delete <span cl=
ass=3D"hl sym">'</span>pruned-op forced <span class=3D"hl sym">:</span>key =
#<span class=3D"hl sym">'</span><span class=3D"hl kwa">car</span><span clas=
s=3D"hl sym">)</span>
-<a id=3D"l_735"></a><span class=3D"hl line"> 735 </span> =
<span class=3D"hl sym">(</span>delete <span class=3D"hl sym">=
'</span>pruned-op module-ops <span class=3D"hl sym">:</span>key #<span clas=
s=3D"hl sym">'</span><span class=3D"hl kwa">car</span><span class=3D"hl sym=
">)</span>
-<a id=3D"l_736"></a><span class=3D"hl line"> 736 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">list</s=
pan> <span class=3D"hl sym">(</span><span class=3D"hl kwa">cons</span> oper=
ation c<span class=3D"hl sym">))))))</span>
-<a id=3D"l_737"></a><span class=3D"hl line"> 737 </span> <span class=
=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>visiting-component =
operation c<span class=3D"hl sym">)</span> nil<span class=3D"hl sym">)</spa=
n>
-<a id=3D"l_738"></a><span class=3D"hl line"> 738 </span> <span class=
=3D"hl sym">(</span>visit-component operation c <span class=3D"hl sym">(</s=
pan><span class=3D"hl kwa">and</span> forced t<span class=3D"hl sym">))</sp=
an>
-<a id=3D"l_739"></a><span class=3D"hl line"> 739 </span> forced<span=
class=3D"hl sym">)))</span>
-<a id=3D"l_740"></a><span class=3D"hl line"> 740 </span>
-<a id=3D"l_741"></a><span class=3D"hl line"> 741 </span>
-<a id=3D"l_742"></a><span class=3D"hl line"> 742 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>operation o=
peration<span class=3D"hl sym">) (</span>c source-file<span class=3D"hl sym=
">))</span>
-<a id=3D"l_743"></a><span class=3D"hl line"> 743 </span> <span class=3D"=
hl sym">(</span>sysdef-error
-<a id=3D"l_744"></a><span class=3D"hl line"> 744 </span> <span class=3D=
"hl str">"~@<required method PERFORM not implemented ~</span>
-<a id=3D"l_745"></a><span class=3D"hl line"> 745 </span><span class=3D"hl=
str"> for operation ~A, component ~A~@:>"</span>
-<a id=3D"l_746"></a><span class=3D"hl line"> 746 </span> <span class=3D=
"hl sym">(</span>class-of operation<span class=3D"hl sym">) (</span>class-o=
f c<span class=3D"hl sym">)))</span>
-<a id=3D"l_747"></a><span class=3D"hl line"> 747 </span>
-<a id=3D"l_748"></a><span class=3D"hl line"> 748 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>operation o=
peration<span class=3D"hl sym">) (</span>c module<span class=3D"hl sym">))<=
/span>
-<a id=3D"l_749"></a><span class=3D"hl line"> 749 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_750"></a><span class=3D"hl line"> 750 </span>
-<a id=3D"l_751"></a><span class=3D"hl line"> 751 </span><span class=3D"hl=
sym">(</span>defmethod explain <span class=3D"hl sym">((</span>operation o=
peration<span class=3D"hl sym">) (</span>component component<span class=3D"=
hl sym">))</span>
-<a id=3D"l_752"></a><span class=3D"hl line"> 752 </span> <span class=3D"=
hl sym">(</span>format <span class=3D"hl sym">*</span>verbose-out<span clas=
s=3D"hl sym">*</span> <span class=3D"hl str">"~&;;; ~A on ~A~%&quo=
t;</span> operation component<span class=3D"hl sym">))</span>
-<a id=3D"l_753"></a><span class=3D"hl line"> 753 </span>
-<a id=3D"l_754"></a><span class=3D"hl line"> 754 </span><span class=3D"hl=
slc">;;; compile-op</span>
-<a id=3D"l_755"></a><span class=3D"hl line"> 755 </span>
-<a id=3D"l_756"></a><span class=3D"hl line"> 756 </span><span class=3D"hl=
sym">(</span>defclass compile-op <span class=3D"hl sym">(</span>operation<=
span class=3D"hl sym">)</span>
-<a id=3D"l_757"></a><span class=3D"hl line"> 757 </span> <span class=3D"=
hl sym">((</span>proclamations <span class=3D"hl sym">:</span>initarg <span=
class=3D"hl sym">:</span>proclamations <span class=3D"hl sym">:</span>acce=
ssor compile-op-proclamations <span class=3D"hl sym">:</span>initform nil<s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_758"></a><span class=3D"hl line"> 758 </span> <span class=3D=
"hl sym">(</span>on-warnings <span class=3D"hl sym">:</span>initarg <span c=
lass=3D"hl sym">:</span>on-warnings <span class=3D"hl sym">:</span>accessor=
operation-on-warnings
-<a id=3D"l_759"></a><span class=3D"hl line"> 759 </span> <=
span class=3D"hl sym">:</span>initform <span class=3D"hl sym">*</span>compi=
le-file-warnings-behaviour<span class=3D"hl sym">*)</span>
-<a id=3D"l_760"></a><span class=3D"hl line"> 760 </span> <span class=3D=
"hl sym">(</span>on-failure <span class=3D"hl sym">:</span>initarg <span cl=
ass=3D"hl sym">:</span>on-failure <span class=3D"hl sym">:</span>accessor o=
peration-on-failure
-<a id=3D"l_761"></a><span class=3D"hl line"> 761 </span> <s=
pan class=3D"hl sym">:</span>initform <span class=3D"hl sym">*</span>compil=
e-file-failure-behaviour<span class=3D"hl sym">*)))</span>
-<a id=3D"l_762"></a><span class=3D"hl line"> 762 </span>
-<a id=3D"l_763"></a><span class=3D"hl line"> 763 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">:</span>before <span=
class=3D"hl sym">((</span>operation compile-op<span class=3D"hl sym">) (</=
span>c source-file<span class=3D"hl sym">))</span>
-<a id=3D"l_764"></a><span class=3D"hl line"> 764 </span> <span class=3D"=
hl sym">(</span>map nil #<span class=3D"hl sym">'</span>ensure-directories-=
exist <span class=3D"hl sym">(</span>output-files operation c<span class=3D=
"hl sym">)))</span>
-<a id=3D"l_765"></a><span class=3D"hl line"> 765 </span>
-<a id=3D"l_766"></a><span class=3D"hl line"> 766 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">:</span>after <span =
class=3D"hl sym">((</span>operation operation<span class=3D"hl sym">) (</sp=
an>c component<span class=3D"hl sym">))</span>
-<a id=3D"l_767"></a><span class=3D"hl line"> 767 </span> <span class=3D"=
hl sym">(</span>setf <span class=3D"hl sym">(</span>gethash <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">type</span>-of operation<span class=
=3D"hl sym">) (</span>component-operation-times c<span class=3D"hl sym">))<=
/span>
-<a id=3D"l_768"></a><span class=3D"hl line"> 768 </span> <span cla=
ss=3D"hl sym">(</span>get-universal-time<span class=3D"hl sym">))</span>
-<a id=3D"l_769"></a><span class=3D"hl line"> 769 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">load</span>-preferences c operation<=
span class=3D"hl sym">))</span>
-<a id=3D"l_770"></a><span class=3D"hl line"> 770 </span>
-<a id=3D"l_771"></a><span class=3D"hl line"> 771 </span><span class=3D"hl=
slc">;;; perform is required to check output-files to find out where to pu=
t</span>
-<a id=3D"l_772"></a><span class=3D"hl line"> 772 </span><span class=3D"hl=
slc">;;; its answers, in case it has been overridden for site policy</span>
-<a id=3D"l_773"></a><span class=3D"hl line"> 773 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>operation c=
ompile-op<span class=3D"hl sym">) (</span>c cl-source-file<span class=3D"hl=
sym">))</span>
-<a id=3D"l_774"></a><span class=3D"hl line"> 774 </span> #-<span class=
=3D"hl sym">:</span>broken-fasl-loader
-<a id=3D"l_775"></a><span class=3D"hl line"> 775 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>source-file <span class=
=3D"hl sym">(</span>component-pathname c<span class=3D"hl sym">))</span>
-<a id=3D"l_776"></a><span class=3D"hl line"> 776 </span> <span cla=
ss=3D"hl sym">(</span>output-file <span class=3D"hl sym">(</span><span clas=
s=3D"hl kwa">car</span> <span class=3D"hl sym">(</span>output-files operati=
on c<span class=3D"hl sym">))))</span>
-<a id=3D"l_777"></a><span class=3D"hl line"> 777 </span> <span class=
=3D"hl sym">(</span>multiple-value-bind <span class=3D"hl sym">(</span>outp=
ut warnings-p failure-p<span class=3D"hl sym">)</span>
-<a id=3D"l_778"></a><span class=3D"hl line"> 778 </span> <span cla=
ss=3D"hl sym">(</span>compile-file source-file <span class=3D"hl sym">:</sp=
an>output-file output-file<span class=3D"hl sym">)</span>
-<a id=3D"l_779"></a><span class=3D"hl line"> 779 </span> <span class=
=3D"hl sym">(</span>when warnings-p
-<a id=3D"l_780"></a><span class=3D"hl line"> 780 </span> <span cla=
ss=3D"hl sym">(</span>case <span class=3D"hl sym">(</span>operation-on-warn=
ings operation<span class=3D"hl sym">)</span>
-<a id=3D"l_781"></a><span class=3D"hl line"> 781 </span> <span c=
lass=3D"hl sym">(:</span>warn <span class=3D"hl sym">(</span>warn
-<a id=3D"l_782"></a><span class=3D"hl line"> 782 </span> =
<span class=3D"hl str">"~@<COMPILE-FILE warned while performin=
g ~A on ~A.~@:>"</span>
-<a id=3D"l_783"></a><span class=3D"hl line"> 783 </span> =
operation c<span class=3D"hl sym">))</span>
-<a id=3D"l_784"></a><span class=3D"hl line"> 784 </span> <span c=
lass=3D"hl sym">(:</span>error <span class=3D"hl sym">(</span>error <span c=
lass=3D"hl sym">'</span>compile-warned <span class=3D"hl sym">:</span>compo=
nent c <span class=3D"hl sym">:</span>operation operation<span class=3D"hl =
sym">))</span>
-<a id=3D"l_785"></a><span class=3D"hl line"> 785 </span> <span c=
lass=3D"hl sym">(:</span>ignore nil<span class=3D"hl sym">)))</span>
-<a id=3D"l_786"></a><span class=3D"hl line"> 786 </span> <span class=
=3D"hl sym">(</span>when failure-p
-<a id=3D"l_787"></a><span class=3D"hl line"> 787 </span> <span cla=
ss=3D"hl sym">(</span>case <span class=3D"hl sym">(</span>operation-on-fail=
ure operation<span class=3D"hl sym">)</span>
-<a id=3D"l_788"></a><span class=3D"hl line"> 788 </span> <span c=
lass=3D"hl sym">(:</span>warn <span class=3D"hl sym">(</span>warn
-<a id=3D"l_789"></a><span class=3D"hl line"> 789 </span> =
<span class=3D"hl str">"~@<COMPILE-FILE failed while performin=
g ~A on ~A.~@:>"</span>
-<a id=3D"l_790"></a><span class=3D"hl line"> 790 </span> =
operation c<span class=3D"hl sym">))</span>
-<a id=3D"l_791"></a><span class=3D"hl line"> 791 </span> <span c=
lass=3D"hl sym">(:</span>error <span class=3D"hl sym">(</span>error <span c=
lass=3D"hl sym">'</span>compile-failed <span class=3D"hl sym">:</span>compo=
nent c <span class=3D"hl sym">:</span>operation operation<span class=3D"hl =
sym">))</span>
-<a id=3D"l_792"></a><span class=3D"hl line"> 792 </span> <span c=
lass=3D"hl sym">(:</span>ignore nil<span class=3D"hl sym">)))</span>
-<a id=3D"l_793"></a><span class=3D"hl line"> 793 </span> <span class=
=3D"hl sym">(</span>unless output
-<a id=3D"l_794"></a><span class=3D"hl line"> 794 </span> <span cla=
ss=3D"hl sym">(</span>error <span class=3D"hl sym">'</span>compile-error <s=
pan class=3D"hl sym">:</span>component c <span class=3D"hl sym">:</span>ope=
ration operation<span class=3D"hl sym">)))))</span>
-<a id=3D"l_795"></a><span class=3D"hl line"> 795 </span>
-<a id=3D"l_796"></a><span class=3D"hl line"> 796 </span><span class=3D"hl=
sym">(</span>defmethod output-files <span class=3D"hl sym">((</span>operat=
ion compile-op<span class=3D"hl sym">) (</span>c cl-source-file<span class=
=3D"hl sym">))</span>
-<a id=3D"l_797"></a><span class=3D"hl line"> 797 </span> #-<span class=
=3D"hl sym">:</span>broken-fasl-loader <span class=3D"hl sym">(</span><span=
class=3D"hl kwa">list</span> <span class=3D"hl sym">(</span>compile-file-p=
athname <span class=3D"hl sym">(</span>component-pathname c<span class=3D"h=
l sym">)))</span>
-<a id=3D"l_798"></a><span class=3D"hl line"> 798 </span> #<span class=3D=
"hl sym">+:</span>broken-fasl-loader <span class=3D"hl sym">(</span><span c=
lass=3D"hl kwa">list</span> <span class=3D"hl sym">(</span>component-pathna=
me c<span class=3D"hl sym">)))</span>
-<a id=3D"l_799"></a><span class=3D"hl line"> 799 </span>
-<a id=3D"l_800"></a><span class=3D"hl line"> 800 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>operation c=
ompile-op<span class=3D"hl sym">) (</span>c static-file<span class=3D"hl sy=
m">))</span>
-<a id=3D"l_801"></a><span class=3D"hl line"> 801 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_802"></a><span class=3D"hl line"> 802 </span>
-<a id=3D"l_803"></a><span class=3D"hl line"> 803 </span><span class=3D"hl=
sym">(</span>defmethod output-files <span class=3D"hl sym">((</span>operat=
ion compile-op<span class=3D"hl sym">) (</span>c static-file<span class=3D"=
hl sym">))</span>
-<a id=3D"l_804"></a><span class=3D"hl line"> 804 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_805"></a><span class=3D"hl line"> 805 </span>
-<a id=3D"l_806"></a><span class=3D"hl line"> 806 </span><span class=3D"hl=
sym">(</span>defmethod input-files <span class=3D"hl sym">((</span>op comp=
ile-op<span class=3D"hl sym">) (</span>c static-file<span class=3D"hl sym">=
))</span>
-<a id=3D"l_807"></a><span class=3D"hl line"> 807 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_808"></a><span class=3D"hl line"> 808 </span>
-<a id=3D"l_809"></a><span class=3D"hl line"> 809 </span>
-<a id=3D"l_810"></a><span class=3D"hl line"> 810 </span><span class=3D"hl=
slc">;;; load-op</span>
-<a id=3D"l_811"></a><span class=3D"hl line"> 811 </span>
-<a id=3D"l_812"></a><span class=3D"hl line"> 812 </span><span class=3D"hl=
sym">(</span>defclass basic-<span class=3D"hl kwa">load</span>-op <span cl=
ass=3D"hl sym">(</span>operation<span class=3D"hl sym">) ())</span>
-<a id=3D"l_813"></a><span class=3D"hl line"> 813 </span>
-<a id=3D"l_814"></a><span class=3D"hl line"> 814 </span><span class=3D"hl=
sym">(</span>defclass <span class=3D"hl kwa">load</span>-op <span class=3D=
"hl sym">(</span>basic-<span class=3D"hl kwa">load</span>-op<span class=3D"=
hl sym">) ())</span>
-<a id=3D"l_815"></a><span class=3D"hl line"> 815 </span>
-<a id=3D"l_816"></a><span class=3D"hl line"> 816 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>o <span cla=
ss=3D"hl kwa">load</span>-op<span class=3D"hl sym">) (</span>c cl-source-fi=
le<span class=3D"hl sym">))</span>
-<a id=3D"l_817"></a><span class=3D"hl line"> 817 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">mapcar</span> #<span class=3D"hl sym=
">'</span><span class=3D"hl kwa">load</span> <span class=3D"hl sym">(</span=
>input-files o c<span class=3D"hl sym">)))</span>
-<a id=3D"l_818"></a><span class=3D"hl line"> 818 </span>
-<a id=3D"l_819"></a><span class=3D"hl line"> 819 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>operation <=
span class=3D"hl kwa">load</span>-op<span class=3D"hl sym">) (</span>c stat=
ic-file<span class=3D"hl sym">))</span>
-<a id=3D"l_820"></a><span class=3D"hl line"> 820 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_821"></a><span class=3D"hl line"> 821 </span><span class=3D"hl=
sym">(</span>defmethod operation-done-p <span class=3D"hl sym">((</span>op=
eration <span class=3D"hl kwa">load</span>-op<span class=3D"hl sym">) (</sp=
an>c static-file<span class=3D"hl sym">))</span>
-<a id=3D"l_822"></a><span class=3D"hl line"> 822 </span> t<span class=3D=
"hl sym">)</span>
-<a id=3D"l_823"></a><span class=3D"hl line"> 823 </span>
-<a id=3D"l_824"></a><span class=3D"hl line"> 824 </span><span class=3D"hl=
sym">(</span>defmethod output-files <span class=3D"hl sym">((</span>o oper=
ation<span class=3D"hl sym">) (</span>c component<span class=3D"hl sym">))<=
/span>
-<a id=3D"l_825"></a><span class=3D"hl line"> 825 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_826"></a><span class=3D"hl line"> 826 </span>
-<a id=3D"l_827"></a><span class=3D"hl line"> 827 </span><span class=3D"hl=
sym">(</span>defmethod component-depends-on <span class=3D"hl sym">((</spa=
n>operation <span class=3D"hl kwa">load</span>-op<span class=3D"hl sym">) (=
</span>c component<span class=3D"hl sym">))</span>
-<a id=3D"l_828"></a><span class=3D"hl line"> 828 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">cons</span> <span class=3D"hl sym">(=
</span><span class=3D"hl kwa">list</span> <span class=3D"hl sym">'</span>co=
mpile-op <span class=3D"hl sym">(</span>component-name c<span class=3D"hl s=
ym">))</span>
-<a id=3D"l_829"></a><span class=3D"hl line"> 829 </span> <span cla=
ss=3D"hl sym">(</span>call-next-method<span class=3D"hl sym">)))</span>
-<a id=3D"l_830"></a><span class=3D"hl line"> 830 </span>
-<a id=3D"l_831"></a><span class=3D"hl line"> 831 </span><span class=3D"hl=
slc">;;; load-source-op</span>
-<a id=3D"l_832"></a><span class=3D"hl line"> 832 </span>
-<a id=3D"l_833"></a><span class=3D"hl line"> 833 </span><span class=3D"hl=
sym">(</span>defclass <span class=3D"hl kwa">load</span>-source-op <span c=
lass=3D"hl sym">(</span>basic-<span class=3D"hl kwa">load</span>-op<span cl=
ass=3D"hl sym">) ())</span>
-<a id=3D"l_834"></a><span class=3D"hl line"> 834 </span>
-<a id=3D"l_835"></a><span class=3D"hl line"> 835 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>o <span cla=
ss=3D"hl kwa">load</span>-source-op<span class=3D"hl sym">) (</span>c cl-so=
urce-file<span class=3D"hl sym">))</span>
-<a id=3D"l_836"></a><span class=3D"hl line"> 836 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>source <span class=3D"h=
l sym">(</span>component-pathname c<span class=3D"hl sym">)))</span>
-<a id=3D"l_837"></a><span class=3D"hl line"> 837 </span> <span class=
=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>component-property =
c <span class=3D"hl sym">'</span><span class=3D"hl kwa">last</span>-loaded-=
as-source<span class=3D"hl sym">)</span>
-<a id=3D"l_838"></a><span class=3D"hl line"> 838 </span> <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">and</span> <span class=3D"hl=
sym">(</span><span class=3D"hl kwa">load</span> source<span class=3D"hl sy=
m">)</span>
-<a id=3D"l_839"></a><span class=3D"hl line"> 839 </span> <s=
pan class=3D"hl sym">(</span>get-universal-time<span class=3D"hl sym">)))))=
</span>
-<a id=3D"l_840"></a><span class=3D"hl line"> 840 </span>
-<a id=3D"l_841"></a><span class=3D"hl line"> 841 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>operation <=
span class=3D"hl kwa">load</span>-source-op<span class=3D"hl sym">) (</span=
>c static-file<span class=3D"hl sym">))</span>
-<a id=3D"l_842"></a><span class=3D"hl line"> 842 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_843"></a><span class=3D"hl line"> 843 </span>
-<a id=3D"l_844"></a><span class=3D"hl line"> 844 </span><span class=3D"hl=
sym">(</span>defmethod output-files <span class=3D"hl sym">((</span>operat=
ion <span class=3D"hl kwa">load</span>-source-op<span class=3D"hl sym">) (<=
/span>c component<span class=3D"hl sym">))</span>
-<a id=3D"l_845"></a><span class=3D"hl line"> 845 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_846"></a><span class=3D"hl line"> 846 </span>
-<a id=3D"l_847"></a><span class=3D"hl line"> 847 </span><span class=3D"hl=
slc">;;; FIXME: we simply copy load-op's dependencies. this is Just Not R=
ight.</span>
-<a id=3D"l_848"></a><span class=3D"hl line"> 848 </span><span class=3D"hl=
sym">(</span>defmethod component-depends-on <span class=3D"hl sym">((</spa=
n>o <span class=3D"hl kwa">load</span>-source-op<span class=3D"hl sym">) (<=
/span>c component<span class=3D"hl sym">))</span>
-<a id=3D"l_849"></a><span class=3D"hl line"> 849 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((</span>what-would-<span class=
=3D"hl kwa">load</span>-op-do <span class=3D"hl sym">(</span><span class=3D=
"hl kwa">cdr</span> <span class=3D"hl sym">(</span><span class=3D"hl kwa">a=
ssoc</span> <span class=3D"hl sym">'</span><span class=3D"hl kwa">load</spa=
n>-op
-<a id=3D"l_850"></a><span class=3D"hl line"> 850 </span> =
<span class=3D"hl sym">(</span>slot-value c <span=
class=3D"hl sym">'</span>in-order-to<span class=3D"hl sym">)))))</span>
-<a id=3D"l_851"></a><span class=3D"hl line"> 851 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">mapcar</span> <span class=3D"hl =
sym">(</span><span class=3D"hl kwa">lambda</span> <span class=3D"hl sym">(<=
/span>dep<span class=3D"hl sym">)</span>
-<a id=3D"l_852"></a><span class=3D"hl line"> 852 </span> <sp=
an class=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D=
"hl sym">(</span><span class=3D"hl kwa">eq</span> <span class=3D"hl sym">(<=
/span><span class=3D"hl kwa">car</span> dep<span class=3D"hl sym">) '</span=
><span class=3D"hl kwa">load</span>-op<span class=3D"hl sym">)</span>
-<a id=3D"l_853"></a><span class=3D"hl line"> 853 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">cons</span> <span cl=
ass=3D"hl sym">'</span><span class=3D"hl kwa">load</span>-source-op <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">cdr</span> dep<span class=3D=
"hl sym">))</span>
-<a id=3D"l_854"></a><span class=3D"hl line"> 854 </span> =
dep<span class=3D"hl sym">))</span>
-<a id=3D"l_855"></a><span class=3D"hl line"> 855 </span> what-=
would-<span class=3D"hl kwa">load</span>-op-do<span class=3D"hl sym">)))</s=
pan>
-<a id=3D"l_856"></a><span class=3D"hl line"> 856 </span>
-<a id=3D"l_857"></a><span class=3D"hl line"> 857 </span><span class=3D"hl=
sym">(</span>defmethod operation-done-p <span class=3D"hl sym">((</span>o =
<span class=3D"hl kwa">load</span>-source-op<span class=3D"hl sym">) (</spa=
n>c source-file<span class=3D"hl sym">))</span>
-<a id=3D"l_858"></a><span class=3D"hl line"> 858 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">if</span> <span class=3D"hl sym">(</=
span><span class=3D"hl kwa">or</span> <span class=3D"hl sym">(</span><span =
class=3D"hl kwa">not</span> <span class=3D"hl sym">(</span>component-proper=
ty c <span class=3D"hl sym">'</span><span class=3D"hl kwa">last</span>-load=
ed-as-source<span class=3D"hl sym">))</span>
-<a id=3D"l_859"></a><span class=3D"hl line"> 859 </span> <span c=
lass=3D"hl sym">(> (</span>file-write-date <span class=3D"hl sym">(</spa=
n>component-pathname c<span class=3D"hl sym">))</span>
-<a id=3D"l_860"></a><span class=3D"hl line"> 860 </span> <spa=
n class=3D"hl sym">(</span>component-property c <span class=3D"hl sym">'</s=
pan><span class=3D"hl kwa">last</span>-loaded-as-source<span class=3D"hl sy=
m">)))</span>
-<a id=3D"l_861"></a><span class=3D"hl line"> 861 </span> nil t<span =
class=3D"hl sym">))</span>
-<a id=3D"l_862"></a><span class=3D"hl line"> 862 </span>
-<a id=3D"l_863"></a><span class=3D"hl line"> 863 </span><span class=3D"hl=
sym">(</span>defclass test-op <span class=3D"hl sym">(</span>operation<spa=
n class=3D"hl sym">) ())</span>
-<a id=3D"l_864"></a><span class=3D"hl line"> 864 </span>
-<a id=3D"l_865"></a><span class=3D"hl line"> 865 </span><span class=3D"hl=
sym">(</span>defmethod perform <span class=3D"hl sym">((</span>operation t=
est-op<span class=3D"hl sym">) (</span>c component<span class=3D"hl sym">))=
</span>
-<a id=3D"l_866"></a><span class=3D"hl line"> 866 </span> nil<span class=
=3D"hl sym">)</span>
-<a id=3D"l_867"></a><span class=3D"hl line"> 867 </span>
-<a id=3D"l_868"></a><span class=3D"hl line"> 868 </span><span class=3D"hl=
sym">(</span>defgeneric <span class=3D"hl kwa">load</span>-preferences <sp=
an class=3D"hl sym">(</span>system operation<span class=3D"hl sym">)</span>
-<a id=3D"l_869"></a><span class=3D"hl line"> 869 </span> <span class=3D"=
hl sym">(:</span>documentation
-<a id=3D"l_870"></a><span class=3D"hl line"> 870 </span> <span class=3D=
"hl str">"Called to load system preferences after <perform operatio=
n</span>
-<a id=3D"l_871"></a><span class=3D"hl line"> 871 </span><span class=3D"hl=
str">system>. Typical uses are to set parameters that don't exist until=
</span>
-<a id=3D"l_872"></a><span class=3D"hl line"> 872 </span><span class=3D"hl=
str">after the system has been loaded."</span><span class=3D"hl sym">=
))</span>
-<a id=3D"l_873"></a><span class=3D"hl line"> 873 </span>
-<a id=3D"l_874"></a><span class=3D"hl line"> 874 </span><span class=3D"hl=
sym">(</span>defgeneric preference-file-for-system<span class=3D"hl sym">/=
</span>operation <span class=3D"hl sym">(</span>system operation<span class=
=3D"hl sym">)</span>
-<a id=3D"l_875"></a><span class=3D"hl line"> 875 </span> <span class=3D"=
hl sym">(:</span>documentation
-<a id=3D"l_876"></a><span class=3D"hl line"> 876 </span> <span class=3D=
"hl str">"Returns the pathname of the preference file for this system.=
</span>
-<a id=3D"l_877"></a><span class=3D"hl line"> 877 </span><span class=3D"hl=
str">Called by 'load-preferences to determine what file to load."</sp=
an><span class=3D"hl sym">))</span>
-<a id=3D"l_878"></a><span class=3D"hl line"> 878 </span>
-<a id=3D"l_879"></a><span class=3D"hl line"> 879 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl kwa">load</span>-preferences <spa=
n class=3D"hl sym">((</span>s t<span class=3D"hl sym">) (</span>operation t=
<span class=3D"hl sym">))</span>
-<a id=3D"l_880"></a><span class=3D"hl line"> 880 </span> <span class=3D"=
hl slc">;; do nothing</span>
-<a id=3D"l_881"></a><span class=3D"hl line"> 881 </span> <span class=3D"=
hl sym">(</span>values<span class=3D"hl sym">))</span>
-<a id=3D"l_882"></a><span class=3D"hl line"> 882 </span>
-<a id=3D"l_883"></a><span class=3D"hl line"> 883 </span><span class=3D"hl=
sym">(</span>defmethod <span class=3D"hl kwa">load</span>-preferences <spa=
n class=3D"hl sym">((</span>s system<span class=3D"hl sym">) (</span>operat=
ion basic-<span class=3D"hl kwa">load</span>-op<span class=3D"hl sym">))</s=
pan>
-<a id=3D"l_884"></a><span class=3D"hl line"> 884 </span> <span class=3D"=
hl sym">(</span>let<span class=3D"hl sym">* ((*</span>package<span class=3D=
"hl sym">* (</span>find-package <span class=3D"hl sym">:</span>common-lisp<=
span class=3D"hl sym">))</span>
-<a id=3D"l_885"></a><span class=3D"hl line"> 885 </span> <span cl=
ass=3D"hl sym">(</span>file <span class=3D"hl sym">(</span>probe-file <span=
class=3D"hl sym">(</span>preference-file-for-system<span class=3D"hl sym">=
/</span>operation s operation<span class=3D"hl sym">))))</span>
-<a id=3D"l_886"></a><span class=3D"hl line"> 886 </span> <span class=
=3D"hl sym">(</span>when file
-<a id=3D"l_887"></a><span class=3D"hl line"> 887 </span> <span class=
=3D"hl sym">(</span>when <span class=3D"hl sym">*</span>verbose-out<span cl=
ass=3D"hl sym">*</span>
-<a id=3D"l_888"></a><span class=3D"hl line"> 888 </span> <span cla=
ss=3D"hl sym">(</span>format <span class=3D"hl sym">*</span>verbose-out<spa=
n class=3D"hl sym">*</span>
-<a id=3D"l_889"></a><span class=3D"hl line"> 889 </span> <=
span class=3D"hl str">"~&~@<; ~@;loading preferences fo=
r ~A/~(~A~) from ~A~@:>~%"</span>
-<a id=3D"l_890"></a><span class=3D"hl line"> 890 </span> <=
span class=3D"hl sym">(</span>component-name s<span class=3D"hl sym">)</spa=
n>
-<a id=3D"l_891"></a><span class=3D"hl line"> 891 </span> <=
span class=3D"hl sym">(</span><span class=3D"hl kwa">type</span>-of operati=
on<span class=3D"hl sym">)</span> file<span class=3D"hl sym">))</span>
-<a id=3D"l_892"></a><span class=3D"hl line"> 892 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">load</span> file<span class=3D"h=
l sym">))))</span>
-<a id=3D"l_893"></a><span class=3D"hl line"> 893 </span>
-<a id=3D"l_894"></a><span class=3D"hl line"> 894 </span><span class=3D"hl=
sym">(</span>defmethod preference-file-for-system<span class=3D"hl sym">/<=
/span>operation <span class=3D"hl sym">((</span>system t<span class=3D"hl s=
ym">) (</span>operation t<span class=3D"hl sym">))</span>
-<a id=3D"l_895"></a><span class=3D"hl line"> 895 </span> <span class=3D"=
hl slc">;; cope with anything other than systems</span>
-<a id=3D"l_896"></a><span class=3D"hl line"> 896 </span> <span class=3D"=
hl sym">(</span>preference-file-for-system<span class=3D"hl sym">/</span>op=
eration <span class=3D"hl sym">(</span>find-system system t<span class=3D"h=
l sym">)</span> operation<span class=3D"hl sym">))</span>
-<a id=3D"l_897"></a><span class=3D"hl line"> 897 </span>
-<a id=3D"l_898"></a><span class=3D"hl line"> 898 </span><span class=3D"hl=
sym">(</span>defmethod preference-file-for-system<span class=3D"hl sym">/<=
/span>operation <span class=3D"hl sym">((</span>s system<span class=3D"hl s=
ym">) (</span>operation t<span class=3D"hl sym">))</span>
-<a id=3D"l_899"></a><span class=3D"hl line"> 899 </span> <span class=3D"=
hl sym">(</span>let <span class=3D"hl sym">((*</span>default-pathname-defau=
lts<span class=3D"hl sym">*</span>
-<a id=3D"l_900"></a><span class=3D"hl line"> 900 </span> <span cl=
ass=3D"hl sym">(</span>make-pathname <span class=3D"hl sym">:</span>name ni=
l <span class=3D"hl sym">:</span><span class=3D"hl kwa">type</span> nil
-<a id=3D"l_901"></a><span class=3D"hl line"> 901 </span> =
<span class=3D"hl sym">:</span>defaults <span class=3D"hl sym">*</sp=
an>default-pathname-defaults<span class=3D"hl sym">*)))</span>
-<a id=3D"l_902"></a><span class=3D"hl line"> 902 </span> <span class=
=3D"hl sym">(</span>merge-pathnames
-<a id=3D"l_903"></a><span class=3D"hl line"> 903 </span> <span class=
=3D"hl sym">(</span>make-pathname <span class=3D"hl sym">:</span>name <span=
class=3D"hl sym">(</span>component-name s<span class=3D"hl sym">)</span>
-<a id=3D"l_904"></a><span class=3D"hl line"> 904 </span> =
<span class=3D"hl sym">:</span><span class=3D"hl kwa">type</span> <span=
class=3D"hl str">"lisp"</span>
-<a id=3D"l_905"></a><span class=3D"hl line"> 905 </span> =
<span class=3D"hl sym">:</span>directory <span class=3D"hl sym">'(:</sp=
an>relative <span class=3D"hl str">".asdf"</span><span class=3D"h=
l sym">))</span>
-<a id=3D"l_906"></a><span class=3D"hl line"> 906 </span> <span class=
=3D"hl sym">(</span>truename <span class=3D"hl sym">(</span>user-homedir-pa=
thname<span class=3D"hl sym">)))))</span>
-<a id=3D"l_907"></a><span class=3D"hl line"> 907 </span>
-<a id=3D"l_908"></a><span class=3D"hl line"> 908 </span><span class=3D"hl=
slc">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</span>
-<a id=3D"l_909"></a><span class=3D"hl line"> 909 </span><span class=3D"hl=
slc">;;; invoking operations</span>
-<a id=3D"l_910"></a><span class=3D"hl line"> 910 </span>
-<a id=3D"l_911"></a><span class=3D"hl line"> 911 </span><span class=3D"hl=
sym">(</span>defvar <span class=3D"hl sym">*</span>operate-docstring<span =
class=3D"hl sym">*</span>
-<a id=3D"l_912"></a><span class=3D"hl line"> 912 </span> <span class=3D"=
hl str">"Operate does three things:</span>
-<a id=3D"l_913"></a><span class=3D"hl line"> 913 </span><span class=3D"hl=
str"></span>
-<a id=3D"l_914"></a><span class=3D"hl line"> 914 </span><span class=3D"hl=
str">1. It creates an instance of `operation-class` using any keyword para=
meters</span>
-<a id=3D"l_915"></a><span class=3D"hl line"> 915 </span><span class=3D"hl=
str">as initargs.</span>
-<a id=3D"l_916"></a><span class=3D"hl line"> 916 </span><span class=3D"hl=
str">2. It finds the asdf-system specified by `system` (possibly loading<=
/span>
-<a id=3D"l_917"></a><span class=3D"hl line"> 917 </span><span class=3D"hl=
str">it from disk).</span>
-<a id=3D"l_918"></a><span class=3D"hl line"> 918 </span><span class=3D"hl=
str">3. It then calls `traverse` with the operation and system as argument=
s</span>
-<a id=3D"l_919"></a><span class=3D"hl line"> 919 </span><span class=3D"hl=
str"></span>
-<a id=3D"l_920"></a><span class=3D"hl line"> 920 </span><span class=3D"hl=
str">The traverse operation is wrapped in `with-compilation-unit` and erro=
r</span>
-<a id=3D"l_921"></a><span class=3D"hl line"> 921 </span><span class=3D"hl=
str">handling code. If a `version` argument is supplied, then operate also=
</span>
-<a id=3D"l_922"></a><span class=3D"hl line"> 922 </span><span class=3D"hl=
str">ensures that the system found satisfies it using the `version-satisfi=
es`</span>
-<a id=3D"l_923"></a><span class=3D"hl line"> 923 </span><span class=3D"hl=
str">method."</span><span class=3D"hl sym">)</span>
-<a id=3D"l_924"></a><span class=3D"hl line"> 924 </span>
-<a id=3D"l_925"></a><span class=3D"hl line"> 925 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> operate <span class=3D"hl=
sym">(</span>operation-class system <span class=3D"hl sym">&</span>res=
t args <span class=3D"hl sym">&</span>key <span class=3D"hl sym">(</spa=
n>verbose t<span class=3D"hl sym">)</span> version
-<a id=3D"l_926"></a><span class=3D"hl line"> 926 </span> <=
span class=3D"hl sym">&</span>allow-other-keys<span class=3D"hl sym">)<=
/span>
-<a id=3D"l_927"></a><span class=3D"hl line"> 927 </span> <span class=3D"=
hl sym">(</span>let<span class=3D"hl sym">* ((</span>op <span class=3D"hl s=
ym">(</span><span class=3D"hl kwa">apply</span> #<span class=3D"hl sym">'</=
span>make-instance operation-class
-<a id=3D"l_928"></a><span class=3D"hl line"> 928 </span> =
<span class=3D"hl sym">:</span>original-initargs args
-<a id=3D"l_929"></a><span class=3D"hl line"> 929 </span> =
args<span class=3D"hl sym">))</span>
-<a id=3D"l_930"></a><span class=3D"hl line"> 930 </span> <span cl=
ass=3D"hl sym">(*</span>verbose-out<span class=3D"hl sym">* (</span><span c=
lass=3D"hl kwa">if</span> verbose <span class=3D"hl sym">*</span>standard-o=
utput<span class=3D"hl sym">* (</span>make-broadcast-stream<span class=3D"h=
l sym">)))</span>
-<a id=3D"l_931"></a><span class=3D"hl line"> 931 </span> <span cl=
ass=3D"hl sym">(</span>system <span class=3D"hl sym">(</span><span class=3D=
"hl kwa">if</span> <span class=3D"hl sym">(</span>typep system <span class=
=3D"hl sym">'</span>component<span class=3D"hl sym">)</span> system <span c=
lass=3D"hl sym">(</span>find-system system<span class=3D"hl sym">))))</span>
-<a id=3D"l_932"></a><span class=3D"hl line"> 932 </span> <span class=
=3D"hl sym">(</span>unless <span class=3D"hl sym">(</span>version-satisfies=
system version<span class=3D"hl sym">)</span>
-<a id=3D"l_933"></a><span class=3D"hl line"> 933 </span> <span class=
=3D"hl sym">(</span>error <span class=3D"hl sym">'</span>missing-component =
<span class=3D"hl sym">:</span>requires system <span class=3D"hl sym">:</sp=
an>version version<span class=3D"hl sym">))</span>
-<a id=3D"l_934"></a><span class=3D"hl line"> 934 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>steps <span class=
=3D"hl sym">(</span>traverse op system<span class=3D"hl sym">)))</span>
-<a id=3D"l_935"></a><span class=3D"hl line"> 935 </span> <span class=
=3D"hl sym">(</span>with-compilation-unit <span class=3D"hl sym">()</span>
-<a id=3D"l_936"></a><span class=3D"hl line"> 936 </span> <span cla=
ss=3D"hl sym">(</span>loop for <span class=3D"hl sym">(</span>op . componen=
t<span class=3D"hl sym">)</span> in steps do
-<a id=3D"l_937"></a><span class=3D"hl line"> 937 </span> =
<span class=3D"hl sym">(</span>loop
-<a id=3D"l_938"></a><span class=3D"hl line"> 938 </span> =
<span class=3D"hl sym">(</span>restart-case
-<a id=3D"l_939"></a><span class=3D"hl line"> 939 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">progn</span> <s=
pan class=3D"hl sym">(</span>perform op component<span class=3D"hl sym">)</=
span>
-<a id=3D"l_940"></a><span class=3D"hl line"> 940 </span> =
<span class=3D"hl sym">(</span>return<span class=3D"hl sym">))=
</span>
-<a id=3D"l_941"></a><span class=3D"hl line"> 941 </span> =
<span class=3D"hl sym">(</span>retry <span class=3D"hl sym">()</span>
-<a id=3D"l_942"></a><span class=3D"hl line"> 942 </span> =
<span class=3D"hl sym">:</span>report
-<a id=3D"l_943"></a><span class=3D"hl line"> 943 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">lambda</span> <=
span class=3D"hl sym">(</span>s<span class=3D"hl sym">)</span>
-<a id=3D"l_944"></a><span class=3D"hl line"> 944 </span> =
<span class=3D"hl sym">(</span>format s <span class=3D"hl str">&quo=
t;~@<Retry performing ~S on ~S.~@:>"</span>
-<a id=3D"l_945"></a><span class=3D"hl line"> 945 </span> =
op component<span class=3D"hl sym">)))</span>
-<a id=3D"l_946"></a><span class=3D"hl line"> 946 </span> =
<span class=3D"hl sym">(</span>accept <span class=3D"hl sym">()</span>
-<a id=3D"l_947"></a><span class=3D"hl line"> 947 </span> =
<span class=3D"hl sym">:</span>report
-<a id=3D"l_948"></a><span class=3D"hl line"> 948 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">lambda</span> <=
span class=3D"hl sym">(</span>s<span class=3D"hl sym">)</span>
-<a id=3D"l_949"></a><span class=3D"hl line"> 949 </span> =
<span class=3D"hl sym">(</span>format s <span class=3D"hl str">&quo=
t;~@<Continue, treating ~S on ~S as ~</span>
-<a id=3D"l_950"></a><span class=3D"hl line"> 950 </span><span class=3D"hl=
str"> having been successful.~@:>=
"</span>
-<a id=3D"l_951"></a><span class=3D"hl line"> 951 </span> =
op component<span class=3D"hl sym">))</span>
-<a id=3D"l_952"></a><span class=3D"hl line"> 952 </span> =
<span class=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>ge=
thash <span class=3D"hl sym">(</span><span class=3D"hl kwa">type</span>-of =
op<span class=3D"hl sym">)</span>
-<a id=3D"l_953"></a><span class=3D"hl line"> 953 </span> =
<span class=3D"hl sym">(</span>component-operation-tim=
es component<span class=3D"hl sym">))</span>
-<a id=3D"l_954"></a><span class=3D"hl line"> 954 </span> =
<span class=3D"hl sym">(</span>get-universal-time<span class=3D=
"hl sym">))</span>
-<a id=3D"l_955"></a><span class=3D"hl line"> 955 </span> =
<span class=3D"hl sym">(</span>return<span class=3D"hl sym">)))))))))=
</span>
-<a id=3D"l_956"></a><span class=3D"hl line"> 956 </span>
-<a id=3D"l_957"></a><span class=3D"hl line"> 957 </span><span class=3D"hl=
sym">(</span>setf <span class=3D"hl sym">(</span>documentation <span class=
=3D"hl sym">'</span>operate <span class=3D"hl sym">'</span>function<span cl=
ass=3D"hl sym">)</span>
-<a id=3D"l_958"></a><span class=3D"hl line"> 958 </span> <span class=
=3D"hl sym">*</span>operate-docstring<span class=3D"hl sym">*)</span>
-<a id=3D"l_959"></a><span class=3D"hl line"> 959 </span>
-<a id=3D"l_960"></a><span class=3D"hl line"> 960 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> oos <span class=3D"hl sym=
">(</span>operation-class system <span class=3D"hl sym">&</span>rest ar=
gs <span class=3D"hl sym">&</span>key force <span class=3D"hl sym">(</s=
pan>verbose t<span class=3D"hl sym">)</span> version<span class=3D"hl sym">=
)</span>
-<a id=3D"l_961"></a><span class=3D"hl line"> 961 </span> <span class=3D"=
hl sym">(</span>declare <span class=3D"hl sym">(</span>ignore force verbose=
version<span class=3D"hl sym">))</span>
-<a id=3D"l_962"></a><span class=3D"hl line"> 962 </span> <span class=3D"=
hl sym">(</span><span class=3D"hl kwa">apply</span> #<span class=3D"hl sym"=
>'</span>operate operation-class system args<span class=3D"hl sym">))</span>
-<a id=3D"l_963"></a><span class=3D"hl line"> 963 </span>
-<a id=3D"l_964"></a><span class=3D"hl line"> 964 </span><span class=3D"hl=
sym">(</span>setf <span class=3D"hl sym">(</span>documentation <span class=
=3D"hl sym">'</span>oos <span class=3D"hl sym">'</span>function<span class=
=3D"hl sym">)</span>
-<a id=3D"l_965"></a><span class=3D"hl line"> 965 </span> <span class=
=3D"hl sym">(</span>format nil
-<a id=3D"l_966"></a><span class=3D"hl line"> 966 </span> <sp=
an class=3D"hl str">"Short for _operate on system_ and an alias for th=
e `operate` function. ~&~&~a"</span>
-<a id=3D"l_967"></a><span class=3D"hl line"> 967 </span> <sp=
an class=3D"hl sym">*</span>operate-docstring<span class=3D"hl sym">*))</sp=
an>
-<a id=3D"l_968"></a><span class=3D"hl line"> 968 </span>
-<a id=3D"l_969"></a><span class=3D"hl line"> 969 </span><span class=3D"hl=
slc">;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;</span>
-<a id=3D"l_970"></a><span class=3D"hl line"> 970 </span><span class=3D"hl=
slc">;;; syntax</span>
-<a id=3D"l_971"></a><span class=3D"hl line"> 971 </span>
-<a id=3D"l_972"></a><span class=3D"hl line"> 972 </span><span class=3D"hl=
sym">(</span><span class=3D"hl kwa">defun</span> remove-keyword <span clas=
s=3D"hl sym">(</span>key arglist<span class=3D"hl sym">)</span>
-<a id=3D"l_973"></a><span class=3D"hl line"> 973 </span> <span class=3D"=
hl sym">(</span>labels <span class=3D"hl sym">((</span>aux <span class=3D"h=
l sym">(</span>key arglist<span class=3D"hl sym">)</span>
-<a id=3D"l_974"></a><span class=3D"hl line"> 974 </span> <spa=
n class=3D"hl sym">(</span><span class=3D"hl kwa">cond</span> <span class=
=3D"hl sym">((</span><span class=3D"hl kwa">null</span> arglist<span class=
=3D"hl sym">)</span> nil<span class=3D"hl sym">)</span>
-<a id=3D"l_975"></a><span class=3D"hl line"> 975 </span> =
<span class=3D"hl sym">((</span><span class=3D"hl kwa">eq</span> key <spa=
n class=3D"hl sym">(</span><span class=3D"hl kwa">car</span> arglist<span c=
lass=3D"hl sym">)) (</span><span class=3D"hl kwa">cddr</span> arglist<span =
class=3D"hl sym">))</span>
-<a id=3D"l_976"></a><span class=3D"hl line"> 976 </span> =
<span class=3D"hl sym">(</span>t <span class=3D"hl sym">(</span><span cla=
ss=3D"hl kwa">cons</span> <span class=3D"hl sym">(</span><span class=3D"hl =
kwa">car</span> arglist<span class=3D"hl sym">) (</span><span class=3D"hl k=
wa">cons</span> <span class=3D"hl sym">(</span><span class=3D"hl kwa">cadr<=
/span> arglist<span class=3D"hl sym">)</span>
-<a id=3D"l_977"></a><span class=3D"hl line"> 977 </span> =
<span class=3D"hl sym">(</span>remove-keyword
-<a id=3D"l_978"></a><span class=3D"hl line"> 978 </span> =
key <span class=3D"hl sym">(</span><span cl=
ass=3D"hl kwa">cddr</span> arglist<span class=3D"hl sym">))))))))</span>
-<a id=3D"l_979"></a><span class=3D"hl line"> 979 </span> <span class=
=3D"hl sym">(</span>aux key arglist<span class=3D"hl sym">)))</span>
-<a id=3D"l_980"></a><span class=3D"hl line"> 980 </span>
-<a id=3D"l_981"></a><span class=3D"hl line"> 981 </span><span class=3D"hl=
sym">(</span>defmacro defsystem <span class=3D"hl sym">(</span>name <span =
class=3D"hl sym">&</span>body options<span class=3D"hl sym">)</span>
-<a id=3D"l_982"></a><span class=3D"hl line"> 982 </span> <span class=3D"=
hl sym">(</span>destructuring-bind <span class=3D"hl sym">(&</span>key =
<span class=3D"hl sym">(</span>pathname nil pathname-arg-p<span class=3D"hl=
sym">) (</span>class <span class=3D"hl sym">'</span>system<span class=3D"h=
l sym">)</span>
-<a id=3D"l_983"></a><span class=3D"hl line"> 983 </span> =
<span class=3D"hl sym">&</span>allow-other-keys<span class=
=3D"hl sym">)</span>
-<a id=3D"l_984"></a><span class=3D"hl line"> 984 </span> options
-<a id=3D"l_985"></a><span class=3D"hl line"> 985 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>component-options <=
span class=3D"hl sym">(</span>remove-keyword <span class=3D"hl sym">:</span=
>class options<span class=3D"hl sym">)))</span>
-<a id=3D"l_986"></a><span class=3D"hl line"> 986 </span> `<span clas=
s=3D"hl sym">(</span><span class=3D"hl kwa">progn</span>
-<a id=3D"l_987"></a><span class=3D"hl line"> 987 </span> <span cl=
ass=3D"hl slc">;; system must be registered before we parse the body, other=
wise</span>
-<a id=3D"l_988"></a><span class=3D"hl line"> 988 </span> <span cl=
ass=3D"hl slc">;; we recur when trying to find an existing system of the sa=
me name</span>
-<a id=3D"l_989"></a><span class=3D"hl line"> 989 </span> <span cl=
ass=3D"hl slc">;; to reuse options (e.g. pathname) from</span>
-<a id=3D"l_990"></a><span class=3D"hl line"> 990 </span> <span cl=
ass=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>s <span class=3D=
"hl sym">(</span>system-registered-p <span class=3D"hl sym">',</span>name<s=
pan class=3D"hl sym">)))</span>
-<a id=3D"l_991"></a><span class=3D"hl line"> 991 </span> <span =
class=3D"hl sym">(</span><span class=3D"hl kwa">cond</span> <span class=3D"=
hl sym">((</span><span class=3D"hl kwa">and</span> s <span class=3D"hl sym"=
>(</span><span class=3D"hl kwa">eq</span> <span class=3D"hl sym">(</span><s=
pan class=3D"hl kwa">type</span>-of <span class=3D"hl sym">(</span><span cl=
ass=3D"hl kwa">cdr</span> s<span class=3D"hl sym">)) ',</span>class<span cl=
ass=3D"hl sym">))</span>
-<a id=3D"l_992"></a><span class=3D"hl line"> 992 </span> =
<span class=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span><span c=
lass=3D"hl kwa">car</span> s<span class=3D"hl sym">) (</span>get-universal-=
time<span class=3D"hl sym">)))</span>
-<a id=3D"l_993"></a><span class=3D"hl line"> 993 </span> =
<span class=3D"hl sym">(</span>s
-<a id=3D"l_994"></a><span class=3D"hl line"> 994 </span> =
#<span class=3D"hl sym">+</span>clisp
-<a id=3D"l_995"></a><span class=3D"hl line"> 995 </span> =
<span class=3D"hl sym">(</span>sysdef-error <span class=3D"hl str">"C=
annot redefine the existing system ~A with a different class"</span> s=
<span class=3D"hl sym">)</span>
-<a id=3D"l_996"></a><span class=3D"hl line"> 996 </span> =
#-clisp
-<a id=3D"l_997"></a><span class=3D"hl line"> 997 </span> =
<span class=3D"hl sym">(</span>change-class <span class=3D"hl sym">(</span=
><span class=3D"hl kwa">cdr</span> s<span class=3D"hl sym">) ',</span>class=
<span class=3D"hl sym">))</span>
-<a id=3D"l_998"></a><span class=3D"hl line"> 998 </span> =
<span class=3D"hl sym">(</span>t
-<a id=3D"l_999"></a><span class=3D"hl line"> 999 </span> =
<span class=3D"hl sym">(</span>register-system <span class=3D"hl sym">(</s=
pan><span class=3D"hl kwa">quote</span> <span class=3D"hl sym">,</span>name=
<span class=3D"hl sym">)</span>
-<a id=3D"l_1000"></a><span class=3D"hl line"> 1000 </span> =
<span class=3D"hl sym">(</span>make-instance <span class=
=3D"hl sym">',</span>class <span class=3D"hl sym">:</span>name <span class=
=3D"hl sym">',</span>name<span class=3D"hl sym">)))))</span>
-<a id=3D"l_1001"></a><span class=3D"hl line"> 1001 </span> <span c=
lass=3D"hl sym">(</span>parse-component-form nil <span class=3D"hl sym">(</=
span><span class=3D"hl kwa">apply</span>
-<a id=3D"l_1002"></a><span class=3D"hl line"> 1002 </span> =
#<span class=3D"hl sym">'</span><span class=3D"hl kwa">=
list</span>
-<a id=3D"l_1003"></a><span class=3D"hl line"> 1003 </span> =
<span class=3D"hl sym">:</span>module <span class=3D"hl=
sym">(</span>coerce-name <span class=3D"hl sym">',</span>name<span class=
=3D"hl sym">)</span>
-<a id=3D"l_1004"></a><span class=3D"hl line"> 1004 </span> =
<span class=3D"hl sym">:</span>pathname
-<a id=3D"l_1005"></a><span class=3D"hl line"> 1005 </span> =
<span class=3D"hl slc">;; to avoid a note about unreach=
able code</span>
-<a id=3D"l_1006"></a><span class=3D"hl line"> 1006 </span> =
<span class=3D"hl sym">,(</span><span class=3D"hl kwa">=
if</span> pathname-arg-p
-<a id=3D"l_1007"></a><span class=3D"hl line"> 1007 </span> =
pathname
-<a id=3D"l_1008"></a><span class=3D"hl line"> 1008 </span> =
`<span class=3D"hl sym">(</span><span class=3D"hl =
kwa">or</span> <span class=3D"hl sym">(</span>when <span class=3D"hl sym">*=
</span><span class=3D"hl kwa">load</span>-truename<span class=3D"hl sym">*<=
/span>
-<a id=3D"l_1009"></a><span class=3D"hl line"> 1009 </span> =
<span class=3D"hl sym">(</span>pathname-san=
s-name<span class=3D"hl sym">+</span><span class=3D"hl kwa">type</span>
-<a id=3D"l_1010"></a><span class=3D"hl line"> 1010 </span> =
<span class=3D"hl sym">(</span>resolve-sym=
links
-<a id=3D"l_1011"></a><span class=3D"hl line"> 1011 </span> =
<span class=3D"hl sym">*</span><span clas=
s=3D"hl kwa">load</span>-truename<span class=3D"hl sym">*)))</span>
-<a id=3D"l_1012"></a><span class=3D"hl line"> 1012 </span> =
<span class=3D"hl sym">*</span>default-pathna=
me-defaults<span class=3D"hl sym">*))</span>
-<a id=3D"l_1013"></a><span class=3D"hl line"> 1013 </span> =
<span class=3D"hl sym">',</span>component-options<span =
class=3D"hl sym">))))))</span>
-<a id=3D"l_1014"></a><span class=3D"hl line"> 1014 </span>
-<a id=3D"l_1015"></a><span class=3D"hl line"> 1015 </span>
-<a id=3D"l_1016"></a><span class=3D"hl line"> 1016 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> class-for-<span class=3D=
"hl kwa">type</span> <span class=3D"hl sym">(</span>parent <span class=3D"h=
l kwa">type</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1017"></a><span class=3D"hl line"> 1017 </span> <span class=3D=
"hl sym">(</span>let<span class=3D"hl sym">* ((</span>extra-symbols <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">list</span> <span class=3D"h=
l sym">(</span>find-symbol <span class=3D"hl sym">(</span>symbol-name <span=
class=3D"hl kwa">type</span><span class=3D"hl sym">) *</span>package<span =
class=3D"hl sym">*)</span>
-<a id=3D"l_1018"></a><span class=3D"hl line"> 1018 </span> =
<span class=3D"hl sym">(</span>find-symbol <span class=3D"hl =
sym">(</span>symbol-name <span class=3D"hl kwa">type</span><span class=3D"h=
l sym">)</span>
-<a id=3D"l_1019"></a><span class=3D"hl line"> 1019 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl=
kwa">load</span>-time-value
-<a id=3D"l_1020"></a><span class=3D"hl line"> 1020 </span> =
<span class=3D"hl sym">(</span>package-name <sp=
an class=3D"hl sym">:</span>asdf<span class=3D"hl sym">)))))</span>
-<a id=3D"l_1021"></a><span class=3D"hl line"> 1021 </span> <span c=
lass=3D"hl sym">(</span>class <span class=3D"hl sym">(</span>dolist <span c=
lass=3D"hl sym">(</span>symbol <span class=3D"hl sym">(</span><span class=
=3D"hl kwa">if</span> <span class=3D"hl sym">(</span>keywordp <span class=
=3D"hl kwa">type</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1022"></a><span class=3D"hl line"> 1022 </span> =
extra-symbols
-<a id=3D"l_1023"></a><span class=3D"hl line"> 1023 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">c=
ons type</span> extra-symbols<span class=3D"hl sym">)))</span>
-<a id=3D"l_1024"></a><span class=3D"hl line"> 1024 </span> =
<span class=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span =
class=3D"hl kwa">and</span> symbol
-<a id=3D"l_1025"></a><span class=3D"hl line"> 1025 </span> =
<span class=3D"hl sym">(</span>find-class symbol nil<span clas=
s=3D"hl sym">)</span>
-<a id=3D"l_1026"></a><span class=3D"hl line"> 1026 </span> =
<span class=3D"hl sym">(</span>subtypep symbol <span class=3D"=
hl sym">'</span>component<span class=3D"hl sym">))</span>
-<a id=3D"l_1027"></a><span class=3D"hl line"> 1027 </span> =
<span class=3D"hl sym">(</span>return <span class=3D"hl sym">(</span>fi=
nd-class symbol<span class=3D"hl sym">))))))</span>
-<a id=3D"l_1028"></a><span class=3D"hl line"> 1028 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">or</span> class
-<a id=3D"l_1029"></a><span class=3D"hl line"> 1029 </span> <span cl=
ass=3D"hl sym">(</span><span class=3D"hl kwa">and</span> <span class=3D"hl =
sym">(</span><span class=3D"hl kwa">eq type</span> <span class=3D"hl sym">:=
</span>file<span class=3D"hl sym">)</span>
-<a id=3D"l_1030"></a><span class=3D"hl line"> 1030 </span> <sp=
an class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> <span class=3D=
"hl sym">(</span>module-default-component-class parent<span class=3D"hl sym=
">)</span>
-<a id=3D"l_1031"></a><span class=3D"hl line"> 1031 </span> =
<span class=3D"hl sym">(</span>find-class <span class=3D"hl sym">'</span>c=
l-source-file<span class=3D"hl sym">)))</span>
-<a id=3D"l_1032"></a><span class=3D"hl line"> 1032 </span> <span cl=
ass=3D"hl sym">(</span>sysdef-error <span class=3D"hl str">"~@<=
don't recognize component type ~A~@:>"</span> <span class=3D"hl=
kwa">type</span><span class=3D"hl sym">))))</span>
-<a id=3D"l_1033"></a><span class=3D"hl line"> 1033 </span>
-<a id=3D"l_1034"></a><span class=3D"hl line"> 1034 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> maybe-add-tree <span cla=
ss=3D"hl sym">(</span>tree op1 op2 c<span class=3D"hl sym">)</span>
-<a id=3D"l_1035"></a><span class=3D"hl line"> 1035 </span> <span class=3D=
"hl str">"Add the node C at /OP1/OP2 in TREE, unless it's there alread=
y.</span>
-<a id=3D"l_1036"></a><span class=3D"hl line"> 1036 </span><span class=3D"h=
l str">Returns the new tree (which probably shares structure with the old o=
ne)"</span>
-<a id=3D"l_1037"></a><span class=3D"hl line"> 1037 </span> <span class=3D=
"hl sym">(</span>let <span class=3D"hl sym">((</span>first-op-tree <span cl=
ass=3D"hl sym">(</span><span class=3D"hl kwa">assoc</span> op1 tree<span cl=
ass=3D"hl sym">)))</span>
-<a id=3D"l_1038"></a><span class=3D"hl line"> 1038 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">if</span> first-op-tree
-<a id=3D"l_1039"></a><span class=3D"hl line"> 1039 </span> <span cl=
ass=3D"hl sym">(</span><span class=3D"hl kwa">progn</span>
-<a id=3D"l_1040"></a><span class=3D"hl line"> 1040 </span> <span =
class=3D"hl sym">(</span>aif <span class=3D"hl sym">(</span><span class=3D"=
hl kwa">assoc</span> op2 <span class=3D"hl sym">(</span><span class=3D"hl k=
wa">cdr</span> first-op-tree<span class=3D"hl sym">))</span>
-<a id=3D"l_1041"></a><span class=3D"hl line"> 1041 </span> <=
span class=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=
=3D"hl sym">(</span>find c <span class=3D"hl sym">(</span><span class=3D"hl=
kwa">cdr</span> it<span class=3D"hl sym">))</span>
-<a id=3D"l_1042"></a><span class=3D"hl line"> 1042 </span> =
nil
-<a id=3D"l_1043"></a><span class=3D"hl line"> 1043 </span> =
<span class=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span><span=
class=3D"hl kwa">cdr</span> it<span class=3D"hl sym">) (</span><span class=
=3D"hl kwa">cons</span> c <span class=3D"hl sym">(</span><span class=3D"hl =
kwa">cdr</span> it<span class=3D"hl sym">))))</span>
-<a id=3D"l_1044"></a><span class=3D"hl line"> 1044 </span> <=
span class=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span><span cla=
ss=3D"hl kwa">cdr</span> first-op-tree<span class=3D"hl sym">)</span>
-<a id=3D"l_1045"></a><span class=3D"hl line"> 1045 </span> =
<span class=3D"hl sym">(</span>acons op2 <span class=3D"hl sym">(</spa=
n><span class=3D"hl kwa">list</span> c<span class=3D"hl sym">) (</span><spa=
n class=3D"hl kwa">cdr</span> first-op-tree<span class=3D"hl sym">))))</spa=
n>
-<a id=3D"l_1046"></a><span class=3D"hl line"> 1046 </span> tree<s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_1047"></a><span class=3D"hl line"> 1047 </span> <span cl=
ass=3D"hl sym">(</span>acons op1 <span class=3D"hl sym">(</span><span class=
=3D"hl kwa">list</span> <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">list</span> op2 c<span class=3D"hl sym">))</span> tree<span class=3D"hl =
sym">))))</span>
-<a id=3D"l_1048"></a><span class=3D"hl line"> 1048 </span>
-<a id=3D"l_1049"></a><span class=3D"hl line"> 1049 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> union-of-dependencies <s=
pan class=3D"hl sym">(&</span>rest deps<span class=3D"hl sym">)</span>
-<a id=3D"l_1050"></a><span class=3D"hl line"> 1050 </span> <span class=3D=
"hl sym">(</span>let <span class=3D"hl sym">((</span>new-tree nil<span clas=
s=3D"hl sym">))</span>
-<a id=3D"l_1051"></a><span class=3D"hl line"> 1051 </span> <span class=
=3D"hl sym">(</span>dolist <span class=3D"hl sym">(</span>dep deps<span cla=
ss=3D"hl sym">)</span>
-<a id=3D"l_1052"></a><span class=3D"hl line"> 1052 </span> <span clas=
s=3D"hl sym">(</span>dolist <span class=3D"hl sym">(</span>op-tree dep<span=
class=3D"hl sym">)</span>
-<a id=3D"l_1053"></a><span class=3D"hl line"> 1053 </span> <span cl=
ass=3D"hl sym">(</span>dolist <span class=3D"hl sym">(</span>op <span clas=
s=3D"hl sym">(</span><span class=3D"hl kwa">cdr</span> op-tree<span class=
=3D"hl sym">))</span>
-<a id=3D"l_1054"></a><span class=3D"hl line"> 1054 </span> <span =
class=3D"hl sym">(</span>dolist <span class=3D"hl sym">(</span>c <span clas=
s=3D"hl sym">(</span><span class=3D"hl kwa">cdr</span> op<span class=3D"hl =
sym">))</span>
-<a id=3D"l_1055"></a><span class=3D"hl line"> 1055 </span> <spa=
n class=3D"hl sym">(</span>setf new-tree
-<a id=3D"l_1056"></a><span class=3D"hl line"> 1056 </span> =
<span class=3D"hl sym">(</span>maybe-add-tree new-tree <span class=3D"hl =
sym">(</span><span class=3D"hl kwa">car</span> op-tree<span class=3D"hl sym=
">) (</span><span class=3D"hl kwa">car</span> op<span class=3D"hl sym">)</s=
pan> c<span class=3D"hl sym">))))))</span>
-<a id=3D"l_1057"></a><span class=3D"hl line"> 1057 </span> new-tree<spa=
n class=3D"hl sym">))</span>
-<a id=3D"l_1058"></a><span class=3D"hl line"> 1058 </span>
-<a id=3D"l_1059"></a><span class=3D"hl line"> 1059 </span>
-<a id=3D"l_1060"></a><span class=3D"hl line"> 1060 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> remove-keys <span class=
=3D"hl sym">(</span>key-names args<span class=3D"hl sym">)</span>
-<a id=3D"l_1061"></a><span class=3D"hl line"> 1061 </span> <span class=3D=
"hl sym">(</span>loop for <span class=3D"hl sym">(</span> name val <span cl=
ass=3D"hl sym">)</span> on args by #<span class=3D"hl sym">'</span><span cl=
ass=3D"hl kwa">cddr</span>
-<a id=3D"l_1062"></a><span class=3D"hl line"> 1062 </span> unless <=
span class=3D"hl sym">(</span><span class=3D"hl kwa">member</span> <span cl=
ass=3D"hl sym">(</span>symbol-name name<span class=3D"hl sym">)</span> key-=
names
-<a id=3D"l_1063"></a><span class=3D"hl line"> 1063 </span> =
<span class=3D"hl sym">:</span>key #<span class=3D"hl sym">'</span>s=
ymbol-name <span class=3D"hl sym">:</span>test <span class=3D"hl sym">'</sp=
an><span class=3D"hl kwa">equal</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1064"></a><span class=3D"hl line"> 1064 </span> <span cl=
ass=3D"hl kwa">append</span> <span class=3D"hl sym">(</span><span class=3D"=
hl kwa">list</span> name val<span class=3D"hl sym">)))</span>
-<a id=3D"l_1065"></a><span class=3D"hl line"> 1065 </span>
-<a id=3D"l_1066"></a><span class=3D"hl line"> 1066 </span><span class=3D"h=
l sym">(</span>defvar <span class=3D"hl sym">*</span>serial-depends-on<span=
class=3D"hl sym">*)</span>
-<a id=3D"l_1067"></a><span class=3D"hl line"> 1067 </span>
-<a id=3D"l_1068"></a><span class=3D"hl line"> 1068 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> parse-component-form <sp=
an class=3D"hl sym">(</span>parent options<span class=3D"hl sym">)</span>
-<a id=3D"l_1069"></a><span class=3D"hl line"> 1069 </span>
-<a id=3D"l_1070"></a><span class=3D"hl line"> 1070 </span> <span class=3D=
"hl sym">(</span>destructuring-bind
-<a id=3D"l_1071"></a><span class=3D"hl line"> 1071 </span> <span cl=
ass=3D"hl sym">(</span><span class=3D"hl kwa">type</span> name <span class=
=3D"hl sym">&</span>rest rest <span class=3D"hl sym">&</span>key
-<a id=3D"l_1072"></a><span class=3D"hl line"> 1072 </span> <s=
pan class=3D"hl slc">;; the following list of keywords is reproduced below =
in the</span>
-<a id=3D"l_1073"></a><span class=3D"hl line"> 1073 </span> <s=
pan class=3D"hl slc">;; remove-keys form. important to keep them in sync</=
span>
-<a id=3D"l_1074"></a><span class=3D"hl line"> 1074 </span> co=
mponents pathname default-component-class
-<a id=3D"l_1075"></a><span class=3D"hl line"> 1075 </span> pe=
rform explain output-files operation-done-p
-<a id=3D"l_1076"></a><span class=3D"hl line"> 1076 </span> we=
akly-depends-on
-<a id=3D"l_1077"></a><span class=3D"hl line"> 1077 </span> de=
pends-on serial in-order-to
-<a id=3D"l_1078"></a><span class=3D"hl line"> 1078 </span> <s=
pan class=3D"hl slc">;; list ends</span>
-<a id=3D"l_1079"></a><span class=3D"hl line"> 1079 </span> <s=
pan class=3D"hl sym">&</span>allow-other-keys<span class=3D"hl sym">)</=
span> options
-<a id=3D"l_1080"></a><span class=3D"hl line"> 1080 </span> <span class=
=3D"hl sym">(</span>declare <span class=3D"hl sym">(</span>ignorable perfor=
m explain output-files operation-done-p<span class=3D"hl sym">))</span>
-<a id=3D"l_1081"></a><span class=3D"hl line"> 1081 </span> <span class=
=3D"hl sym">(</span>check-component-input <span class=3D"hl kwa">type</span=
> name weakly-depends-on depends-on components in-order-to<span class=3D"hl=
sym">)</span>
-<a id=3D"l_1082"></a><span class=3D"hl line"> 1082 </span>
-<a id=3D"l_1083"></a><span class=3D"hl line"> 1083 </span> <span class=
=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"hl k=
wa">and</span> parent
-<a id=3D"l_1084"></a><span class=3D"hl line"> 1084 </span> <=
span class=3D"hl sym">(</span>find-component parent name<span class=3D"hl s=
ym">)</span>
-<a id=3D"l_1085"></a><span class=3D"hl line"> 1085 </span> <=
span class=3D"hl slc">;; ignore the same object when rereading the defsyste=
m</span>
-<a id=3D"l_1086"></a><span class=3D"hl line"> 1086 </span> <=
span class=3D"hl sym">(</span><span class=3D"hl kwa">not</span>
-<a id=3D"l_1087"></a><span class=3D"hl line"> 1087 </span> =
<span class=3D"hl sym">(</span>typep <span class=3D"hl sym">(</span>find-co=
mponent parent name<span class=3D"hl sym">)</span>
-<a id=3D"l_1088"></a><span class=3D"hl line"> 1088 </span> =
<span class=3D"hl sym">(</span>class-for-<span class=3D"hl kwa">type=
</span> parent <span class=3D"hl kwa">type</span><span class=3D"hl sym">)))=
)</span>
-<a id=3D"l_1089"></a><span class=3D"hl line"> 1089 </span> <span clas=
s=3D"hl sym">(</span>error <span class=3D"hl sym">'</span>duplicate-names <=
span class=3D"hl sym">:</span>name name<span class=3D"hl sym">))</span>
-<a id=3D"l_1090"></a><span class=3D"hl line"> 1090 </span>
-<a id=3D"l_1091"></a><span class=3D"hl line"> 1091 </span> <span class=
=3D"hl sym">(</span>let<span class=3D"hl sym">* ((</span>other-args <span c=
lass=3D"hl sym">(</span>remove-keys
-<a id=3D"l_1092"></a><span class=3D"hl line"> 1092 </span> =
<span class=3D"hl sym">'(</span>components pathname default-compone=
nt-class
-<a id=3D"l_1093"></a><span class=3D"hl line"> 1093 </span> =
perform explain output-files operation-done-p
-<a id=3D"l_1094"></a><span class=3D"hl line"> 1094 </span> =
weakly-depends-on
-<a id=3D"l_1095"></a><span class=3D"hl line"> 1095 </span> =
depends-on serial in-order-to<span class=3D"hl sym">)</span>
-<a id=3D"l_1096"></a><span class=3D"hl line"> 1096 </span> =
rest<span class=3D"hl sym">))</span>
-<a id=3D"l_1097"></a><span class=3D"hl line"> 1097 </span> <span=
class=3D"hl sym">(</span>ret
-<a id=3D"l_1098"></a><span class=3D"hl line"> 1098 </span> <spa=
n class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> <span class=3D"=
hl sym">(</span>find-component parent name<span class=3D"hl sym">)</span>
-<a id=3D"l_1099"></a><span class=3D"hl line"> 1099 </span> =
<span class=3D"hl sym">(</span>make-instance <span class=3D"hl sym">(</span=
>class-for-<span class=3D"hl kwa">type</span> parent <span class=3D"hl kwa"=
>type</span><span class=3D"hl sym">)))))</span>
-<a id=3D"l_1100"></a><span class=3D"hl line"> 1100 </span> <span clas=
s=3D"hl sym">(</span>when weakly-depends-on
-<a id=3D"l_1101"></a><span class=3D"hl line"> 1101 </span> <span cl=
ass=3D"hl sym">(</span>setf depends-on <span class=3D"hl sym">(</span><span=
class=3D"hl kwa">append</span> depends-on <span class=3D"hl sym">(</span>r=
emove-<span class=3D"hl kwa">if</span> <span class=3D"hl sym">(</span>compl=
ement #<span class=3D"hl sym">'</span>find-system<span class=3D"hl sym">)</=
span> weakly-depends-on<span class=3D"hl sym">))))</span>
-<a id=3D"l_1102"></a><span class=3D"hl line"> 1102 </span> <span clas=
s=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"hl =
kwa">boundp</span> <span class=3D"hl sym">'*</span>serial-depends-on<span c=
lass=3D"hl sym">*)</span>
-<a id=3D"l_1103"></a><span class=3D"hl line"> 1103 </span> <span cl=
ass=3D"hl sym">(</span>setf depends-on
-<a id=3D"l_1104"></a><span class=3D"hl line"> 1104 </span> <s=
pan class=3D"hl sym">(</span>concatenate <span class=3D"hl sym">'</span><sp=
an class=3D"hl kwa">list</span> <span class=3D"hl sym">*</span>serial-depen=
ds-on<span class=3D"hl sym">*</span> depends-on<span class=3D"hl sym">)))</=
span>
-<a id=3D"l_1105"></a><span class=3D"hl line"> 1105 </span> <span clas=
s=3D"hl sym">(</span><span class=3D"hl kwa">apply</span> #<span class=3D"hl=
sym">'</span>reinitialize-instance ret
-<a id=3D"l_1106"></a><span class=3D"hl line"> 1106 </span> <sp=
an class=3D"hl sym">:</span>name <span class=3D"hl sym">(</span>coerce-name=
name<span class=3D"hl sym">)</span>
-<a id=3D"l_1107"></a><span class=3D"hl line"> 1107 </span> <sp=
an class=3D"hl sym">:</span>pathname pathname
-<a id=3D"l_1108"></a><span class=3D"hl line"> 1108 </span> <sp=
an class=3D"hl sym">:</span>parent parent
-<a id=3D"l_1109"></a><span class=3D"hl line"> 1109 </span> oth=
er-args<span class=3D"hl sym">)</span>
-<a id=3D"l_1110"></a><span class=3D"hl line"> 1110 </span> <span clas=
s=3D"hl sym">(</span>when <span class=3D"hl sym">(</span>typep ret <span cl=
ass=3D"hl sym">'</span>module<span class=3D"hl sym">)</span>
-<a id=3D"l_1111"></a><span class=3D"hl line"> 1111 </span> <span cl=
ass=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>module-default-c=
omponent-class ret<span class=3D"hl sym">)</span>
-<a id=3D"l_1112"></a><span class=3D"hl line"> 1112 </span> <s=
pan class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> default-compo=
nent-class
-<a id=3D"l_1113"></a><span class=3D"hl line"> 1113 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">and</span> <span cl=
ass=3D"hl sym">(</span>typep parent <span class=3D"hl sym">'</span>module<s=
pan class=3D"hl sym">)</span>
-<a id=3D"l_1114"></a><span class=3D"hl line"> 1114 </span> =
<span class=3D"hl sym">(</span>module-default-component-class parent=
<span class=3D"hl sym">))))</span>
-<a id=3D"l_1115"></a><span class=3D"hl line"> 1115 </span> <span cl=
ass=3D"hl sym">(</span>let <span class=3D"hl sym">((*</span>serial-depends-=
on<span class=3D"hl sym">*</span> nil<span class=3D"hl sym">))</span>
-<a id=3D"l_1116"></a><span class=3D"hl line"> 1116 </span> <span =
class=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>module-compone=
nts ret<span class=3D"hl sym">)</span>
-<a id=3D"l_1117"></a><span class=3D"hl line"> 1117 </span> =
<span class=3D"hl sym">(</span>loop for c-form in components
-<a id=3D"l_1118"></a><span class=3D"hl line"> 1118 </span> =
for c <span class=3D"hl sym">=3D (</span>parse-component-form ret c-f=
orm<span class=3D"hl sym">)</span>
-<a id=3D"l_1119"></a><span class=3D"hl line"> 1119 </span> =
collect c
-<a id=3D"l_1120"></a><span class=3D"hl line"> 1120 </span> =
<span class=3D"hl kwa">if</span> serial
-<a id=3D"l_1121"></a><span class=3D"hl line"> 1121 </span> =
do <span class=3D"hl sym">(</span>push <span class=3D"hl sym">(</span=
>component-name c<span class=3D"hl sym">) *</span>serial-depends-on<span cl=
ass=3D"hl sym">*))))</span>
-<a id=3D"l_1122"></a><span class=3D"hl line"> 1122 </span>
-<a id=3D"l_1123"></a><span class=3D"hl line"> 1123 </span> <span cl=
ass=3D"hl slc">;; check for duplicate names</span>
-<a id=3D"l_1124"></a><span class=3D"hl line"> 1124 </span> <span cl=
ass=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>name-hash <span =
class=3D"hl sym">(</span>make-hash-table <span class=3D"hl sym">:</span>tes=
t #<span class=3D"hl sym">'</span><span class=3D"hl kwa">equal</span><span =
class=3D"hl sym">)))</span>
-<a id=3D"l_1125"></a><span class=3D"hl line"> 1125 </span> <span =
class=3D"hl sym">(</span>loop for c in <span class=3D"hl sym">(</span>modul=
e-components ret<span class=3D"hl sym">)</span>
-<a id=3D"l_1126"></a><span class=3D"hl line"> 1126 </span> =
do
-<a id=3D"l_1127"></a><span class=3D"hl line"> 1127 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">if</span> <span class=
=3D"hl sym">(</span>gethash <span class=3D"hl sym">(</span>component-name c=
<span class=3D"hl sym">)</span>
-<a id=3D"l_1128"></a><span class=3D"hl line"> 1128 </span> =
name-hash<span class=3D"hl sym">)</span>
-<a id=3D"l_1129"></a><span class=3D"hl line"> 1129 </span> =
<span class=3D"hl sym">(</span>error <span class=3D"hl sym">'</span>dup=
licate-names
-<a id=3D"l_1130"></a><span class=3D"hl line"> 1130 </span> =
<span class=3D"hl sym">:</span>name <span class=3D"hl sym">(</sp=
an>component-name c<span class=3D"hl sym">))</span>
-<a id=3D"l_1131"></a><span class=3D"hl line"> 1131 </span> =
<span class=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>geth=
ash <span class=3D"hl sym">(</span>component-name c<span class=3D"hl sym">)=
</span>
-<a id=3D"l_1132"></a><span class=3D"hl line"> 1132 </span> =
name-hash<span class=3D"hl sym">)</span>
-<a id=3D"l_1133"></a><span class=3D"hl line"> 1133 </span> =
t<span class=3D"hl sym">)))))</span>
-<a id=3D"l_1134"></a><span class=3D"hl line"> 1134 </span>
-<a id=3D"l_1135"></a><span class=3D"hl line"> 1135 </span> <span clas=
s=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span>slot-value ret <sp=
an class=3D"hl sym">'</span>in-order-to<span class=3D"hl sym">)</span>
-<a id=3D"l_1136"></a><span class=3D"hl line"> 1136 </span> <spa=
n class=3D"hl sym">(</span>union-of-dependencies
-<a id=3D"l_1137"></a><span class=3D"hl line"> 1137 </span> in-=
order-to
-<a id=3D"l_1138"></a><span class=3D"hl line"> 1138 </span> `<s=
pan class=3D"hl sym">((</span>compile-op <span class=3D"hl sym">(</span>com=
pile-op <span class=3D"hl sym">,</span>@depends-on<span class=3D"hl sym=
">))</span>
-<a id=3D"l_1139"></a><span class=3D"hl line"> 1139 </span> <=
span class=3D"hl sym">(</span><span class=3D"hl kwa">load</span>-op <span c=
lass=3D"hl sym">(</span><span class=3D"hl kwa">load</span>-op <span class=
=3D"hl sym">,</span>@depends-on<span class=3D"hl sym">))))</span>
-<a id=3D"l_1140"></a><span class=3D"hl line"> 1140 </span> <spa=
n class=3D"hl sym">(</span>slot-value ret <span class=3D"hl sym">'</span>do=
-first<span class=3D"hl sym">)</span> `<span class=3D"hl sym">((</span>comp=
ile-op <span class=3D"hl sym">(</span><span class=3D"hl kwa">load</span>-op=
<span class=3D"hl sym">,</span>@depends-on<span class=3D"hl sym">))))<=
/span>
-<a id=3D"l_1141"></a><span class=3D"hl line"> 1141 </span>
-<a id=3D"l_1142"></a><span class=3D"hl line"> 1142 </span> <span clas=
s=3D"hl sym">(</span>%remove-component-inline-methods ret rest<span class=
=3D"hl sym">)</span>
-<a id=3D"l_1143"></a><span class=3D"hl line"> 1143 </span>
-<a id=3D"l_1144"></a><span class=3D"hl line"> 1144 </span> ret<span c=
lass=3D"hl sym">)))</span>
-<a id=3D"l_1145"></a><span class=3D"hl line"> 1145 </span>
-<a id=3D"l_1146"></a><span class=3D"hl line"> 1146 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> %remove-component-inline=
-methods <span class=3D"hl sym">(</span>ret rest<span class=3D"hl sym">)</s=
pan>
-<a id=3D"l_1147"></a><span class=3D"hl line"> 1147 </span> <span class=3D=
"hl sym">(</span>loop for name in <span class=3D"hl sym">+</span>asdf-metho=
ds<span class=3D"hl sym">+</span>
-<a id=3D"l_1148"></a><span class=3D"hl line"> 1148 </span> do <span=
class=3D"hl sym">(</span>map <span class=3D"hl sym">'</span>nil
-<a id=3D"l_1149"></a><span class=3D"hl line"> 1149 </span> =
<span class=3D"hl slc">;; this is inefficient as most of the stored</span>
-<a id=3D"l_1150"></a><span class=3D"hl line"> 1150 </span> =
<span class=3D"hl slc">;; methods will not be for this particular gf n</spa=
n>
-<a id=3D"l_1151"></a><span class=3D"hl line"> 1151 </span> =
<span class=3D"hl slc">;; But this is hardly performance-critical</span>
-<a id=3D"l_1152"></a><span class=3D"hl line"> 1152 </span> =
<span class=3D"hl sym">(</span><span class=3D"hl kwa">lambda</span> <span c=
lass=3D"hl sym">(</span>m<span class=3D"hl sym">)</span>
-<a id=3D"l_1153"></a><span class=3D"hl line"> 1153 </span> =
<span class=3D"hl sym">(</span>remove-method <span class=3D"hl sym">(</sp=
an>symbol-function name<span class=3D"hl sym">)</span> m<span class=3D"hl s=
ym">))</span>
-<a id=3D"l_1154"></a><span class=3D"hl line"> 1154 </span> =
<span class=3D"hl sym">(</span>component-inline-methods ret<span class=3D"h=
l sym">)))</span>
-<a id=3D"l_1155"></a><span class=3D"hl line"> 1155 </span> <span class=3D=
"hl slc">;; clear methods, then add the new ones</span>
-<a id=3D"l_1156"></a><span class=3D"hl line"> 1156 </span> <span class=3D=
"hl sym">(</span>setf <span class=3D"hl sym">(</span>component-inline-metho=
ds ret<span class=3D"hl sym">)</span> nil<span class=3D"hl sym">)</span>
-<a id=3D"l_1157"></a><span class=3D"hl line"> 1157 </span> <span class=3D=
"hl sym">(</span>loop for name in <span class=3D"hl sym">+</span>asdf-metho=
ds<span class=3D"hl sym">+</span>
-<a id=3D"l_1158"></a><span class=3D"hl line"> 1158 </span> for v <s=
pan class=3D"hl sym">=3D (</span>getf rest <span class=3D"hl sym">(</span>i=
ntern <span class=3D"hl sym">(</span>symbol-name name<span class=3D"hl sym"=
>) :</span>keyword<span class=3D"hl sym">))</span>
-<a id=3D"l_1159"></a><span class=3D"hl line"> 1159 </span> when v do
-<a id=3D"l_1160"></a><span class=3D"hl line"> 1160 </span> <span cl=
ass=3D"hl sym">(</span>destructuring-bind <span class=3D"hl sym">(</span>op=
qual <span class=3D"hl sym">(</span>o c<span class=3D"hl sym">) &</spa=
n>body body<span class=3D"hl sym">)</span> v
-<a id=3D"l_1161"></a><span class=3D"hl line"> 1161 </span> <span =
class=3D"hl sym">(</span>pushnew
-<a id=3D"l_1162"></a><span class=3D"hl line"> 1162 </span> <span=
class=3D"hl sym">(</span><span class=3D"hl kwa">eval</span> `<span class=
=3D"hl sym">(</span>defmethod <span class=3D"hl sym">,</span>name <span cla=
ss=3D"hl sym">,</span>qual <span class=3D"hl sym">((,</span>o <span class=
=3D"hl sym">,</span>op<span class=3D"hl sym">) (,</span>c <span class=3D"hl=
sym">(</span>eql <span class=3D"hl sym">,</span>ret<span class=3D"hl sym">=
)))</span>
-<a id=3D"l_1163"></a><span class=3D"hl line"> 1163 </span> =
<span class=3D"hl sym">,</span>@body<span class=3D"hl sym"=
>))</span>
-<a id=3D"l_1164"></a><span class=3D"hl line"> 1164 </span> <span=
class=3D"hl sym">(</span>component-inline-methods ret<span class=3D"hl sym=
">)))))</span>
-<a id=3D"l_1165"></a><span class=3D"hl line"> 1165 </span>
-<a id=3D"l_1166"></a><span class=3D"hl line"> 1166 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> check-component-input <s=
pan class=3D"hl sym">(</span><span class=3D"hl kwa">type</span> name weakly=
-depends-on depends-on components in-order-to<span class=3D"hl sym">)</span>
-<a id=3D"l_1167"></a><span class=3D"hl line"> 1167 </span> <span class=3D=
"hl str">"A partial test of the values of a component."</span>
-<a id=3D"l_1168"></a><span class=3D"hl line"> 1168 </span> <span class=3D=
"hl sym">(</span>when weakly-depends-on <span class=3D"hl sym">(</span>warn=
<span class=3D"hl str">"We got one! XXXXX"</span><span class=3D"=
hl sym">))</span>
-<a id=3D"l_1169"></a><span class=3D"hl line"> 1169 </span> <span class=3D=
"hl sym">(</span>unless <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">listp</span> depends-on<span class=3D"hl sym">)</span>
-<a id=3D"l_1170"></a><span class=3D"hl line"> 1170 </span> <span class=
=3D"hl sym">(</span>sysdef-error-component <span class=3D"hl str">":de=
pends-on must be a list."</span>
-<a id=3D"l_1171"></a><span class=3D"hl line"> 1171 </span> =
<span class=3D"hl kwa">type</span> name depends-on<span class=
=3D"hl sym">))</span>
-<a id=3D"l_1172"></a><span class=3D"hl line"> 1172 </span> <span class=3D=
"hl sym">(</span>unless <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">listp</span> weakly-depends-on<span class=3D"hl sym">)</span>
-<a id=3D"l_1173"></a><span class=3D"hl line"> 1173 </span> <span class=
=3D"hl sym">(</span>sysdef-error-component <span class=3D"hl str">":we=
akly-depends-on must be a list."</span>
-<a id=3D"l_1174"></a><span class=3D"hl line"> 1174 </span> =
<span class=3D"hl kwa">type</span> name weakly-depends-on<span =
class=3D"hl sym">))</span>
-<a id=3D"l_1175"></a><span class=3D"hl line"> 1175 </span> <span class=3D=
"hl sym">(</span>unless <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">listp</span> components<span class=3D"hl sym">)</span>
-<a id=3D"l_1176"></a><span class=3D"hl line"> 1176 </span> <span class=
=3D"hl sym">(</span>sysdef-error-component <span class=3D"hl str">":co=
mponents must be NIL or a list of components."</span>
-<a id=3D"l_1177"></a><span class=3D"hl line"> 1177 </span> =
<span class=3D"hl kwa">type</span> name components<span class=
=3D"hl sym">))</span>
-<a id=3D"l_1178"></a><span class=3D"hl line"> 1178 </span> <span class=3D=
"hl sym">(</span>unless <span class=3D"hl sym">(</span><span class=3D"hl kw=
a">and</span> <span class=3D"hl sym">(</span><span class=3D"hl kwa">listp</=
span> in-order-to<span class=3D"hl sym">) (</span><span class=3D"hl kwa">li=
stp</span> <span class=3D"hl sym">(</span><span class=3D"hl kwa">car</span>=
in-order-to<span class=3D"hl sym">)))</span>
-<a id=3D"l_1179"></a><span class=3D"hl line"> 1179 </span> <span class=
=3D"hl sym">(</span>sysdef-error-component <span class=3D"hl str">":in=
-order-to must be NIL or a list of components."</span>
-<a id=3D"l_1180"></a><span class=3D"hl line"> 1180 </span> =
<span class=3D"hl kwa">type</span> name in-order-to<span class=
=3D"hl sym">)))</span>
-<a id=3D"l_1181"></a><span class=3D"hl line"> 1181 </span>
-<a id=3D"l_1182"></a><span class=3D"hl line"> 1182 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> sysdef-error-component <=
span class=3D"hl sym">(</span>msg <span class=3D"hl kwa">type</span> name v=
alue<span class=3D"hl sym">)</span>
-<a id=3D"l_1183"></a><span class=3D"hl line"> 1183 </span> <span class=3D=
"hl sym">(</span>sysdef-error <span class=3D"hl sym">(</span>concatenate <s=
pan class=3D"hl sym">'</span>string msg
-<a id=3D"l_1184"></a><span class=3D"hl line"> 1184 </span> =
<span class=3D"hl str">"~&The value specified for ~(~=
A~) ~A is ~W"</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1185"></a><span class=3D"hl line"> 1185 </span> =
<span class=3D"hl kwa">type</span> name value<span class=3D"hl sym">))</spa=
n>
-<a id=3D"l_1186"></a><span class=3D"hl line"> 1186 </span>
-<a id=3D"l_1187"></a><span class=3D"hl line"> 1187 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> resolve-symlinks <span c=
lass=3D"hl sym">(</span>path<span class=3D"hl sym">)</span>
-<a id=3D"l_1188"></a><span class=3D"hl line"> 1188 </span> #-allegro <spa=
n class=3D"hl sym">(</span>truename path<span class=3D"hl sym">)</span>
-<a id=3D"l_1189"></a><span class=3D"hl line"> 1189 </span> #<span class=
=3D"hl sym">+</span>allegro <span class=3D"hl sym">(</span>excl<span class=
=3D"hl sym">:</span>pathname-resolve-symbolic-links path<span class=3D"hl s=
ym">)</span>
-<a id=3D"l_1190"></a><span class=3D"hl line"> 1190 </span> <span class=3D=
"hl sym">)</span>
-<a id=3D"l_1191"></a><span class=3D"hl line"> 1191 </span>
-<a id=3D"l_1192"></a><span class=3D"hl line"> 1192 </span><span class=3D"h=
l slc">;;; optional extras</span>
-<a id=3D"l_1193"></a><span class=3D"hl line"> 1193 </span>
-<a id=3D"l_1194"></a><span class=3D"hl line"> 1194 </span><span class=3D"h=
l slc">;;; run-shell-command functions for other lisp implementations will =
be</span>
-<a id=3D"l_1195"></a><span class=3D"hl line"> 1195 </span><span class=3D"h=
l slc">;;; gratefully accepted, if they do the same thing. If the docstrin=
g</span>
-<a id=3D"l_1196"></a><span class=3D"hl line"> 1196 </span><span class=3D"h=
l slc">;;; is ambiguous, send a bug report</span>
-<a id=3D"l_1197"></a><span class=3D"hl line"> 1197 </span>
-<a id=3D"l_1198"></a><span class=3D"hl line"> 1198 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> run-shell-<span class=3D=
"hl kwa">command</span> <span class=3D"hl sym">(</span>control-string <span=
class=3D"hl sym">&</span>rest args<span class=3D"hl sym">)</span>
-<a id=3D"l_1199"></a><span class=3D"hl line"> 1199 </span> <span class=3D=
"hl str">"Interpolate ARGS into CONTROL-STRING as if by FORMAT, and</s=
pan>
-<a id=3D"l_1200"></a><span class=3D"hl line"> 1200 </span><span class=3D"h=
l str">synchronously execute the result using a Bourne-compatible shell, wi=
th</span>
-<a id=3D"l_1201"></a><span class=3D"hl line"> 1201 </span><span class=3D"h=
l str">output to *VERBOSE-OUT*. Returns the shell's exit code."</span>
-<a id=3D"l_1202"></a><span class=3D"hl line"> 1202 </span> <span class=3D=
"hl sym">(</span>let <span class=3D"hl sym">((</span><span class=3D"hl kwa"=
>command</span> <span class=3D"hl sym">(</span><span class=3D"hl kwa">apply=
</span> #<span class=3D"hl sym">'</span>format nil control-string args<span=
class=3D"hl sym">)))</span>
-<a id=3D"l_1203"></a><span class=3D"hl line"> 1203 </span> <span class=
=3D"hl sym">(</span>format <span class=3D"hl sym">*</span>verbose-out<span =
class=3D"hl sym">*</span> <span class=3D"hl str">"; $ ~A~%"</span=
> <span class=3D"hl kwa">command</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1204"></a><span class=3D"hl line"> 1204 </span> #<span class=
=3D"hl sym">+</span>sbcl
-<a id=3D"l_1205"></a><span class=3D"hl line"> 1205 </span> <span class=
=3D"hl sym">(</span>sb-ext<span class=3D"hl sym">:</span>process-<span clas=
s=3D"hl kwa">exit</span>-code
-<a id=3D"l_1206"></a><span class=3D"hl line"> 1206 </span> <span class=
=3D"hl sym">(</span>sb-ext<span class=3D"hl sym">:</span>run-program
-<a id=3D"l_1207"></a><span class=3D"hl line"> 1207 </span> #<span cla=
ss=3D"hl sym">+</span>win32 <span class=3D"hl str">"sh"</span> #-=
win32 <span class=3D"hl str">"/bin/sh"</span>
-<a id=3D"l_1208"></a><span class=3D"hl line"> 1208 </span> <span clas=
s=3D"hl sym">(</span><span class=3D"hl kwa">list</span> <span class=3D"hl =
str">"-c"</span> <span class=3D"hl kwa">command</span><span class=
=3D"hl sym">)</span>
-<a id=3D"l_1209"></a><span class=3D"hl line"> 1209 </span> #<span cla=
ss=3D"hl sym">+</span>win32 #<span class=3D"hl sym">+</span>win32 <span cla=
ss=3D"hl sym">:</span>search t
-<a id=3D"l_1210"></a><span class=3D"hl line"> 1210 </span> <span clas=
s=3D"hl sym">:</span>input nil <span class=3D"hl sym">:</span>output <span =
class=3D"hl sym">*</span>verbose-out<span class=3D"hl sym">*))</span>
-<a id=3D"l_1211"></a><span class=3D"hl line"> 1211 </span>
-<a id=3D"l_1212"></a><span class=3D"hl line"> 1212 </span> #<span class=
=3D"hl sym">+(</span><span class=3D"hl kwa">or</span> cmu scl<span class=3D=
"hl sym">)</span>
-<a id=3D"l_1213"></a><span class=3D"hl line"> 1213 </span> <span class=
=3D"hl sym">(</span>ext<span class=3D"hl sym">:</span>process-<span class=
=3D"hl kwa">exit</span>-code
-<a id=3D"l_1214"></a><span class=3D"hl line"> 1214 </span> <span class=
=3D"hl sym">(</span>ext<span class=3D"hl sym">:</span>run-program
-<a id=3D"l_1215"></a><span class=3D"hl line"> 1215 </span> <span clas=
s=3D"hl str">"/bin/sh"</span>
-<a id=3D"l_1216"></a><span class=3D"hl line"> 1216 </span> <span clas=
s=3D"hl sym">(</span><span class=3D"hl kwa">list</span> <span class=3D"hl =
str">"-c"</span> <span class=3D"hl kwa">command</span><span class=
=3D"hl sym">)</span>
-<a id=3D"l_1217"></a><span class=3D"hl line"> 1217 </span> <span clas=
s=3D"hl sym">:</span>input nil <span class=3D"hl sym">:</span>output <span =
class=3D"hl sym">*</span>verbose-out<span class=3D"hl sym">*))</span>
-<a id=3D"l_1218"></a><span class=3D"hl line"> 1218 </span>
-<a id=3D"l_1219"></a><span class=3D"hl line"> 1219 </span> #<span class=
=3D"hl sym">+</span>allegro
-<a id=3D"l_1220"></a><span class=3D"hl line"> 1220 </span> <span class=
=3D"hl sym">(</span>excl<span class=3D"hl sym">:</span>run-shell-<span clas=
s=3D"hl kwa">command command</span> <span class=3D"hl sym">:</span>input ni=
l <span class=3D"hl sym">:</span>output <span class=3D"hl sym">*</span>verb=
ose-out<span class=3D"hl sym">*)</span>
-<a id=3D"l_1221"></a><span class=3D"hl line"> 1221 </span>
-<a id=3D"l_1222"></a><span class=3D"hl line"> 1222 </span> #<span class=
=3D"hl sym">+</span>lispworks
-<a id=3D"l_1223"></a><span class=3D"hl line"> 1223 </span> <span class=
=3D"hl sym">(</span>system<span class=3D"hl sym">:</span>call-system-showin=
g-output
-<a id=3D"l_1224"></a><span class=3D"hl line"> 1224 </span> <span class=
=3D"hl kwa">command</span>
-<a id=3D"l_1225"></a><span class=3D"hl line"> 1225 </span> <span class=
=3D"hl sym">:</span>shell-<span class=3D"hl kwa">type</span> <span class=3D=
"hl str">"/bin/sh"</span>
-<a id=3D"l_1226"></a><span class=3D"hl line"> 1226 </span> <span class=
=3D"hl sym">:</span>output-stream <span class=3D"hl sym">*</span>verbose-ou=
t<span class=3D"hl sym">*)</span>
-<a id=3D"l_1227"></a><span class=3D"hl line"> 1227 </span>
-<a id=3D"l_1228"></a><span class=3D"hl line"> 1228 </span> #<span class=
=3D"hl sym">+</span>clisp <span class=3D"hl slc">;XXX n=
ot exactly *verbose-out*, I know</span>
-<a id=3D"l_1229"></a><span class=3D"hl line"> 1229 </span> <span class=
=3D"hl sym">(</span>ext<span class=3D"hl sym">:</span>run-shell-<span class=
=3D"hl kwa">command command</span> <span class=3D"hl sym">:</span>output <=
span class=3D"hl sym">:</span>terminal <span class=3D"hl sym">:</span>wait =
t<span class=3D"hl sym">)</span>
-<a id=3D"l_1230"></a><span class=3D"hl line"> 1230 </span>
-<a id=3D"l_1231"></a><span class=3D"hl line"> 1231 </span> #<span class=
=3D"hl sym">+</span>openmcl
-<a id=3D"l_1232"></a><span class=3D"hl line"> 1232 </span> <span class=
=3D"hl sym">(</span><span class=3D"hl kwa">nth</span>-value <span class=3D"=
hl num">1</span>
-<a id=3D"l_1233"></a><span class=3D"hl line"> 1233 </span> <=
span class=3D"hl sym">(</span>ccl<span class=3D"hl sym">:</span>external-pr=
ocess-status
-<a id=3D"l_1234"></a><span class=3D"hl line"> 1234 </span> =
<span class=3D"hl sym">(</span>ccl<span class=3D"hl sym">:</span>run-progra=
m <span class=3D"hl str">"/bin/sh"</span> <span class=3D"hl sym">=
(</span><span class=3D"hl kwa">list</span> <span class=3D"hl str">"-c&=
quot;</span> <span class=3D"hl kwa">command</span><span class=3D"hl sym">)<=
/span>
-<a id=3D"l_1235"></a><span class=3D"hl line"> 1235 </span> =
<span class=3D"hl sym">:</span>input nil <span class=3D"hl=
sym">:</span>output <span class=3D"hl sym">*</span>verbose-out<span class=
=3D"hl sym">*</span>
-<a id=3D"l_1236"></a><span class=3D"hl line"> 1236 </span> =
<span class=3D"hl sym">:</span>wait t<span class=3D"hl sym=
">)))</span>
-<a id=3D"l_1237"></a><span class=3D"hl line"> 1237 </span> #<span class=
=3D"hl sym">+</span>ecl <span class=3D"hl slc">;; courtesy of Juan Jose Gar=
cia Ripoll</span>
-<a id=3D"l_1238"></a><span class=3D"hl line"> 1238 </span> <span class=
=3D"hl sym">(</span>si<span class=3D"hl sym">:</span>system <span class=3D"=
hl kwa">command</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1239"></a><span class=3D"hl line"> 1239 </span> #-<span clas=
s=3D"hl sym">(</span><span class=3D"hl kwa">or</span> openmcl clisp lispwor=
ks allegro scl cmu sbcl ecl<span class=3D"hl sym">)</span>
-<a id=3D"l_1240"></a><span class=3D"hl line"> 1240 </span> <span class=
=3D"hl sym">(</span>error <span class=3D"hl str">"RUN-SHELL-PROGRAM no=
t implemented for this Lisp"</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1241"></a><span class=3D"hl line"> 1241 </span> <span class=
=3D"hl sym">))</span>
-<a id=3D"l_1242"></a><span class=3D"hl line"> 1242 </span>
-<a id=3D"l_1243"></a><span class=3D"hl line"> 1243 </span>
-<a id=3D"l_1244"></a><span class=3D"hl line"> 1244 </span><span class=3D"h=
l sym">(</span>defgeneric hyperdocumentation <span class=3D"hl sym">(</span=
>package name doc-<span class=3D"hl kwa">type</span><span class=3D"hl sym">=
))</span>
-<a id=3D"l_1245"></a><span class=3D"hl line"> 1245 </span><span class=3D"h=
l sym">(</span>defmethod hyperdocumentation <span class=3D"hl sym">((</span=
>package symbol<span class=3D"hl sym">)</span> name doc-<span class=3D"hl k=
wa">type</span><span class=3D"hl sym">)</span>
-<a id=3D"l_1246"></a><span class=3D"hl line"> 1246 </span> <span class=3D=
"hl sym">(</span>hyperdocumentation <span class=3D"hl sym">(</span>find-pac=
kage package<span class=3D"hl sym">)</span> name doc-<span class=3D"hl kwa"=
>type</span><span class=3D"hl sym">))</span>
-<a id=3D"l_1247"></a><span class=3D"hl line"> 1247 </span>
-<a id=3D"l_1248"></a><span class=3D"hl line"> 1248 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> hyperdoc <span class=3D"=
hl sym">(</span>name doc-<span class=3D"hl kwa">type</span><span class=3D"h=
l sym">)</span>
-<a id=3D"l_1249"></a><span class=3D"hl line"> 1249 </span> <span class=3D=
"hl sym">(</span>hyperdocumentation <span class=3D"hl sym">(</span>symbol-p=
ackage name<span class=3D"hl sym">)</span> name doc-<span class=3D"hl kwa">=
type</span><span class=3D"hl sym">))</span>
-<a id=3D"l_1250"></a><span class=3D"hl line"> 1250 </span>
-<a id=3D"l_1251"></a><span class=3D"hl line"> 1251 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> system-source-file <span=
class=3D"hl sym">(</span>system-name<span class=3D"hl sym">)</span>
-<a id=3D"l_1252"></a><span class=3D"hl line"> 1252 </span> <span class=3D=
"hl sym">(</span>let <span class=3D"hl sym">((</span>system <span class=3D"=
hl sym">(</span>asdf<span class=3D"hl sym">:</span>find-system system-name<=
span class=3D"hl sym">)))</span>
-<a id=3D"l_1253"></a><span class=3D"hl line"> 1253 </span> <span class=
=3D"hl sym">(</span>make-pathname
-<a id=3D"l_1254"></a><span class=3D"hl line"> 1254 </span> <span class=
=3D"hl sym">:</span><span class=3D"hl kwa">type</span> <span class=3D"hl st=
r">"asd"</span>
-<a id=3D"l_1255"></a><span class=3D"hl line"> 1255 </span> <span class=
=3D"hl sym">:</span>name <span class=3D"hl sym">(</span>asdf<span class=3D"=
hl sym">:</span>component-name system<span class=3D"hl sym">)</span>
-<a id=3D"l_1256"></a><span class=3D"hl line"> 1256 </span> <span class=
=3D"hl sym">:</span>defaults <span class=3D"hl sym">(</span>asdf<span class=
=3D"hl sym">:</span>component-relative-pathname system<span class=3D"hl sym=
">))))</span>
-<a id=3D"l_1257"></a><span class=3D"hl line"> 1257 </span>
-<a id=3D"l_1258"></a><span class=3D"hl line"> 1258 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> system-source-directory =
<span class=3D"hl sym">(</span>system-name<span class=3D"hl sym">)</span>
-<a id=3D"l_1259"></a><span class=3D"hl line"> 1259 </span> <span class=3D=
"hl sym">(</span>make-pathname <span class=3D"hl sym">:</span>name nil
-<a id=3D"l_1260"></a><span class=3D"hl line"> 1260 </span> =
<span class=3D"hl sym">:</span><span class=3D"hl kwa">type</span> nil
-<a id=3D"l_1261"></a><span class=3D"hl line"> 1261 </span> =
<span class=3D"hl sym">:</span>defaults <span class=3D"hl sym">(</span>sys=
tem-source-file system-name<span class=3D"hl sym">)))</span>
-<a id=3D"l_1262"></a><span class=3D"hl line"> 1262 </span>
-<a id=3D"l_1263"></a><span class=3D"hl line"> 1263 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">defun</span> system-relative-pathname=
<span class=3D"hl sym">(</span>system pathname <span class=3D"hl sym">&=
;</span>key name <span class=3D"hl kwa">type</span><span class=3D"hl sym">)=
</span>
-<a id=3D"l_1264"></a><span class=3D"hl line"> 1264 </span> <span class=3D=
"hl sym">(</span>let <span class=3D"hl sym">((</span>directory <span class=
=3D"hl sym">(</span>pathname-directory pathname<span class=3D"hl sym">)))</=
span>
-<a id=3D"l_1265"></a><span class=3D"hl line"> 1265 </span> <span class=
=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"hl k=
wa">eq</span> <span class=3D"hl sym">(</span><span class=3D"hl kwa">car</sp=
an> directory<span class=3D"hl sym">) :</span>absolute<span class=3D"hl sym=
">)</span>
-<a id=3D"l_1266"></a><span class=3D"hl line"> 1266 </span> <span clas=
s=3D"hl sym">(</span>setf <span class=3D"hl sym">(</span><span class=3D"hl =
kwa">car</span> directory<span class=3D"hl sym">) :</span>relative<span cla=
ss=3D"hl sym">))</span>
-<a id=3D"l_1267"></a><span class=3D"hl line"> 1267 </span> <span class=
=3D"hl sym">(</span>merge-pathnames
-<a id=3D"l_1268"></a><span class=3D"hl line"> 1268 </span> <span class=
=3D"hl sym">(</span>make-pathname <span class=3D"hl sym">:</span>name <span=
class=3D"hl sym">(</span><span class=3D"hl kwa">or</span> name <span class=
=3D"hl sym">(</span>pathname-name pathname<span class=3D"hl sym">))</span>
-<a id=3D"l_1269"></a><span class=3D"hl line"> 1269 </span> =
<span class=3D"hl sym">:</span><span class=3D"hl kwa">type</span> <span=
class=3D"hl sym">(</span><span class=3D"hl kwa">or type</span> <span class=
=3D"hl sym">(</span>pathname-<span class=3D"hl kwa">type</span> pathname<sp=
an class=3D"hl sym">))</span>
-<a id=3D"l_1270"></a><span class=3D"hl line"> 1270 </span> =
<span class=3D"hl sym">:</span>directory directory<span class=3D"hl sym=
">)</span>
-<a id=3D"l_1271"></a><span class=3D"hl line"> 1271 </span> <span class=
=3D"hl sym">(</span>system-source-directory system<span class=3D"hl sym">))=
))</span>
-<a id=3D"l_1272"></a><span class=3D"hl line"> 1272 </span>
-<a id=3D"l_1273"></a><span class=3D"hl line"> 1273 </span>
-<a id=3D"l_1274"></a><span class=3D"hl line"> 1274 </span><span class=3D"h=
l sym">(</span>pushnew <span class=3D"hl sym">:</span>asdf <span class=3D"h=
l sym">*</span>features<span class=3D"hl sym">*)</span>
-<a id=3D"l_1275"></a><span class=3D"hl line"> 1275 </span>
-<a id=3D"l_1276"></a><span class=3D"hl line"> 1276 </span>#<span class=3D"=
hl sym">+</span>sbcl
-<a id=3D"l_1277"></a><span class=3D"hl line"> 1277 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">eval</span>-when <span class=3D"hl sy=
m">(:</span>compile-toplevel <span class=3D"hl sym">:</span><span class=3D"=
hl kwa">load</span>-toplevel <span class=3D"hl sym">:</span>execute<span cl=
ass=3D"hl sym">)</span>
-<a id=3D"l_1278"></a><span class=3D"hl line"> 1278 </span> <span class=3D=
"hl sym">(</span>when <span class=3D"hl sym">(</span>sb-ext<span class=3D"h=
l sym">:</span>posix-<span class=3D"hl kwa">getenv</span> <span class=3D"hl=
str">"SBCL_BUILDING_CONTRIB"</span><span class=3D"hl sym">)</spa=
n>
-<a id=3D"l_1279"></a><span class=3D"hl line"> 1279 </span> <span class=
=3D"hl sym">(</span>pushnew <span class=3D"hl sym">:</span>sbcl-hooks-requi=
re <span class=3D"hl sym">*</span>features<span class=3D"hl sym">*)))</span>
-<a id=3D"l_1280"></a><span class=3D"hl line"> 1280 </span>
-<a id=3D"l_1281"></a><span class=3D"hl line"> 1281 </span>#<span class=3D"=
hl sym">+(</span><span class=3D"hl kwa">and</span> sbcl sbcl-hooks-require<=
span class=3D"hl sym">)</span>
-<a id=3D"l_1282"></a><span class=3D"hl line"> 1282 </span><span class=3D"h=
l sym">(</span><span class=3D"hl kwa">progn</span>
-<a id=3D"l_1283"></a><span class=3D"hl line"> 1283 </span> <span class=3D=
"hl sym">(</span><span class=3D"hl kwa">defun</span> module-provide-asdf <s=
pan class=3D"hl sym">(</span>name<span class=3D"hl sym">)</span>
-<a id=3D"l_1284"></a><span class=3D"hl line"> 1284 </span> <span class=
=3D"hl sym">(</span>handler-bind <span class=3D"hl sym">((</span>style-warn=
ing #<span class=3D"hl sym">'</span>muffle-warning<span class=3D"hl sym">))=
</span>
-<a id=3D"l_1285"></a><span class=3D"hl line"> 1285 </span> <span clas=
s=3D"hl sym">(</span>let<span class=3D"hl sym">* ((*</span>verbose-out<span=
class=3D"hl sym">* (</span>make-broadcast-stream<span class=3D"hl sym">))<=
/span>
-<a id=3D"l_1286"></a><span class=3D"hl line"> 1286 </span> <sp=
an class=3D"hl sym">(</span>system <span class=3D"hl sym">(</span>asdf<span=
class=3D"hl sym">:</span>find-system name nil<span class=3D"hl sym">)))</s=
pan>
-<a id=3D"l_1287"></a><span class=3D"hl line"> 1287 </span> <span cl=
ass=3D"hl sym">(</span>when system
-<a id=3D"l_1288"></a><span class=3D"hl line"> 1288 </span> <span =
class=3D"hl sym">(</span>asdf<span class=3D"hl sym">:</span>operate <span c=
lass=3D"hl sym">'</span>asdf<span class=3D"hl sym">:</span><span class=3D"h=
l kwa">load</span>-op name<span class=3D"hl sym">)</span>
-<a id=3D"l_1289"></a><span class=3D"hl line"> 1289 </span> t<span=
class=3D"hl sym">))))</span>
-<a id=3D"l_1290"></a><span class=3D"hl line"> 1290 </span>
-<a id=3D"l_1291"></a><span class=3D"hl line"> 1291 </span> <span class=3D=
"hl sym">(</span><span class=3D"hl kwa">defun</span> contrib-sysdef-search =
<span class=3D"hl sym">(</span>system<span class=3D"hl sym">)</span>
-<a id=3D"l_1292"></a><span class=3D"hl line"> 1292 </span> <span class=
=3D"hl sym">(</span>let <span class=3D"hl sym">((</span>home <span class=3D=
"hl sym">(</span>sb-ext<span class=3D"hl sym">:</span>posix-<span class=3D"=
hl kwa">getenv</span> <span class=3D"hl str">"SBCL_HOME"</span><s=
pan class=3D"hl sym">)))</span>
-<a id=3D"l_1293"></a><span class=3D"hl line"> 1293 </span> <span clas=
s=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"hl =
kwa">and</span> home <span class=3D"hl sym">(</span><span class=3D"hl kwa">=
not</span> <span class=3D"hl sym">(</span>string<span class=3D"hl sym">=3D<=
/span> home <span class=3D"hl str">""</span><span class=3D"hl sym=
">)))</span>
-<a id=3D"l_1294"></a><span class=3D"hl line"> 1294 </span> <span cl=
ass=3D"hl sym">(</span>let<span class=3D"hl sym">* ((</span>name <span clas=
s=3D"hl sym">(</span>coerce-name system<span class=3D"hl sym">))</span>
-<a id=3D"l_1295"></a><span class=3D"hl line"> 1295 </span> <=
span class=3D"hl sym">(</span>home <span class=3D"hl sym">(</span>truename =
home<span class=3D"hl sym">))</span>
-<a id=3D"l_1296"></a><span class=3D"hl line"> 1296 </span> <=
span class=3D"hl sym">(</span>contrib <span class=3D"hl sym">(</span>merge-=
pathnames
-<a id=3D"l_1297"></a><span class=3D"hl line"> 1297 </span> =
<span class=3D"hl sym">(</span>make-pathname <span class=3D"hl sym=
">:</span>directory `<span class=3D"hl sym">(:</span>relative <span class=
=3D"hl sym">,</span>name<span class=3D"hl sym">)</span>
-<a id=3D"l_1298"></a><span class=3D"hl line"> 1298 </span> =
<span class=3D"hl sym">:</span>name name
-<a id=3D"l_1299"></a><span class=3D"hl line"> 1299 </span> =
<span class=3D"hl sym">:</span><span class=3D"hl kw=
a">type</span> <span class=3D"hl str">"asd"</span>
-<a id=3D"l_1300"></a><span class=3D"hl line"> 1300 </span> =
<span class=3D"hl sym">:</span>case <span class=3D"=
hl sym">:</span>local
-<a id=3D"l_1301"></a><span class=3D"hl line"> 1301 </span> =
<span class=3D"hl sym">:</span>version <span class=
=3D"hl sym">:</span>newest<span class=3D"hl sym">)</span>
-<a id=3D"l_1302"></a><span class=3D"hl line"> 1302 </span> =
home<span class=3D"hl sym">)))</span>
-<a id=3D"l_1303"></a><span class=3D"hl line"> 1303 </span> <span =
class=3D"hl sym">(</span>probe-file contrib<span class=3D"hl sym">)))))</sp=
an>
-<a id=3D"l_1304"></a><span class=3D"hl line"> 1304 </span>
-<a id=3D"l_1305"></a><span class=3D"hl line"> 1305 </span> <span class=3D=
"hl sym">(</span>pushnew
-<a id=3D"l_1306"></a><span class=3D"hl line"> 1306 </span> <span class=
=3D"hl sym">'(</span>let <span class=3D"hl sym">((</span>home <span class=
=3D"hl sym">(</span>sb-ext<span class=3D"hl sym">:</span>posix-<span class=
=3D"hl kwa">getenv</span> <span class=3D"hl str">"SBCL_HOME"</spa=
n><span class=3D"hl sym">)))</span>
-<a id=3D"l_1307"></a><span class=3D"hl line"> 1307 </span> <span clas=
s=3D"hl sym">(</span>when <span class=3D"hl sym">(</span><span class=3D"hl =
kwa">and</span> home <span class=3D"hl sym">(</span><span class=3D"hl kwa">=
not</span> <span class=3D"hl sym">(</span>string<span class=3D"hl sym">=3D<=
/span> home <span class=3D"hl str">""</span><span class=3D"hl sym=
">)))</span>
-<a id=3D"l_1308"></a><span class=3D"hl line"> 1308 </span> <span cl=
ass=3D"hl sym">(</span>merge-pathnames <span class=3D"hl str">"site-sy=
stems/"</span> <span class=3D"hl sym">(</span>truename home<span class=
=3D"hl sym">))))</span>
-<a id=3D"l_1309"></a><span class=3D"hl line"> 1309 </span> <span class=
=3D"hl sym">*</span>central-registry<span class=3D"hl sym">*)</span>
-<a id=3D"l_1310"></a><span class=3D"hl line"> 1310 </span>
-<a id=3D"l_1311"></a><span class=3D"hl line"> 1311 </span> <span class=3D=
"hl sym">(</span>pushnew
-<a id=3D"l_1312"></a><span class=3D"hl line"> 1312 </span> <span class=
=3D"hl sym">'(</span>merge-pathnames <span class=3D"hl str">".sbcl/sys=
tems/"</span>
-<a id=3D"l_1313"></a><span class=3D"hl line"> 1313 </span> <span class=
=3D"hl sym">(</span>user-homedir-pathname<span class=3D"hl sym">))</span>
-<a id=3D"l_1314"></a><span class=3D"hl line"> 1314 </span> <span class=
=3D"hl sym">*</span>central-registry<span class=3D"hl sym">*)</span>
-<a id=3D"l_1315"></a><span class=3D"hl line"> 1315 </span>
-<a id=3D"l_1316"></a><span class=3D"hl line"> 1316 </span> <span class=3D=
"hl sym">(</span>pushnew <span class=3D"hl sym">'</span>module-provide-asdf=
sb-ext<span class=3D"hl sym">:*</span>module-provider-functions<span class=
=3D"hl sym">*)</span>
-<a id=3D"l_1317"></a><span class=3D"hl line"> 1317 </span> <span class=3D=
"hl sym">(</span>pushnew <span class=3D"hl sym">'</span>contrib-sysdef-sear=
ch <span class=3D"hl sym">*</span>system-definition-search-functions<span c=
lass=3D"hl sym">*))</span>
-<a id=3D"l_1318"></a><span class=3D"hl line"> 1318 </span>
-<a id=3D"l_1319"></a><span class=3D"hl line"> 1319 </span><span class=3D"h=
l sym">(</span>provide <span class=3D"hl sym">'</span>asdf<span class=3D"hl=
sym">)</span>
-</pre></div>
-
-<hr />
-<table>
-<tr>
-<td>
-<address><a href=3D"http://sourceforge.net/">Back to SourceForge.net</a></=
address><br />
-Powered by <a href=3D"http://viewvc.tigris.org/">ViewVC 1.0.3</a>
-</td>
-<td style=3D"text-align:right;">
-<h3><a href=3D"/*docroot*/help_rootview.html">ViewVC and Help</a></h3>
-</td>
-</tr>
-</table>
-</body>
-</html>
-
+;;; This is asdf: Another System Definition Facility. $Revision$
+;;;
+;;; Feedback, bug reports, and patches are all welcome: please mail to
+;;; <cclan-list at lists.sf.net>. But note first that the canonical
+;;; source for asdf is presently the cCLan CVS repository at
+;;; <URL:http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/>
+;;;
+;;; If you obtained this copy from anywhere else, and you experience
+;;; trouble using it, or find bugs, you may want to check at the
+;;; location above for a more recent version (and for documentation
+;;; and test files, if your copy came without them) before reporting
+;;; bugs. There are usually two "supported" revisions - the CVS HEAD
+;;; is the latest development version, whereas the revision tagged
+;;; RELEASE may be slightly older but is considered `stable'
+
+;;; Copyright (c) 2001-2007 Daniel Barlow and contributors
+;;;
+;;; Permission is hereby granted, free of charge, to any person obtaining
+;;; a copy of this software and associated documentation files (the
+;;; "Software"), to deal in the Software without restriction, including
+;;; without limitation the rights to use, copy, modify, merge, publish,
+;;; distribute, sublicense, and/or sell copies of the Software, and to
+;;; permit persons to whom the Software is furnished to do so, subject to
+;;; the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;;; the problem with writing a defsystem replacement is bootstrapping:
+;;; we can't use defsystem to compile it. Hence, all in one file
+
+(defpackage #:asdf
+ (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command
+ #:system-definition-pathname #:find-component ; miscellaneous
+ #:hyperdocumentation #:hyperdoc
+
+ #:compile-op #:load-op #:load-source-op #:test-system-version
+ #:test-op
+ #:operation ; operations
+ #:feature ; sort-of operation
+ #:version ; metaphorically sort-of an operat=
ion
+
+ #:input-files #:output-files #:perform ; operation methods
+ #:operation-done-p #:explain
+
+ #:component #:source-file
+ #:c-source-file #:cl-source-file #:java-source-file
+ #:static-file
+ #:doc-file
+ #:html-file
+ #:text-file
+ #:source-file-type
+ #:module ; components
+ #:system
+ #:unix-dso
+
+ #:module-components ; component accessors
+ #:component-pathname
+ #:component-relative-pathname
+ #:component-name
+ #:component-version
+ #:component-parent
+ #:component-property
+ #:component-system
+
+ #:component-depends-on
+
+ #:system-description
+ #:system-long-description
+ #:system-author
+ #:system-maintainer
+ #:system-license
+ #:system-licence
+ #:system-source-file
+ #:system-relative-pathname
+
+ #:operation-on-warnings
+ #:operation-on-failure
+
+ ;#:*component-parent-pathname*
+ #:*system-definition-search-functions*
+ #:*central-registry* ; variables
+ #:*compile-file-warnings-behaviour*
+ #:*compile-file-failure-behaviour*
+ #:*asdf-revision*
+
+ #:operation-error #:compile-failed #:compile-warned #:compile-e=
rror
+ #:error-component #:error-operation
+ #:system-definition-error
+ #:missing-component
+ #:missing-dependency
+ #:circular-dependency ; errors
+ #:duplicate-names
+
+ #:retry
+ #:accept ; restarts
+
+ #:preference-file-for-system/operation
+ #:load-preferences
+ )
+ (:use :cl))
+
+
+#+nil
+(error "The author of this file habitually uses #+nil to comment out ~
+ forms. But don't worry, it was unlikely to work in the New ~
+ Implementation of Lisp anyway")
+
+(in-package #:asdf)
+
+(defvar *asdf-revision* (let* ((v "$Revision$")
+ (colon (or (position #\: v) -1))
+ (dot (position #\. v)))
+ (and v colon dot
+ (list (parse-integer v :start (1+ colon)
+ :junk-allowed t)
+ (parse-integer v :start (1+ dot)
+ :junk-allowed t)))))
+
+(defvar *compile-file-warnings-behaviour* :warn)
+
+(defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
+
+(defvar *verbose-out* nil)
+
+(defparameter +asdf-methods+
+ '(perform explain output-files operation-done-p))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; utility stuff
+
+(defmacro aif (test then &optional else)
+ `(let ((it ,test)) (if it ,then ,else)))
+
+(defun pathname-sans-name+type (pathname)
+ "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
+and NIL NAME and TYPE components"
+ (make-pathname :name nil :type nil :defaults pathname))
+
+(define-modify-macro appendf (&rest args)
+ append "Append onto list")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; classes, condiitons
+
+(define-condition system-definition-error (error) ()
+ ;; [this use of :report should be redundant, but unfortunately it's not.
+ ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-fun=
ction
+ ;; over print-object; this is always conditions::%print-condition for
+ ;; condition objects, which in turn does inheritance of :report options =
at
+ ;; run-time. fortunately, inheritance means we only need this kludge he=
re in
+ ;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.]
+ #+cmu (:report print-object))
+
+(define-condition formatted-system-definition-error (system-definition-err=
or)
+ ((format-control :initarg :format-control :reader format-control)
+ (format-arguments :initarg :format-arguments :reader format-arguments))
+ (:report (lambda (c s)
+ (apply #'format s (format-control c) (format-arguments c)))))
+
+(define-condition circular-dependency (system-definition-error)
+ ((components :initarg :components :reader circular-dependency-components=
)))
+
+(define-condition duplicate-names (system-definition-error)
+ ((name :initarg :name :reader duplicate-names-name)))
+
+(define-condition missing-component (system-definition-error)
+ ((requires :initform "(unnamed)" :reader missing-requires :initarg :requ=
ires)
+ (version :initform nil :reader missing-version :initarg :version)
+ (parent :initform nil :reader missing-parent :initarg :parent)))
+
+(define-condition missing-dependency (missing-component)
+ ((required-by :initarg :required-by :reader missing-required-by)))
+
+(define-condition operation-error (error)
+ ((component :reader error-component :initarg :component)
+ (operation :reader error-operation :initarg :operation))
+ (:report (lambda (c s)
+ (format s "~@<erred while invoking ~A on ~A~@:>"
+ (error-operation c) (error-component c)))))
+(define-condition compile-error (operation-error) ())
+(define-condition compile-failed (compile-error) ())
+(define-condition compile-warned (compile-error) ())
+
+(defclass component ()
+ ((name :accessor component-name :initarg :name :documentation
+ "Component name: designator for a string composed of portable pat=
hname characters")
+ (version :accessor component-version :initarg :version)
+ (in-order-to :initform nil :initarg :in-order-to)
+ ;; XXX crap name
+ (do-first :initform nil :initarg :do-first)
+ ;; methods defined using the "inline" style inside a defsystem form:
+ ;; need to store them somewhere so we can delete them when the system
+ ;; is re-evaluated
+ (inline-methods :accessor component-inline-methods :initform nil)
+ (parent :initarg :parent :initform nil :reader component-parent)
+ ;; no direct accessor for pathname, we do this as a method to allow
+ ;; it to default in funky ways if not supplied
+ (relative-pathname :initarg :pathname)
+ (operation-times :initform (make-hash-table )
+ :accessor component-operation-times)
+ ;; XXX we should provide some atomic interface for updating the
+ ;; component properties
+ (properties :accessor component-properties :initarg :properties
+ :initform nil)))
+
+;;;; methods: conditions
+
+(defmethod print-object ((c missing-dependency) s)
+ (format s "~@<~A, required by ~A~@:>"
+ (call-next-method c nil) (missing-required-by c)))
+
+(defun sysdef-error (format &rest arguments)
+ (error 'formatted-system-definition-error :format-control format :format=
-arguments arguments))
+
+;;;; methods: components
+
+(defmethod print-object ((c missing-component) s)
+ (format s "~@<component ~S not found~
+ ~@[ or does not match version ~A~]~
+ ~@[ in ~A~]~@:>"
+ (missing-requires c)
+ (missing-version c)
+ (when (missing-parent c)
+ (component-name (missing-parent c)))))
+
+(defgeneric component-system (component)
+ (:documentation "Find the top-level system containing COMPONENT"))
+
+(defmethod component-system ((component component))
+ (aif (component-parent component)
+ (component-system it)
+ component))
+
+(defmethod print-object ((c component) stream)
+ (print-unreadable-object (c stream :type t :identity t)
+ (ignore-errors
+ (prin1 (component-name c) stream))))
+
+(defclass module (component)
+ ((components :initform nil :accessor module-components :initarg :compone=
nts)
+ ;; what to do if we can't satisfy a dependency of one of this module's
+ ;; components. This allows a limited form of conditional processing
+ (if-component-dep-fails :initform :fail
+ :accessor module-if-component-dep-fails
+ :initarg :if-component-dep-fails)
+ (default-component-class :accessor module-default-component-class
+ :initform 'cl-source-file :initarg :default-component-class)))
+
+(defgeneric component-pathname (component)
+ (:documentation "Extracts the pathname applicable for a particular compo=
nent."))
+
+(defun component-parent-pathname (component)
+ (aif (component-parent component)
+ (component-pathname it)
+ *default-pathname-defaults*))
+
+(defgeneric component-relative-pathname (component)
+ (:documentation "Extracts the relative pathname applicable for a particu=
lar component."))
+
+(defmethod component-relative-pathname ((component module))
+ (or (slot-value component 'relative-pathname)
+ (make-pathname
+ :directory `(:relative ,(component-name component))
+ :host (pathname-host (component-parent-pathname component)))))
+
+(defmethod component-pathname ((component component))
+ (let ((*default-pathname-defaults* (component-parent-pathname component)=
))
+ (merge-pathnames (component-relative-pathname component))))
+
+(defgeneric component-property (component property))
+
+(defmethod component-property ((c component) property)
+ (cdr (assoc property (slot-value c 'properties) :test #'equal)))
+
+(defgeneric (setf component-property) (new-value component property))
+
+(defmethod (setf component-property) (new-value (c component) property)
+ (let ((a (assoc property (slot-value c 'properties) :test #'equal)))
+ (if a
+ (setf (cdr a) new-value)
+ (setf (slot-value c 'properties)
+ (acons property new-value (slot-value c 'properties))))))
+
+(defclass system (module)
+ ((description :accessor system-description :initarg :description)
+ (long-description
+ :accessor system-long-description :initarg :long-description)
+ (author :accessor system-author :initarg :author)
+ (maintainer :accessor system-maintainer :initarg :maintainer)
+ (licence :accessor system-licence :initarg :licence
+ :accessor system-license :initarg :license)))
+
+;;; version-satisfies
+
+;;; with apologies to christophe rhodes ...
+(defun split (string &optional max (ws '(#\Space #\Tab)))
+ (flet ((is-ws (char) (find char ws)))
+ (nreverse
+ (let ((list nil) (start 0) (words 0) end)
+ (loop
+ (when (and max (>=3D words (1- max)))
+ (return (cons (subseq string start) list)))
+ (setf end (position-if #'is-ws string :start start))
+ (push (subseq string start end) list)
+ (incf words)
+ (unless end (return list))
+ (setf start (1+ end)))))))
+
+(defgeneric version-satisfies (component version))
+
+(defmethod version-satisfies ((c component) version)
+ (unless (and version (slot-boundp c 'version))
+ (return-from version-satisfies t))
+ (let ((x (mapcar #'parse-integer
+ (split (component-version c) nil '(#\.))))
+ (y (mapcar #'parse-integer
+ (split version nil '(#\.)))))
+ (labels ((bigger (x y)
+ (cond ((not y) t)
+ ((not x) nil)
+ ((> (car x) (car y)) t)
+ ((=3D (car x) (car y))
+ (bigger (cdr x) (cdr y))))))
+ (and (=3D (car x) (car y))
+ (or (not (cdr y)) (bigger (cdr x) (cdr y)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; finding systems
+
+(defvar *defined-systems* (make-hash-table :test 'equal))
+(defun coerce-name (name)
+ (typecase name
+ (component (component-name name))
+ (symbol (string-downcase (symbol-name name)))
+ (string name)
+ (t (sysdef-error "~@<invalid component designator ~A~@:>" name))))
+
+;;; for the sake of keeping things reasonably neat, we adopt a
+;;; convention that functions in this list are prefixed SYSDEF-
+
+(defvar *system-definition-search-functions*
+ '(sysdef-central-registry-search))
+
+(defun system-definition-pathname (system)
+ (some (lambda (x) (funcall x system))
+ *system-definition-search-functions*))
+
+(defvar *central-registry*
+ '(*default-pathname-defaults*
+ #+nil "/home/dan/src/sourceforge/cclan/asdf/systems/"
+ #+nil "telent:asdf;systems;"))
+
+(defun sysdef-central-registry-search (system)
+ (let ((name (coerce-name system)))
+ (block nil
+ (dolist (dir *central-registry*)
+ (let* ((defaults (eval dir))
+ (file (and defaults
+ (make-pathname
+ :defaults defaults :version :newest
+ :name name :type "asd" :case :local))))
+ (if (and file (probe-file file))
+ (return file)))))))
+
+(defun make-temporary-package ()
+ (flet ((try (counter)
+ (ignore-errors
+ (make-package (format nil "ASDF~D" counter)
+ :use '(:cl :asdf)))))
+ (do* ((counter 0 (+ counter 1))
+ (package (try counter) (try counter)))
+ (package package))))
+
+(defun find-system (name &optional (error-p t))
+ (let* ((name (coerce-name name))
+ (in-memory (gethash name *defined-systems*))
+ (on-disk (system-definition-pathname name)))
+ (when (and on-disk
+ (or (not in-memory)
+ (< (car in-memory) (file-write-date on-disk))))
+ (let ((package (make-temporary-package)))
+ (unwind-protect
+ (let ((*package* package))
+ (format
+ *verbose-out*
+ "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
+ ;; FIXME: This wants to be (ENOUGH-NAMESTRING
+ ;; ON-DISK), but CMUCL barfs on that.
+ on-disk
+ *package*)
+ (load on-disk))
+ (delete-package package))))
+ (let ((in-memory (gethash name *defined-systems*)))
+ (if in-memory
+ (progn (if on-disk (setf (car in-memory) (file-write-date on-dis=
k)))
+ (cdr in-memory))
+ (if error-p (error 'missing-component :requires name))))))
+
+(defun register-system (name system)
+ (format *verbose-out* "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
+ (setf (gethash (coerce-name name) *defined-systems*)
+ (cons (get-universal-time) system)))
+
+(defun system-registered-p (name)
+ (gethash (coerce-name name) *defined-systems*))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; finding components
+
+(defgeneric find-component (module name &optional version)
+ (:documentation "Finds the component with name NAME present in the
+MODULE module; if MODULE is nil, then the component is assumed to be a
+system."))
+
+(defmethod find-component ((module module) name &optional version)
+ (if (slot-boundp module 'components)
+ (let ((m (find name (module-components module)
+ :test #'equal :key #'component-name)))
+ (if (and m (version-satisfies m version)) m))))
+
+
+;;; a component with no parent is a system
+(defmethod find-component ((module (eql nil)) name &optional version)
+ (let ((m (find-system name nil)))
+ (if (and m (version-satisfies m version)) m)))
+
+;;; component subclasses
+
+(defclass source-file (component) ())
+
+(defclass cl-source-file (source-file) ())
+(defclass c-source-file (source-file) ())
+(defclass java-source-file (source-file) ())
+(defclass static-file (source-file) ())
+(defclass doc-file (static-file) ())
+(defclass html-file (doc-file) ())
+
+(defgeneric source-file-type (component system))
+(defmethod source-file-type ((c cl-source-file) (s module)) "lisp")
+(defmethod source-file-type ((c c-source-file) (s module)) "c")
+(defmethod source-file-type ((c java-source-file) (s module)) "java")
+(defmethod source-file-type ((c html-file) (s module)) "html")
+(defmethod source-file-type ((c static-file) (s module)) nil)
+
+(defmethod component-relative-pathname ((component source-file))
+ (let ((relative-pathname (slot-value component 'relative-pathname)))
+ (if relative-pathname
+ (merge-pathnames
+ relative-pathname
+ (make-pathname
+ :type (source-file-type component (component-system component))))
+ (let* ((*default-pathname-defaults*
+ (component-parent-pathname component))
+ (name-type
+ (make-pathname
+ :name (component-name component)
+ :type (source-file-type component
+ (component-system component)))))
+ name-type))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; operations
+
+;;; one of these is instantiated whenever (operate ) is called
+
+(defclass operation ()
+ ((forced :initform nil :initarg :force :accessor operation-forced)
+ (original-initargs :initform nil :initarg :original-initargs
+ :accessor operation-original-initargs)
+ (visited-nodes :initform nil :accessor operation-visited-nodes)
+ (visiting-nodes :initform nil :accessor operation-visiting-nodes)
+ (parent :initform nil :initarg :parent :accessor operation-parent)))
+
+(defmethod print-object ((o operation) stream)
+ (print-unreadable-object (o stream :type t :identity t)
+ (ignore-errors
+ (prin1 (operation-original-initargs o) stream))))
+
+(defmethod shared-initialize :after ((operation operation) slot-names
+ &key force
+ &allow-other-keys)
+ (declare (ignore slot-names force))
+ ;; empty method to disable initarg validity checking
+ )
+
+(defgeneric perform (operation component))
+(defgeneric operation-done-p (operation component))
+(defgeneric explain (operation component))
+(defgeneric output-files (operation component))
+(defgeneric input-files (operation component))
+
+(defun node-for (o c)
+ (cons (class-name (class-of o)) c))
+
+(defgeneric operation-ancestor (operation)
+ (:documentation
+ "Recursively chase the operation's parent pointer until we get to
+the head of the tree"))
+
+(defmethod operation-ancestor ((operation operation))
+ (aif (operation-parent operation)
+ (operation-ancestor it)
+ operation))
+
+
+(defun make-sub-operation (c o dep-c dep-o)
+ (let* ((args (copy-list (operation-original-initargs o)))
+ (force-p (getf args :force)))
+ ;; note explicit comparison with T: any other non-NIL force value
+ ;; (e.g. :recursive) will pass through
+ (cond ((and (null (component-parent c))
+ (null (component-parent dep-c))
+ (not (eql c dep-c)))
+ (when (eql force-p t)
+ (setf (getf args :force) nil))
+ (apply #'make-instance dep-o
+ :parent o
+ :original-initargs args args))
+ ((subtypep (type-of o) dep-o)
+ o)
+ (t
+ (apply #'make-instance dep-o
+ :parent o :original-initargs args args)))))
+
+
+(defgeneric visit-component (operation component data))
+
+(defmethod visit-component ((o operation) (c component) data)
+ (unless (component-visited-p o c)
+ (push (cons (node-for o c) data)
+ (operation-visited-nodes (operation-ancestor o)))))
+
+(defgeneric component-visited-p (operation component))
+
+(defmethod component-visited-p ((o operation) (c component))
+ (assoc (node-for o c)
+ (operation-visited-nodes (operation-ancestor o))
+ :test 'equal))
+
+(defgeneric (setf visiting-component) (new-value operation component))
+
+(defmethod (setf visiting-component) (new-value operation component)
+ ;; MCL complains about unused lexical variables
+ (declare (ignorable new-value operation component)))
+
+(defmethod (setf visiting-component) (new-value (o operation) (c component=
))
+ (let ((node (node-for o c))
+ (a (operation-ancestor o)))
+ (if new-value
+ (pushnew node (operation-visiting-nodes a) :test 'equal)
+ (setf (operation-visiting-nodes a)
+ (remove node (operation-visiting-nodes a) :test 'equal)))))
+
+(defgeneric component-visiting-p (operation component))
+
+(defmethod component-visiting-p ((o operation) (c component))
+ (let ((node (cons o c)))
+ (member node (operation-visiting-nodes (operation-ancestor o))
+ :test 'equal)))
+
+(defgeneric component-depends-on (operation component)
+ (:documentation
+ "Returns a list of dependencies needed by the component to perform
+ the operation. A dependency has one of the following forms:
+
+ (<operation> <component>*), where <operation> is a class
+ designator and each <component> is a component
+ designator, which means that the component depends on
+ <operation> having been performed on each <component>; or
+
+ (FEATURE <feature>), which means that the component depends
+ on <feature>'s presence in *FEATURES*.
+
+ Methods specialized on subclasses of existing component types
+ should usually append the results of CALL-NEXT-METHOD to the
+ list."))
+
+(defmethod component-depends-on ((op-spec symbol) (c component))
+ (component-depends-on (make-instance op-spec) c))
+
+(defmethod component-depends-on ((o operation) (c component))
+ (cdr (assoc (class-name (class-of o))
+ (slot-value c 'in-order-to))))
+
+(defgeneric component-self-dependencies (operation component))
+
+(defmethod component-self-dependencies ((o operation) (c component))
+ (let ((all-deps (component-depends-on o c)))
+ (remove-if-not (lambda (x)
+ (member (component-name c) (cdr x) :test #'string=3D))
+ all-deps)))
+
+(defmethod input-files ((operation operation) (c component))
+ (let ((parent (component-parent c))
+ (self-deps (component-self-dependencies operation c)))
+ (if self-deps
+ (mapcan (lambda (dep)
+ (destructuring-bind (op name) dep
+ (output-files (make-instance op)
+ (find-component parent name))))
+ self-deps)
+ ;; no previous operations needed? I guess we work with the
+ ;; original source file, then
+ (list (component-pathname c)))))
+
+(defmethod input-files ((operation operation) (c module)) nil)
+
+(defmethod operation-done-p ((o operation) (c component))
+ (flet ((fwd-or-return-t (file)
+ ;; if FILE-WRITE-DATE returns NIL, it's possible that the
+ ;; user or some other agent has deleted an input file. If
+ ;; that's the case, well, that's not good, but as long as
+ ;; the operation is otherwise considered to be done we
+ ;; could continue and survive.
+ (let ((date (file-write-date file)))
+ (cond
+ (date)
+ (t
+ (warn "~@<Missing FILE-WRITE-DATE for ~S: treating ~
+ operation ~S on component ~S as done.~@:>"
+ file o c)
+ (return-from operation-done-p t))))))
+ (let ((out-files (output-files o c))
+ (in-files (input-files o c)))
+ (cond ((and (not in-files) (not out-files))
+ ;; arbitrary decision: an operation that uses nothing to
+ ;; produce nothing probably isn't doing much
+ t)
+ ((not out-files)
+ (let ((op-done
+ (gethash (type-of o)
+ (component-operation-times c))))
+ (and op-done
+ (>=3D op-done
+ (apply #'max
+ (mapcar #'fwd-or-return-t in-files))))))
+ ((not in-files) nil)
+ (t
+ (and
+ (every #'probe-file out-files)
+ (> (apply #'min (mapcar #'file-write-date out-files))
+ (apply #'max (mapcar #'fwd-or-return-t in-files)))))))))
+
+;;; So you look at this code and think "why isn't it a bunch of
+;;; methods". And the answer is, because standard method combination
+;;; runs :before methods most->least-specific, which is back to front
+;;; for our purposes. And CLISP doesn't have non-standard method
+;;; combinations, so let's keep it simple and aspire to portability
+
+(defgeneric traverse (operation component))
+(defmethod traverse ((operation operation) (c component))
+ (let ((forced nil))
+ (labels ((do-one-dep (required-op required-c required-v)
+ (let* ((dep-c (or (find-component
+ (component-parent c)
+ ;; XXX tacky. really we should build the
+ ;; in-order-to slot with canonicalized
+ ;; names instead of coercing this late
+ (coerce-name required-c) required-v)
+ (error 'missing-dependency
+ :required-by c
+ :version required-v
+ :requires required-c)))
+ (op (make-sub-operation c operation dep-c required-o=
p)))
+ (traverse op dep-c)))
+ (do-dep (op dep)
+ (cond ((eq op 'feature)
+ (or (member (car dep) *features*)
+ (error 'missing-dependency
+ :required-by c
+ :requires (car dep)
+ :version nil)))
+ (t
+ (dolist (d dep)
+ (cond ((consp d)
+ (assert (string-equal
+ (symbol-name (first d))
+ "VERSION"))
+ (appendf forced
+ (do-one-dep op (second d) (third d=
))))
+ (t
+ (appendf forced (do-one-dep op d nil)))))))=
))
+ (aif (component-visited-p operation c)
+ (return-from traverse
+ (if (cdr it) (list (cons 'pruned-op c)) nil)))
+ ;; dependencies
+ (if (component-visiting-p operation c)
+ (error 'circular-dependency :components (list c)))
+ (setf (visiting-component operation c) t)
+ (loop for (required-op . deps) in (component-depends-on operation c)
+ do (do-dep required-op deps))
+ ;; constituent bits
+ (let ((module-ops
+ (when (typep c 'module)
+ (let ((at-least-one nil)
+ (forced nil)
+ (error nil))
+ (loop for kid in (module-components c)
+ do (handler-case
+ (appendf forced (traverse operation kid ))
+ (missing-dependency (condition)
+ (if (eq (module-if-component-dep-fails c) :f=
ail)
+ (error condition))
+ (setf error condition))
+ (:no-error (c)
+ (declare (ignore c))
+ (setf at-least-one t))))
+ (when (and (eq (module-if-component-dep-fails c) :try-nex=
t)
+ (not at-least-one))
+ (error error))
+ forced))))
+ ;; now the thing itself
+ (when (or forced module-ops
+ (not (operation-done-p operation c))
+ (let ((f (operation-forced (operation-ancestor operation=
))))
+ (and f (or (not (consp f))
+ (member (component-name
+ (operation-ancestor operation))
+ (mapcar #'coerce-name f)
+ :test #'string=3D)))))
+ (let ((do-first (cdr (assoc (class-name (class-of operation))
+ (slot-value c 'do-first)))))
+ (loop for (required-op . deps) in do-first
+ do (do-dep required-op deps)))
+ (setf forced (append (delete 'pruned-op forced :key #'car)
+ (delete 'pruned-op module-ops :key #'car)
+ (list (cons operation c))))))
+ (setf (visiting-component operation c) nil)
+ (visit-component operation c (and forced t))
+ forced)))
+
+
+(defmethod perform ((operation operation) (c source-file))
+ (sysdef-error
+ "~@<required method PERFORM not implemented ~
+ for operation ~A, component ~A~@:>"
+ (class-of operation) (class-of c)))
+
+(defmethod perform ((operation operation) (c module))
+ nil)
+
+(defmethod explain ((operation operation) (component component))
+ (format *verbose-out* "~&;;; ~A on ~A~%" operation component))
+
+;;; compile-op
+
+(defclass compile-op (operation)
+ ((proclamations :initarg :proclamations :accessor compile-op-proclamatio=
ns :initform nil)
+ (on-warnings :initarg :on-warnings :accessor operation-on-warnings
+ :initform *compile-file-warnings-behaviour*)
+ (on-failure :initarg :on-failure :accessor operation-on-failure
+ :initform *compile-file-failure-behaviour*)))
+
+(defmethod perform :before ((operation compile-op) (c source-file))
+ (map nil #'ensure-directories-exist (output-files operation c)))
+
+(defmethod perform :after ((operation operation) (c component))
+ (setf (gethash (type-of operation) (component-operation-times c))
+ (get-universal-time))
+ (load-preferences c operation))
+
+;;; perform is required to check output-files to find out where to put
+;;; its answers, in case it has been overridden for site policy
+(defmethod perform ((operation compile-op) (c cl-source-file))
+ #-:broken-fasl-loader
+ (let ((source-file (component-pathname c))
+ (output-file (car (output-files operation c))))
+ (multiple-value-bind (output warnings-p failure-p)
+ (compile-file source-file :output-file output-file)
+ (when warnings-p
+ (case (operation-on-warnings operation)
+ (:warn (warn
+ "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>"
+ operation c))
+ (:error (error 'compile-warned :component c :operation operation=
))
+ (:ignore nil)))
+ (when failure-p
+ (case (operation-on-failure operation)
+ (:warn (warn
+ "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>"
+ operation c))
+ (:error (error 'compile-failed :component c :operation operation=
))
+ (:ignore nil)))
+ (unless output
+ (error 'compile-error :component c :operation operation)))))
+
+(defmethod output-files ((operation compile-op) (c cl-source-file))
+ #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c=
)))
+ #+:broken-fasl-loader (list (component-pathname c)))
+
+(defmethod perform ((operation compile-op) (c static-file))
+ nil)
+
+(defmethod output-files ((operation compile-op) (c static-file))
+ nil)
+
+(defmethod input-files ((op compile-op) (c static-file))
+ nil)
+
+
+;;; load-op
+
+(defclass basic-load-op (operation) ())
+
+(defclass load-op (basic-load-op) ())
+
+(defmethod perform ((o load-op) (c cl-source-file))
+ (mapcar #'load (input-files o c)))
+
+(defmethod perform ((operation load-op) (c static-file))
+ nil)
+(defmethod operation-done-p ((operation load-op) (c static-file))
+ t)
+
+(defmethod output-files ((o operation) (c component))
+ nil)
+
+(defmethod component-depends-on ((operation load-op) (c component))
+ (cons (list 'compile-op (component-name c))
+ (call-next-method)))
+
+;;; load-source-op
+
+(defclass load-source-op (basic-load-op) ())
+
+(defmethod perform ((o load-source-op) (c cl-source-file))
+ (let ((source (component-pathname c)))
+ (setf (component-property c 'last-loaded-as-source)
+ (and (load source)
+ (get-universal-time)))))
+
+(defmethod perform ((operation load-source-op) (c static-file))
+ nil)
+
+(defmethod output-files ((operation load-source-op) (c component))
+ nil)
+
+;;; FIXME: we simply copy load-op's dependencies. this is Just Not Right.
+(defmethod component-depends-on ((o load-source-op) (c component))
+ (let ((what-would-load-op-do (cdr (assoc 'load-op
+ (slot-value c 'in-order-to)))))
+ (mapcar (lambda (dep)
+ (if (eq (car dep) 'load-op)
+ (cons 'load-source-op (cdr dep))
+ dep))
+ what-would-load-op-do)))
+
+(defmethod operation-done-p ((o load-source-op) (c source-file))
+ (if (or (not (component-property c 'last-loaded-as-source))
+ (> (file-write-date (component-pathname c))
+ (component-property c 'last-loaded-as-source)))
+ nil t))
+
+(defclass test-op (operation) ())
+
+(defmethod perform ((operation test-op) (c component))
+ nil)
+
+(defgeneric load-preferences (system operation)
+ (:documentation
+ "Called to load system preferences after <perform operation
+system>. Typical uses are to set parameters that don't exist until
+after the system has been loaded."))
+
+(defgeneric preference-file-for-system/operation (system operation)
+ (:documentation
+ "Returns the pathname of the preference file for this system.
+Called by 'load-preferences to determine what file to load."))
+
+(defmethod load-preferences ((s t) (operation t))
+ ;; do nothing
+ (values))
+
+(defmethod load-preferences ((s system) (operation basic-load-op))
+ (let* ((*package* (find-package :common-lisp))
+ (file (probe-file (preference-file-for-system/operation s operati=
on))))
+ (when file
+ (when *verbose-out*
+ (format *verbose-out*
+ "~&~@<; ~@;loading preferences for ~A/~(~A~) from ~A~@:>~%"
+ (component-name s)
+ (type-of operation) file))
+ (load file))))
+
+(defmethod preference-file-for-system/operation ((system t) (operation t))
+ ;; cope with anything other than systems
+ (preference-file-for-system/operation (find-system system t) operation))
+
+(defmethod preference-file-for-system/operation ((s system) (operation t))
+ (let ((*default-pathname-defaults*
+ (make-pathname :name nil :type nil
+ :defaults *default-pathname-defaults*)))
+ (merge-pathnames
+ (make-pathname :name (component-name s)
+ :type "lisp"
+ :directory '(:relative ".asdf"))
+ (truename (user-homedir-pathname)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; invoking operations
+
+(defvar *operate-docstring*
+ "Operate does three things:
+
+1. It creates an instance of `operation-class` using any keyword parameters
+as initargs.
+2. It finds the asdf-system specified by `system` (possibly loading
+it from disk).
+3. It then calls `traverse` with the operation and system as arguments
+
+The traverse operation is wrapped in `with-compilation-unit` and error
+handling code. If a `version` argument is supplied, then operate also
+ensures that the system found satisfies it using the `version-satisfies`
+method.")
+
+(defun operate (operation-class system &rest args &key (verbose t) version
+ &allow-other-keys)
+ (let* ((op (apply #'make-instance operation-class
+ :original-initargs args
+ args))
+ (*verbose-out* (if verbose *standard-output* (make-broadcast-stre=
am)))
+ (system (if (typep system 'component) system (find-system system)=
)))
+ (unless (version-satisfies system version)
+ (error 'missing-component :requires system :version version))
+ (let ((steps (traverse op system)))
+ (with-compilation-unit ()
+ (loop for (op . component) in steps do
+ (loop
+ (restart-case
+ (progn (perform op component)
+ (return))
+ (retry ()
+ :report
+ (lambda (s)
+ (format s "~@<Retry performing ~S on ~S.~@:>"
+ op component)))
+ (accept ()
+ :report
+ (lambda (s)
+ (format s "~@<Continue, treating ~S on ~S as ~
+ having been successful.~@:>"
+ op component))
+ (setf (gethash (type-of op)
+ (component-operation-times component=
))
+ (get-universal-time))
+ (return)))))))))
+
+(setf (documentation 'operate 'function)
+ *operate-docstring*)
+
+(defun oos (operation-class system &rest args &key force (verbose t) versi=
on)
+ (declare (ignore force verbose version))
+ (apply #'operate operation-class system args))
+
+(setf (documentation 'oos 'function)
+ (format nil
+ "Short for _operate on system_ and an alias for the `operate=
` function. ~&~&~a"
+ *operate-docstring*))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; syntax
+
+(defun remove-keyword (key arglist)
+ (labels ((aux (key arglist)
+ (cond ((null arglist) nil)
+ ((eq key (car arglist)) (cddr arglist))
+ (t (cons (car arglist) (cons (cadr arglist)
+ (remove-keyword
+ key (cddr arglist))))))))
+ (aux key arglist)))
+
+(defmacro defsystem (name &body options)
+ (destructuring-bind (&key (pathname nil pathname-arg-p) (class 'system)
+ &allow-other-keys)
+ options
+ (let ((component-options (remove-keyword :class options)))
+ `(progn
+ ;; system must be registered before we parse the body, otherwise
+ ;; we recur when trying to find an existing system of the same na=
me
+ ;; to reuse options (e.g. pathname) from
+ (let ((s (system-registered-p ',name)))
+ (cond ((and s (eq (type-of (cdr s)) ',class))
+ (setf (car s) (get-universal-time)))
+ (s
+ #+clisp
+ (sysdef-error "Cannot redefine the existing system ~A wi=
th a different class" s)
+ #-clisp
+ (change-class (cdr s) ',class))
+ (t
+ (register-system (quote ,name)
+ (make-instance ',class :name ',name)))))
+ (parse-component-form nil (apply
+ #'list
+ :module (coerce-name ',name)
+ :pathname
+ ;; to avoid a note about unreachable c=
ode
+ ,(if pathname-arg-p
+ pathname
+ `(or (when *load-truename*
+ (pathname-sans-name+type
+ (resolve-symlinks
+ *load-truename*)))
+ *default-pathname-defaults*))
+ ',component-options))))))
+
+
+(defun class-for-type (parent type)
+ (let* ((extra-symbols (list (find-symbol (symbol-name type) *package*)
+ (find-symbol (symbol-name type)
+ (load-time-value
+ (package-name :asdf)))))
+ (class (dolist (symbol (if (keywordp type)
+ extra-symbols
+ (cons type extra-symbols)))
+ (when (and symbol
+ (find-class symbol nil)
+ (subtypep symbol 'component))
+ (return (find-class symbol))))))
+ (or class
+ (and (eq type :file)
+ (or (module-default-component-class parent)
+ (find-class 'cl-source-file)))
+ (sysdef-error "~@<don't recognize component type ~A~@:>" type))))
+
+(defun maybe-add-tree (tree op1 op2 c)
+ "Add the node C at /OP1/OP2 in TREE, unless it's there already.
+Returns the new tree (which probably shares structure with the old one)"
+ (let ((first-op-tree (assoc op1 tree)))
+ (if first-op-tree
+ (progn
+ (aif (assoc op2 (cdr first-op-tree))
+ (if (find c (cdr it))
+ nil
+ (setf (cdr it) (cons c (cdr it))))
+ (setf (cdr first-op-tree)
+ (acons op2 (list c) (cdr first-op-tree))))
+ tree)
+ (acons op1 (list (list op2 c)) tree))))
+
+(defun union-of-dependencies (&rest deps)
+ (let ((new-tree nil))
+ (dolist (dep deps)
+ (dolist (op-tree dep)
+ (dolist (op (cdr op-tree))
+ (dolist (c (cdr op))
+ (setf new-tree
+ (maybe-add-tree new-tree (car op-tree) (car op) c))))))
+ new-tree))
+
+
+(defun remove-keys (key-names args)
+ (loop for ( name val ) on args by #'cddr
+ unless (member (symbol-name name) key-names
+ :key #'symbol-name :test 'equal)
+ append (list name val)))
+
+(defvar *serial-depends-on*)
+
+(defun parse-component-form (parent options)
+
+ (destructuring-bind
+ (type name &rest rest &key
+ ;; the following list of keywords is reproduced below in the
+ ;; remove-keys form. important to keep them in sync
+ components pathname default-component-class
+ perform explain output-files operation-done-p
+ weakly-depends-on
+ depends-on serial in-order-to
+ ;; list ends
+ &allow-other-keys) options
+ (declare (ignorable perform explain output-files operation-done-p))
+ (check-component-input type name weakly-depends-on depends-on componen=
ts in-order-to)
+
+ (when (and parent
+ (find-component parent name)
+ ;; ignore the same object when rereading the defsystem
+ (not
+ (typep (find-component parent name)
+ (class-for-type parent type))))
+ (error 'duplicate-names :name name))
+
+ (let* ((other-args (remove-keys
+ '(components pathname default-component-class
+ perform explain output-files operation-done-p
+ weakly-depends-on
+ depends-on serial in-order-to)
+ rest))
+ (ret
+ (or (find-component parent name)
+ (make-instance (class-for-type parent type)))))
+ (when weakly-depends-on
+ (setf depends-on (append depends-on (remove-if (complement #'find-=
system) weakly-depends-on))))
+ (when (boundp '*serial-depends-on*)
+ (setf depends-on
+ (concatenate 'list *serial-depends-on* depends-on)))
+ (apply #'reinitialize-instance ret
+ :name (coerce-name name)
+ :pathname pathname
+ :parent parent
+ other-args)
+ (when (typep ret 'module)
+ (setf (module-default-component-class ret)
+ (or default-component-class
+ (and (typep parent 'module)
+ (module-default-component-class parent))))
+ (let ((*serial-depends-on* nil))
+ (setf (module-components ret)
+ (loop for c-form in components
+ for c =3D (parse-component-form ret c-form)
+ collect c
+ if serial
+ do (push (component-name c) *serial-depends-on*))))
+
+ ;; check for duplicate names
+ (let ((name-hash (make-hash-table :test #'equal)))
+ (loop for c in (module-components ret)
+ do
+ (if (gethash (component-name c)
+ name-hash)
+ (error 'duplicate-names
+ :name (component-name c))
+ (setf (gethash (component-name c)
+ name-hash)
+ t)))))
+
+ (setf (slot-value ret 'in-order-to)
+ (union-of-dependencies
+ in-order-to
+ `((compile-op (compile-op , at depends-on))
+ (load-op (load-op , at depends-on))))
+ (slot-value ret 'do-first) `((compile-op (load-op , at depends-on=
))))
+
+ (%remove-component-inline-methods ret rest)
+
+ ret)))
+
+(defun %remove-component-inline-methods (ret rest)
+ (loop for name in +asdf-methods+
+ do (map 'nil
+ ;; this is inefficient as most of the stored
+ ;; methods will not be for this particular gf n
+ ;; But this is hardly performance-critical
+ (lambda (m)
+ (remove-method (symbol-function name) m))
+ (component-inline-methods ret)))
+ ;; clear methods, then add the new ones
+ (setf (component-inline-methods ret) nil)
+ (loop for name in +asdf-methods+
+ for v =3D (getf rest (intern (symbol-name name) :keyword))
+ when v do
+ (destructuring-bind (op qual (o c) &body body) v
+ (pushnew
+ (eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret)))
+ , at body))
+ (component-inline-methods ret)))))
+
+(defun check-component-input (type name weakly-depends-on depends-on compo=
nents in-order-to)
+ "A partial test of the values of a component."
+ (when weakly-depends-on (warn "We got one! XXXXX"))
+ (unless (listp depends-on)
+ (sysdef-error-component ":depends-on must be a list."
+ type name depends-on))
+ (unless (listp weakly-depends-on)
+ (sysdef-error-component ":weakly-depends-on must be a list."
+ type name weakly-depends-on))
+ (unless (listp components)
+ (sysdef-error-component ":components must be NIL or a list of componen=
ts."
+ type name components))
+ (unless (and (listp in-order-to) (listp (car in-order-to)))
+ (sysdef-error-component ":in-order-to must be NIL or a list of compone=
nts."
+ type name in-order-to)))
+
+(defun sysdef-error-component (msg type name value)
+ (sysdef-error (concatenate 'string msg
+ "~&The value specified for ~(~A~) ~A is ~W")
+ type name value))
+
+(defun resolve-symlinks (path)
+ #-allegro (truename path)
+ #+allegro (excl:pathname-resolve-symbolic-links path)
+ )
+
+;;; optional extras
+
+;;; run-shell-command functions for other lisp implementations will be
+;;; gratefully accepted, if they do the same thing. If the docstring
+;;; is ambiguous, send a bug report
+
+(defun run-shell-command (control-string &rest args)
+ "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
+synchronously execute the result using a Bourne-compatible shell, with
+output to *VERBOSE-OUT*. Returns the shell's exit code."
+ (let ((command (apply #'format nil control-string args)))
+ (format *verbose-out* "; $ ~A~%" command)
+ #+sbcl
+ (sb-ext:process-exit-code
+ (sb-ext:run-program
+ #+win32 "sh" #-win32 "/bin/sh"
+ (list "-c" command)
+ #+win32 #+win32 :search t
+ :input nil :output *verbose-out*))
+
+ #+(or cmu scl)
+ (ext:process-exit-code
+ (ext:run-program
+ "/bin/sh"
+ (list "-c" command)
+ :input nil :output *verbose-out*))
+
+ #+allegro
+ (excl:run-shell-command command :input nil :output *verbose-out*)
+
+ #+lispworks
+ (system:call-system-showing-output
+ command
+ :shell-type "/bin/sh"
+ :output-stream *verbose-out*)
+
+ #+clisp ;XXX not exactly *verbose-out*, I know
+ (ext:run-shell-command command :output :terminal :wait t)
+
+ #+openmcl
+ (nth-value 1
+ (ccl:external-process-status
+ (ccl:run-program "/bin/sh" (list "-c" command)
+ :input nil :output *verbose-out*
+ :wait t)))
+ #+ecl ;; courtesy of Juan Jose Garcia Ripoll
+ (si:system command)
+ #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl)
+ (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
+ ))
+
+
+(defgeneric hyperdocumentation (package name doc-type))
+(defmethod hyperdocumentation ((package symbol) name doc-type)
+ (hyperdocumentation (find-package package) name doc-type))
+
+(defun hyperdoc (name doc-type)
+ (hyperdocumentation (symbol-package name) name doc-type))
+
+(defun system-source-file (system-name)
+ (let ((system (asdf:find-system system-name)))
+ (make-pathname
+ :type "asd"
+ :name (asdf:component-name system)
+ :defaults (asdf:component-relative-pathname system))))
+
+(defun system-source-directory (system-name)
+ (make-pathname :name nil
+ :type nil
+ :defaults (system-source-file system-name)))
+
+(defun system-relative-pathname (system pathname &key name type)
+ (let ((directory (pathname-directory pathname)))
+ (when (eq (car directory) :absolute)
+ (setf (car directory) :relative))
+ (merge-pathnames
+ (make-pathname :name (or name (pathname-name pathname))
+ :type (or type (pathname-type pathname))
+ :directory directory)
+ (system-source-directory system))))
+
+
+(pushnew :asdf *features*)
+
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (sb-ext:posix-getenv "SBCL_BUILDING_CONTRIB")
+ (pushnew :sbcl-hooks-require *features*)))
+
+#+(and sbcl sbcl-hooks-require)
+(progn
+ (defun module-provide-asdf (name)
+ (handler-bind ((style-warning #'muffle-warning))
+ (let* ((*verbose-out* (make-broadcast-stream))
+ (system (asdf:find-system name nil)))
+ (when system
+ (asdf:operate 'asdf:load-op name)
+ t))))
+
+ (defun contrib-sysdef-search (system)
+ (let ((home (sb-ext:posix-getenv "SBCL_HOME")))
+ (when (and home (not (string=3D home "")))
+ (let* ((name (coerce-name system))
+ (home (truename home))
+ (contrib (merge-pathnames
+ (make-pathname :directory `(:relative ,name)
+ :name name
+ :type "asd"
+ :case :local
+ :version :newest)
+ home)))
+ (probe-file contrib)))))
+
+ (pushnew
+ '(let ((home (sb-ext:posix-getenv "SBCL_HOME")))
+ (when (and home (not (string=3D home "")))
+ (merge-pathnames "site-systems/" (truename home))))
+ *central-registry*)
+
+ (pushnew
+ '(merge-pathnames ".sbcl/systems/"
+ (user-homedir-pathname))
+ *central-registry*)
+
+ (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*)
+ (pushnew 'contrib-sysdef-search *system-definition-search-functions*))
+
+(provide 'asdf)
More information about the Openmcl-cvs-notifications
mailing list