2 <FUNCTION (FUNNAME DEF)
9 <COND (<0? .N> <FRAME>)
10 (T <FRAME <FRAMEN <- .N 1>>>)>>>
\e
24 <RESTORE .FP (FAILURE CAUGHT WITH M = .M AND A = .A)>> >>
29 <FUNCTION (VAR\ VAL "AUX" (OV <RLVAL .VAR\ >))
31 <SET .VAR\ <RLVAL VAL>>
33 <SET .VAR\ <RLVAL OV>>
39 <COND (<EMPTY? .L> .L)
41 <CHTYPE <REST .L> <TYPE .L>>)
42 (T <THDELQ1 .ELT .L>) >>>
47 <COND (<EMPTY? <REST .L>> .L)
48 (<==? <2 .L> .ELT> <THPUTREST .L <REST .L 2>>)
49 (T <THDELQ1 .ELT <REST .L>>) > >>
53 <FUNCTION (LIST1 LIST2)
54 <FAILPOINT ((OREST <REST .LIST1>))
55 <PUTREST .LIST1 .LIST2>
57 <PUTREST .LIST1 .OREST>
62 <FUNCTION (THING IND "OPTIONAL" PROP)
63 <FAILPOINT ((OPROP <GET .THING .IND>))
64 <COND (<ASSIGNED? PROP>
65 <PUT .THING .IND .PROP>)
66 (T <PUT .THING .IND>) >
68 <COND (.OPROP <PUT .THING .IND .OPROP>)
74 <FUNCTION (LOC VAL "AUX" (OVAL <IN .LOC>))
76 <SETLOC .LOC <RLVAL VAL>>
78 <SETLOC .LOC <RLVAL OVAL>>
79 <FAIL .M .A> >>>
\f<DEFINE FALSE
80 <FUNCTION ("ARGS" A) <CHTYPE <EVAL .A> FALSE> >>
84 <FUNCTION ("ARGS" A) <CHTYPE <EVAL .A> FORM> >>
87 <FUNCTION ("ARGS" A) <CHTYPE <EVAL .A> UNASSIGNED> >>
90 <FUNCTION ("REST" 'A) <CHTYPE <EVAL .A> SEGMENT> >>
94 <GET .TYPE 'CONSTRUCTOR> >>
97 <PUT LIST CONSTRUCTOR ,CONSL>
98 <PUT FORM CONSTRUCTOR ,FORM>
99 <PUT FALSE CONSTRUCTOR ,FALSE>
100 <PUT VECTOR CONSTRUCTOR ,CONSV>
101 <PUT SEGMENT CONSTRUCTOR ,SEGMENT>
102 <PUT UVECTOR CONSTRUCTOR ,CONSU>
108 <COND (<GASSIGNED? .ATOM> <GVAL .ATOM>)
112 <FAILPOINT CLIPPER ((VAL ..VAR))
115 <COND (<EMPTY? .VAL> <FAIL>)
118 <SET .VAR <SET VAL <REST .VAL>>>>>) >> >>
122 <FUNCTION (FOO) <NOT <EMPTY? <RLVAL FOO>>>>>
126 <FUNCTION ACT (CURRENTENV NEWENV)
127 <PROG1 <SPLICE .CURRENTENV .NEWENV>
132 <FUNCTION ("BIND" FOO) .FOO>>
\f<DEFINE RESET
134 <FAILPOINT ((VAL <RLVAL .VAR>)) <> ()
135 <SET .VAR <RLVAL VAL>>
139 <FUNCTION ("REST" A) <1 .A> >>
143 <FUNCTION ("REST" A) <2 .A> >>
\f<DEFINE MULTILEVEL
145 <AND <NOT <MONAD? .OBJECT>>
146 <MEMQ <TYPE .OBJECT> '(LIST FORM VECTOR SEGMENT VECTOR)>> >>
149 <FUNCTION REV (L "OPTIONAL" (CFUNC <CONSTRUCTOR <TYPE .L>>)
151 <COND (<EMPTY? .L> <.CFUNC !.RESULT>)
152 (T <SET RESULT (<1 .L> !.RESULT)>
158 <FUNCTION ("REST" LSTUPL)
159 <COND (<EMPTY? .LSTUPL> ())
160 (T <CHTYPE <NCONC1 .LSTUPL> <TYPE <1 .LSTUPL>>>) >>>
165 <COND (<EMPTY? <REST .LSTUPL>> <1 .LSTUPL>)
166 (T <NCONC2 <1 .LSTUPL> <REST .LSTUPL>>) >>>
171 <COND (<EMPTY? .L1> <NCONC1 .LREST>)
172 (T <PUTREST .L1 <NCONC2 <REST .L1> .LREST>>) >>>
\f<DEFINE ANOTHER
173 <FUNCTION (OBJ BOUND)
176 <AND <==? .OBJ .BOUND> <FAIL>>
177 <RESTORE .FP <SET OBJ <REST .OBJ>>>> >>
181 <FUNCTION MAPPER (FUN "REST" EXPS "AUX" (RESULT ()) RES1 LAS)
182 <SET RES1 <APPLY .FUN <LISTFIRSTS .EXPS>>>
183 <COND (<EMPTY? .RESULT>
184 <SET LAS <SET RESULT (.RES1)>>)
185 (T <PUTREST .LAS <SET LAS (.RES1)>>) >
190 <FUNCTION MAPPER (FUN "REST" EXPS "AUX" (RESULT ()))
191 <REPEAT () <APPLY .FUN <LISTFIRSTS .EXPS>>> >>
195 <FUNCTION MAPPER (FUN "REST" EXPS
196 "AUX" (RESULT ()) RES1 LAS1)
197 <SET RES1 <APPLY .FUN <LISTFIRSTS .EXPS>>>
198 <COND (<EMPTY? .RESULT>
200 (T <PUTREST .LAS1 .RES1>) >
201 <SET LAS1 <LAST .RES1>>
207 <COND (<EMPTY? .EXPTUPL> ())
208 (<EMPTY? <SET RES1 <1 .EXPTUPL>>> <.MAPPER .RESULT>)
210 <PUT .EXPTUPL 1 <REST .RES1>>>
211 !<LISTFIRSTS <REST .EXPTUPL>>)) > >>
216 <COND (<EMPTY? .EXP> ())
217 (<EMPTY? <REST .EXP>> .EXP)
218 (T <SET EXP <REST .EXP>>
219 <AGAIN .L>) >>>
\f<DEFINE BOTTOM
221 <COND (<MONAD? .THING> .THING)
222 (<==? <TYPE .THING> LIST> ())
223 (T <REST .THING <LENGTH .THING>>)> >>
229 <FUNCTION (VEC "REST" VARS)
230 <MAPC ,SET .VARS .VEC> >>
\f\ 3\f