5 #DECL ((ATM) <UNSPECIAL ATOM>)
8 <OR <TYPE? ,.ATM FUNCTION>
11 <DEFINE PREV (LS SUBLS)
12 #DECL ((LS SUBLS) <UNSPECIAL LIST> (VALUE) LIST)
13 <REST .LS <- <LENGTH .LS> <LENGTH .SUBLS> 1>>>
15 <DEFINE SPLOUTEM (FL OU)
16 #DECL ((FL) <UNSPECIAL LIST> (OU) <UNSPECIAL ATOM>)
18 #DECL ((TEM) <UNSPECIAL <PRIMTYPE LIST>>)
19 <COND (<EMPTY? .FL> <RETURN T>)
20 (<SET TEM <MEMQ .OU <1 .FL>>>
21 <COND (<==? <1 .FL> .TEM> <PUT .FL 1 <REST .TEM>>)
22 (ELSE <PUTREST <PREV <1 .FL> .TEM> <REST .TEM>>)>)>
23 <SET FL <REST .FL 2>>>>
26 #DECL ((LS) <UNSPECIAL LIST>)
27 <REPEAT ((RES ()) (TEM ()))
28 #DECL ((RES TEM) LIST)
29 <COND (<EMPTY? .LS> <RETURN .RES>)>
31 <SET RES <PUTREST .LS .RES>>
34 <DEFINE ORDEREM (FLIST)
35 #DECL ((FLIST) <UNSPECIAL LIST>)
36 <REPEAT (TEM (RES ()))
37 #DECL ((RES) <UNSPECIAL <LIST [REST <OR ATOM LIST>]>>
38 (VALUE) <LIST [REST <OR ATOM LIST>]>
39 (TEM) <UNSPECIAL <PRIMTYPE LIST>>)
41 (<EMPTY? .FLIST> <RETURN <REVERSE .RES>>)
42 (<SET TEM <MEMQ () .FLIST>>
43 <SET RES (<2 .TEM> !.RES)>
44 <COND (<==? .TEM .FLIST> <SET FLIST <REST .FLIST 2>>)
45 (ELSE <PUTREST <PREV .FLIST .TEM> <REST .TEM 2>>)>
46 <SPLOUTEM .FLIST <1 .RES>>)
48 <PROG ((RES2 ()) GOTONE)
51 <REPEAT ((RES1 .FLIST))
53 <COND (<NOT <CALLME <2 .RES1> .FLIST>>
55 <SET RES2 (<2 .RES1> !.RES2)>
56 <COND (<==? .FLIST .RES1>
57 <SET FLIST <REST .FLIST 2>>)
59 <PUTREST <PREV .FLIST .RES1>
61 <AND <EMPTY? <SET RES1 <REST .RES1 2>>> <RETURN>>>
62 <COND (.GOTONE <AGAIN>)
63 (<NOT <EMPTY? .FLIST>> <SET FLIST <CORDER .FLIST>>)>
64 <SET TEM <REVERSE .RES>>
65 <COND (<NOT <EMPTY? .FLIST>>
68 <SET RES <REST .FLIST <- <LENGTH .FLIST> 1>>>)
71 <REST <PUTREST .RES .FLIST>
73 <COND (<EMPTY? .RES> <SET RES .RES2>)
74 (ELSE <PUTREST .RES .RES2> <SET RES .TEM>)>>
77 <DEFINE CALLME (ATM LST)
78 #DECL ((ATM) ATOM (LST) <LIST [REST <LIST [REST ATOM]> ATOM]>)
80 <AND <EMPTY? .LST> <RETURN <>>>
81 <AND <MEMQ .ATM <1 .LST>> <RETURN>>
82 <SET LST <REST .LST 2>>>>
84 <DEFINE CORDER (LST "AUX" (RES ()))
85 #DECL ((LST) <LIST [REST <LIST [REST ATOM]> ATOM]> (RES) LIST)
87 #DECL ((LS) <LIST [REST LIST ATOM]>)
88 <AND <EMPTY? .LS> <RETURN>>
89 <PUT .LS 1 <ALLREACH (<2 .LS>) <1 .LS> .LST>>
90 <SET LS <REST .LS 2>>>
92 #DECL ((PNT) <LIST [REST LIST ATOM]>)
93 <REPEAT ((SHORT <CHTYPE <MIN> FIX>) (TL 0) (LST .LST))
94 #DECL ((SHORT TL) FIX (LST) <LIST [REST LIST ATOM]>)
95 <AND <EMPTY? .LST> <RETURN>>
96 <COND (<L? <SET TL <LENGTH <1 .LST>>> .SHORT>
99 <SET LST <REST .LST 2>>>
101 (<COND (<1? <LENGTH <1 .PNT>>> <1 <1 .PNT>>)
104 <MAPF <> <FUNCTION (ATM) <SPLOUTEM .LST .ATM>> <1 .PNT>>
106 <COND (<SET TEM <MEMQ () .LST>>
107 <COND (<==? .TEM .LST> <SET LST <REST .TEM 2>>)
109 <PUTREST <PREV .LST .TEM>
112 <AND <EMPTY? .LST> <RETURN>>>
115 <DEFINE ALLREACH (LATM LST MLST)
116 #DECL ((LATM LST) <LIST [REST ATOM]>
117 (MLST) <LIST [REST <LIST [REST ATOM]> ATOM]>)
121 <COND (<MEMQ .ATM .LATM>)
124 <ALLREACH (.ATM !.LATM)
126 #DECL ((L) <LIST [REST LIST ATOM]>)
127 <AND <==? <2 .L> .ATM>
134 <DEFINE REMEMIT (ATM)
135 #DECL ((ATM) ATOM (FUNC) <SPECIAL ATOM>
136 (FUNCL) <SPECIAL <LIST [REST ATOM]>>)
139 <SET FUNCL (.ATM !.FUNCL)>>>
141 <DEFINE FINDREC (OBJ "AUX" (FM '<>))
143 <COND (<MONAD? .OBJ>)
144 (<AND <TYPE? .OBJ FORM SEGMENT>
145 <NOT <EMPTY? <SET FM <CHTYPE .OBJ FORM>>>>>
146 <COND (<AND <TYPE? <1 .FM> ATOM> <GASSIGNED? <1 .FM>>>
147 <AND <TYPE? ,<1 .FM> FUNCTION> <REMEMIT <1 .FM>>>
148 <AND <TYPE? ,<1 .FM> MACRO>
149 <NOT <EMPTY? ,<1 .FM>>>
150 <FINDREC <EMACRO .FM>>>
151 ;"Analyze expansion of MACRO call"
152 <AND <OR <==? ,<1 .FM> ,MAPF> <==? ,<1 .FM> ,MAPR>>
153 <NOT <LENGTH? .FM 3>>
155 <AND <TYPE? <2 .FM> FORM> <CHK-GVAL <2 .FM>>>
158 <AND <TYPE? <3 .FM> FORM>
159 <CHK-GVAL <3 .FM>>>>>)
160 (<STRUCTURED? <1 .OBJ>> <MAPF <> ,FINDREC <1 .OBJ>>)>
161 <COND (<EMPTY? <REST .OBJ>>)
162 (ELSE <MAPF <> ,FINDREC <REST .OBJ>>)>)
163 (ELSE <MAPF <> ,FINDREC .OBJ>)>>
165 <DEFINE EMACRO (OBJ "AUX" (ERR <GET ERROR!-INTERRUPTS INTERRUPT>) TEM)
166 <COND (.ERR <OFF .ERR>)>
168 <FUNCTION (FR "TUPLE" T)
169 <COND (<AND <GASSIGNED? MACACT> <LEGAL? ,MACACT>>
170 <DISMISS [!.T] ,MACACT>)
171 (ELSE <APPLY ,<PARSE "OVALRET!-COMBAT!-"> " ">)>>
173 <COND (<TYPE? <SET TEM
174 <PROG MACACT () #DECL ((MACACT) <SPECIAL ACTIVATION>)
175 <SETG MACACT .MACACT>
179 <COND (.ERR <EVENT .ERR>)>
180 <ERROR " MACRO EXPANSION LOSSAGE " !.TEM>)
181 (ELSE <OFF "ERROR"> <AND .ERR <EVENT .ERR>> <1 .TEM>)>>
183 <DEFINE CHK-GVAL (FM) #DECL ((FM) FORM)
184 <AND <==? <LENGTH .FM> 2>
189 <OR <TYPE? ,<2 .FM> FUNCTION>
190 <AND <TYPE? ,<2 .FM> MACRO>
191 <NOT <EMPTY? ,<2 .FM>>>
192 <TYPE? <1 ,<2 .FM>> FUNCTION>>>
195 <DEFINE FINDEM (FUNC "AUX" (FUNCL ()))
196 #DECL ((FUNC) <SPECIAL ATOM> (FUNCL) <SPECIAL <LIST [REST ATOM]>>
197 (VALUE) <LIST [REST ATOM]>)
201 <DEFINE FINDEMALL (ATM
206 <LIST <LIST [REST ATOM]> ATOM>)
207 <AND <EMPTY? .ATM> <RETURN .TD>>
208 <SET TD (<FINDEM <1 .ATM>> <1 .ATM> !.TD)>
209 <SET ATM <REST .ATM>>>))
210 #DECL ((ATM) <UNSPECIAL <TUPLE [REST ATOM]>>
211 (TOPDO) <UNSPECIAL <LIST <LIST [REST ATOM]> ATOM>>)
212 <REPEAT ((TODO .TOPDO) (CURDO <1 .TOPDO>))
213 #DECL ((TODO) <UNSPECIAL LIST>
214 (CURDO) <UNSPECIAL <LIST [REST ATOM]>>)
215 <COND (<EMPTY? .CURDO>
216 <COND (<EMPTY? <SET TODO <REST .TODO 2>>>
218 (ELSE <SET CURDO <1 .TODO>> <AGAIN>)>)
219 (<MEMQ <1 .CURDO> .TOPDO>)
221 <PUTREST <REST .TODO <- <LENGTH .TODO> 1>>
222 (<FINDEM <1 .CURDO>> <1 .CURDO>)>)>
223 <SET CURDO <REST .CURDO>>>>
225 <DEFINE GETORDER ("TUPLE" ATMS)
226 #DECL ((ATMS) <UNSPECIAL <TUPLE [REST ATOM]>>)
227 <COND (<NOT <MEMQ #FALSE () <MAPF ,LIST ,CHECK .ATMS>>>
228 <ORDEREM <FINDEMALL .ATMS>>)
229 (ELSE <ERROR BAD-ARG GETORDER>)>>
233 <SET LIST_OF_FUNCTIONS