3 <COND (<0? .N> <FRAME>)
4 (T <FRAME <FRAMEN <- .N 1>>>)>>>
\e
18 <RESTORE .FP (FAILURE CAUGHT WITH M = .M AND A = .A)>> >>
23 <FUNCTION (VAR VAL "AUX" (OV <RLVAL .VAR>))
25 <SET .VAR <RLVAL VAL>>
32 <FUNCTION ("BIND" CUR EXP "OPTIONAL" (ENV <>)
33 "AUX" (TP <TYPE .EXP>) VAL EXP1)
36 <EVAL <CHTYPE <INSTANTIATE <CHTYPE .EXP LIST>>
38 (<MEMQ .TP '(ACTORFORM SACTORFORM)>
39 <COND (<==? <SET EXP1 <1 .EXP>> GIVEN>
40 <OR <AND <ASSIGNED? <2 .EXP>>
45 <CHTYPE (GIVEN <2 .EXP>) .TP>)
47 <FAILPOINT FP ((PATS <REST .EXP>) P1)
49 <AND <EMPTY? .PATS> <FAIL>>
51 <SET PATS <REST .PATS>>
52 <RESTORE .FP <INSTANTIATE .P1>>>)
54 <OR <EVAL <2 .EXP>> <FAIL>>
57 <OR <AND <EMPTY? <REST .EXP>> .EXP>
58 <REPEAT R ((P1 <2 .EXP>) (PATS <REST .EXP 2>))
60 <EXIT .R <INSTANTIATE .P1>>>
61 <MATCH1 .P1 <1 .PATS>>
62 <SET PATS <REST .EXP>> >>)
65 (<==? <TYPE <SET EXP1 <1 .EXP>> > SEGMENT>
66 (!<EVAL <CHTYPE .EXP1 FORM>>
67 !<INSTANTIATE <REST .EXP>>))
68 (<==? <TYPE .EXP1> SACTORFORM>
69 <SET VAL <INSTANTIATE .EXP1>>
70 <OR <AND <MEMQ <TYPE .VAL> '(ACTORFORM SACTORFORM)>
71 (<CHTYPE .VAL SACTORFORM>
72 !<INSTANTIATE <REST .EXP>>)>
73 (!.VAL !<INSTANTIATE <REST .EXP>>)>)
74 (T (<INSTANTIATE .EXP1> !<INSTANTIATE <REST .EXP>>))> >>
\f<SETG FALSE
75 <FUNCTION ("ARGS" A) <CHTYPE <EVAL .A> FALSE> >>
79 <FUNCTION ("ARGS" A) <CHTYPE <EVAL .A> FORM> >>
82 <FUNCTION ("ARGS" A) <CHTYPE <EVAL .A> UNASSIGNED> >>
85 <FUNCTION ("REST" 'A) <CHTYPE <EVAL .A> SEGMENT> >>
88 <FUNCTION ("ARGS" A) <CHTYPE .A ACTOR> >>
91 <FUNCTION ("ARGS" A) <CHTYPE .A ACTOR-FUNCTION> >>
94 <FUNCTION ("BIND" CUR AFORM OBJECT
95 "OPTIONAL" (BOUNDARY <BOTTOM .OBJECT>) (OBLIGATORY T) (ENV <>)
98 <COND (<ATOM? <1 .AFORM>>
99 <SET ACTOR <AVAL <1 .AFORM>>>)
100 (<SET ACTOR <EVAL <1 .AFORM>>>)>
101 <COND (<==? <TYPE .ACTOR> ACTOR-FUNCTION>
102 <EVAL <FORM <CHTYPE .ACTOR FUNCTION>
107 (<==? <TYPE .ACTOR> ACTOR>
108 <ERROR ATTEMPT-TO-INVOKE-ACTOR>)
109 (<ERROR NON-INVOKABLE-TYPE>)> >>
114 <COND (<GASSIGNED? .ATOM> <GVAL .ATOM>)
120 <AND <ATOM? .EXP> <SET EXP <AVAL .EXP>>>
121 <MEMQ <TYPE .EXP> '(ACTOR ACTOR-FUNCTION)> >>
\f<SETG ACTORSUBST1
122 <FUNCTION AS (AFORM PURESWITCH
123 "AUX" (A1 <1 .AFORM>) (TP <TYPE .AFORM>)
124 (A2 <OR <EMPTY? <REST .AFORM>> <2 .AFORM>>))
125 <COND (<==? .A1 GIVEN>
126 <COND (<ASSIGNED? .A2>
129 (T <SET .PURESWITCH <FALSE .A2>>
133 <SET .PURESWITCH <FALSE .A2>>
134 <CHTYPE (GIVEN .A2) .TP>)
136 <PROG ((PAT <ANOTHERPAT <REST .AFORM> .PURESWITCH>))
137 <COND (<OR ..PURESWITCH
138 <NOT <==? <TYPE .PAT> FORM>>>
140 (<CHTYPE .PAT .TP>)>>)
142 <OR <EVAL .A2> <FAIL>>
145 <AND <EMPTY? <REST .AFORM>>
146 <EXIT .AS <CHTYPE '<?> .TP>>>
147 <REPEAT R ((PATS <REST .AFORM 2>) (SPATS ())
149 <COND (<EMPTY? <SET BEG <CHOMP PATS .BEG P>>>
151 <EXIT .R <CHTYPE (ET !.SPATS) .TP>>)
152 (<OR .P <NOT <EMPTY? .P>>>
156 <AND <EMPTY? .SPATS> <EXIT .RESTRICT <>>>
157 <MATCH1 .A2 <1 .SPATS>>
158 <SET SPATS <REST .SPATS>> >
160 <AND <EMPTY? <SET BEG <CHOMP PATS .BEG P>>>
162 <MATCH1 .A2 <1 .BEG>> >)
163 (T <SET SPATS (<1 .BEG> !.SPATS)>)> >)
164 (.AFORM)> >>
\f<SETG ANOTHERPAT
165 <FUNCTION (PATSVAL PURESWITCH
166 "AUX" (VAL1 <CLIP PATSVAL>))
167 <COND (<SET .PURESWITCH <MONAD? .VAL1>>
169 (<==? <TYPE .VAL1> FORM>
170 <COND (<ACTOR? <1 .VAL1>>
171 <ACTORSUBST1 .VAL1 .PURESWITCH>)
173 <EVAL <ACTORSUBST .VAL1>>) >)
178 <FUNCTION (VAR "AUX" (VAL ..VAR))
179 <COND (<EMPTY? .VAL> <FAIL>)>
180 <PROG1 <1 .VAL> <SET .VAR <REST .VAL>>> >>
\f<SETG CHOMP
181 <FUNCTION CHOMP ("BIND" C VAR ENDVAR BEG PURESWITCH "OPTIONAL" (ENV <>)
182 "AUX" (VAL ..VAR) VAL1)
183 <COND (<OR <EMPTY? .BEG>
184 <EMPTY? <SET BEG <REST .BEG>>>
186 <COND (<OR <MONAD? .VAL> <==? .VAL .ENDVAR>>
189 <THSET .VAR <REST .VAL>>
190 <COND (<SET .PURESWITCH <MONAD? <SET VAL1 <1 .VAL>>>>
192 (<==? <TYPE .VAL1> FORM>
194 (<COND (<ACTOR? <1 .VAL1>>
195 <ACTORSUBST1 .VAL1 .PURESWITCH>)
197 <EVAL <ACTORSUBST .VAL1 >>) >))
198 (<==? <TYPE .VAL1> SEGMENT>
201 <COND (<ACTOR? <1 .VAL1>>
202 <SET VAL1 <ACTORSUBST1 .VAL1 .PURESWITCH>>
203 <OR <AND <OR ..PURESWITCH
204 <NOT <==? <TYPE .VAL1> SEGMENT>>>
208 <EVAL <ACTORSUBST .VAL1>>) >>
209 <COND (<EMPTY? .VAL1>
211 <SET .VAR <SET VAL <REST .VAL>>>
219 <FAILPOINT ((VAL <RLVAL .VAR>)) <> ()
220 <SET .VAR <RLVAL VAL>>
224 <FUNCTION ("REST" A) <1 .A> >>
\f<SETG ACTORSUBST
225 <FUNCTION A ("BIND" C EXP "OPTIONAL" (ENV <>)
226 "AUX" (PURE <>) TP EXP1)
227 <OR <MULTILEVEL .EXP> <EXIT .A .EXP>>
229 <COND (<ACTORFORM? <SET EXP1 <1 .EXP>>>
230 <SET TP <TYPE .EXP1>>
231 <SET EXP1 <ACTORSUBST1 .EXP1 PURE>>
232 <AND <==? .TP SEGMENT>
233 <OR .PURE <NOT <==? <TYPE .EXP1> FORM>>>
235 <<CONSTRUCTOR <TYPE .EXP>>
237 !.<ACTORSUBST <REST .EXP>>>>>)
238 (T <SET EXP1 <ACTORSUBST .EXP1>>) >
239 <<CONSTRUCTOR <TYPE .EXP>> .EXP1 !.<ACTORSUBST <REST .EXP>>> >>
244 <AND <NOT <MONAD? .OBJECT>>
245 <MEMQ <TYPE .OBJECT> '(LIST FORM VECTOR SEGMENT VECTOR)>> >>
250 <AND <MEMQ <TYPE .EXP> '(FORM SEGMENT)>
252 <ACTOR? <1 .EXP>>> >>
256 <ACTOR-FUNCTION (OBJECT BOUNDARY OBLIGATORY VAR
257 "AUX" (VAL <RLVAL .VAR>))
258 <AND <==? <TYPE <RLVAL VAL>> UNASSIGNED>
259 <REPEAT R ((V <CHTYPE <RLVAL VAL> LIST>))
260 <AND <EMPTY? .V> <EXIT .R <>>>
261 <SET BOUNDARY <IS2 <1 <1 .V>> .OBJECT .BOUNDARY .OBLIGATORY <2 <1 .V>>>>
264 <COND (<ASSIGNED? .VAR>
265 <COND (<OR <MONAD? .OBJECT> .OBLIGATORY>
266 <OR <=? ..VAR .OBJECT> <FAIL>>)
268 <SET BOUNDARY <PREFIX1 ..VAR () .OBJECT .BOUNDARY>>)>)
271 <COND (<OR <MONAD? .OBJECT> .OBLIGATORY>
274 <ANOTHER .OBJECT .BOUNDARY>>)>>>)>
280 <ACTOR-FUNCTION (OBJECT BOUNDARY OBLIGATORY PRED)
282 <COND (.OBLIGATORY .BOUNDARY)
283 (T <ANOTHER .OBJECT .BOUNDARY>)> >>
288 <ACTOR-FUNCTION (OBJECT BOUNDARY OBLIGATORY "OPTIONAL" (N <>))
290 <OR <NOT .N> <==? .N <BLENGTH .OBJECT .BOUNDARY>> <FAIL>>
293 <COND (<G? .N <BLENGTH .OBJECT .BOUNDARY>>
295 (T <REST .OBJECT .N>)>)
296 (T <ANOTHER .OBJECT .BOUNDARY>)> >>
301 <ACTOR-FUNCTION (OBJECT BOUNDARY OBLIGATORY VAR)
304 <COND (<OR <MONAD? .OBJECT> .OBLIGATORY>
307 <ANOTHER .OBJECT .BOUNDARY>>)>>>
312 <ACTOR-FUNCTION (OBJECT BOUNDARY OBLIGATORY "ARGS" A)
313 <ERROR VEL-UNDER-CONSTRUCTION> >>
\f<SETG ANOTHER
314 <FUNCTION (OBJ BOUND)
317 <AND <==? .OBJ .BOUND> <FAIL>>
318 <RESTORE .FP <SET OBJ <REST .OBJ>>>> >>
323 <FUNCTION P (PAT ENDV KV BETAV)
324 <REPEAT ((END .PAT) (KS 0) (BETAS 0))
326 <SET .KV .KS> <SET .BETAV .BETAS>
327 <SET .ENDV .END> <EXIT .P <>>)
328 (<==? <TYPE <1 .PAT>> SEGMENT>
329 <SET KS <+ .KS .BETAS>>
331 <SET END <REST .PAT>>)
332 (T <SET BETAS <+ .BETAS 1>>)>
333 <SET PAT <REST .PAT>> > >>
337 <FUNCTION (L LBOUND K BETA "AUX" (KOUNT <BLENGTH .L .LBOUND>))
338 <AND <G? <+ .K .BETA> .KOUNT>
340 <REST .L <- .KOUNT .BETA>> >>
345 <FUNCTION BL (L LB "AUX" (K 0))
346 <COND (<==? .L .LB> .K)
352 <FUNCTION P (L1 TERM1 L2 TERM2)
353 <COND (<OR <EMPTY? .L1> <==? .L1 .TERM1>>
355 (<==? .L2 .TERM2> <FAIL>)>
356 <OR <=? <1 .L1> <1 .L2>> <FAIL>>
357 <SET L1 <REST .L1>> <SET L2 <REST .L2>>
363 <GET .TYPE 'CONSTRUCTOR> >>
366 <PUT LIST CONSTRUCTOR ,CONSL>
367 <PUT FORM CONSTRUCTOR ,FORM>
368 <PUT VECTOR CONSTRUCTOR ,CONSV>
369 <PUT SEGMENT CONSTRUCTOR ,SEGMENT>
370 <PUT UVECTOR CONSTRUCTOR ,CONSU>
\f<SETG IS1
371 <FUNCTION S ("BIND" C PAT EXP
372 "OPTIONAL" (BOUND <BOTTOM .EXP>) (OBLIGATORY T) (ENV <>)
373 "AUX" (BEG ()) PURE ENDP BETA ENDE K ENDP1)
374 <COND (<EMPTY? .PAT> <EXIT .S <OR <EMPTY? .EXP> <FAIL>>>)
376 <EXIT .S <OR <=? .PAT .EXP> <FAIL>>>)
378 <OR <EMPTY? .EXP> <FAIL>>)>
380 <SET ENDP1 <BOTTOM .PAT>>
382 <COND (<EMPTY? <THSET BEG <CHOMP PAT .ENDP1 .BEG PURE>>>
383 <EXIT .S <GOTEND .EXP .BOUND .OBLIGATORY>>)
385 <THSET EXP <PREFIX1 .BEG .PAT .EXP .BOUND>>
387 (<==? <TYPE <1 .BEG>> SEGMENT>
389 (T <IS2 <1 .BEG> <1 .EXP>>
390 <THSET EXP <REST .EXP>>)> >
391 <HACKPAT .PAT ENDP K BETA>
392 <SET ENDE <POST .EXP .BOUND .K .BETA>>
395 <THSET EXP <PREFIX1 .BEG .PAT .EXP .ENDE>>
397 (<==? <TYPE <1 .BEG>> SEGMENT>
398 <THSET EXP <INVOKE <1 .BEG>
401 <AND <==? .PAT .ENDP> .OBLIGATORY>>>)
402 (<==? .EXP .ENDE> <FAIL>)
403 (T <IS2 <1 .BEG> <1 .EXP>>
404 <THSET EXP <REST .EXP>>)>
405 <COND (<EMPTY? <THSET BEG <CHOMP PAT .ENDP .BEG PURE>>>
406 <EXIT .R <OR <==? .EXP .ENDE> <NOT .OBLIGATORY> <FAIL>>>)> >
409 <COND (<EMPTY? <THSET BEG <CHOMP ENDP .ENDP1 .BEG PURE>>>
412 <OR <=? <1 .BEG> <1 .ENDE>> <FAIL>>)
413 (T <IS2 <1 .BEG> <1 .ENDE>>) >
414 <SET ENDE <REST .ENDE>> > >>
\f<SETG GOTEND
415 <FUNCTION (EXP BOUND OBLIGATORY)
416 <OR <==? .EXP .BOUND>
423 <FUNCTION (PAT EXP "OPTIONAL" (BOUND <BOTTOM .EXP>) (OBLIGATORY T) (ENV <>))
424 <COND (<==? <TYPE .PAT> FORM>
425 <INVOKE .PAT .EXP .BOUND .OBLIGATORY .ENV>)
426 (<IS1 .PAT .EXP .BOUND .OBLIGATORY .ENV>) > >>
430 <FUNCTION (EXP1 EXP2)
431 <COND (<MONAD? .EXP1>
435 ((<1 .EXP1> !<UPTO <REST .EXP1> .EXP2>))> >>
439 <FUNCTION S ('PAT EXP "AUX" (PURE <>))
440 <COND (<ACTORFORM? .PAT>
441 <SET PAT <ACTORSUBST1 .PAT PURE>>
443 <EXIT .S <=? .PAT .EXP>>>
445 <PROG1 T <INVOKE .PAT .EXP>>
448 <PROG1 T <IS1 .PAT .EXP>>
454 <COND (<MONAD? .THING> <>)
455 (<==? <TYPE .THING> LIST> ())
456 (T <REST .THING <LENGTH .THING>>)> >>
\f\f\ 3\f