31 <SETG DECL-ITEM-COUNT 3>
35 <SETG DECL-IN-COUNT-VEC 5>
37 <SETG DECL-REST-VEC 6>
50 <MANIFEST HIGHBOUND LOWBOUND>
52 <SETG ALLWORDS '<PRIMTYPE WORD>>
54 <DEFINE TASTEFUL-DECL (D "AUX" TEM)
55 <COND (<OR <NOT .D> <==? .D NO-RETURN>> ANY)
56 (<AND <TYPE? .D ATOM> <VALID-TYPE? .D>> .D)
57 (<AND <OR <TYPE? <SET TEM .D> ATOM> <SET TEM <ISTYPE? .D>>>
60 (<TYPE? .D FORM SEGMENT>
62 <OR <AND <EMPTY? .D> ANY> <TASTEFUL-DECL <1 .D>>>)
63 (<==? <1 .D> FIX> FIX)
64 (<AND <==? <LENGTH .D> 2> <==? <1 .D> NOT>> ANY)
66 <CHTYPE <MAPF ,LIST ,TASTEFUL-DECL .D> SEGMENT>)
67 (ELSE <CHTYPE <MAPF ,LIST ,TASTEFUL-DECL .D> FORM>)>)
69 [<COND (<==? <1 .D> OPT> OPTIONAL) (ELSE <1 .D>)>
70 !<MAPF ,LIST ,TASTEFUL-DECL <REST .D>>])
73 <DEFINE TMERGE (P1 P2)
74 <COND (<OR <AND <TYPE? .P1 FORM SEGMENT>
77 <AND <TYPE? .P2 FORM SEGMENT>
80 <CTMATCH .P1 .P2 <> <> T>>
81 <CTMATCH .P1 .P2 T T <>>)
82 (<=? .P1 '<NOT ANY>> .P2)
83 (<=? .P2 '<NOT ANY>> .P1)
84 (ELSE <CHTYPE (OR !<PUT-IN <PUT-IN () .P1> .P2>) FORM>)>>
86 <DEFINE TYPE-AND (P1 P2) <CTMATCH .P1 .P2 T <> <>>>
88 <DEFINE TMATCH (P1 P2) <CTMATCH .P1 .P2 <> <> <>>>
90 <DEFINE CTMATCH (P1 P2 ANDF ORF MAYBEF)
91 #DECL ((ANDF ORF MAYBEF) <SPECIAL <OR FALSE ATOM>>)
94 <DEFINE DTMATCH (PAT1 PAT2)
95 <OR .PAT1 <SET PAT1 ANY>>
96 <OR .PAT2 <SET PAT2 ANY>>
97 <COND (<=? .PAT1 .PAT2> .PAT1)
98 (<TYPE? <SET PAT1 <VTS .PAT1>> ATOM> <TYPMAT .PAT1 <VTS .PAT2>>)
99 (<TYPE? <SET PAT2 <VTS .PAT2>> ATOM> <TYPMAT .PAT2 .PAT1>)
100 (<AND <TYPE? .PAT1 FORM SEGMENT> <TYPE? .PAT2 FORM SEGMENT>>
102 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
105 <OR <AND <TYPE? .X ATOM>
107 <MEMQ .X '![STRUCTURED LOCATIVE APPLICABLE ANY!]>>
109 <AND <TYPE? .X ATOM> <GET .X DECL>>
113 #DECL ((OBJ) <PRIMTYPE LIST>)
114 <AND <NOT <EMPTY? .OBJ>> <NOT <EMPTY? <REST .OBJ>>>>>
116 <DEFINE TYPMAT (TYP PAT "AUX" TEM)
119 <COND (<TYPE? .PAT ATOM>
120 <OR <AND <==? .PAT ANY> <COND (.ORF ANY) (ELSE .TYP)>>
121 <AND <==? .TYP ANY> <COND (.ORF ANY) (ELSE .PAT)>>
122 <AND <=? .PAT .TYP> .TYP>
124 <STRUC .PAT .TYP <>>>)
125 (<TYPE? .PAT FORM SEGMENT> <TEXP1 .PAT .TYP>)
126 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
128 <OR <AND <N==? <SET TEM <VTS .TYP>> .TYP> <DTMATCH .TEM .PAT>>
129 <AND <N==? <SET TEM <VTS .PAT>> .PAT>
130 <TYPMAT .TYP .TEM>>>>>>
134 <DEFINE TEXP1 (FORT PAT)
135 #DECL ((FORT) <OR FORM SEGMENT>)
136 <COND (<EMPTY? .FORT> #FALSE (EMPTY-TYPE-FORM!-ERRORS))
137 (<MEMQ <1 .FORT> '![OR AND NOT PRIMTYPE!]> <ACTORT .FORT .PAT>)
138 (<AND <==? <1 .FORT> QUOTE> <2-ELEM .FORT>>
139 <DTMATCH <GEN-DECL <2 .FORT>> .PAT>)
140 (ELSE <FORMATCH .FORT .PAT>)>>
142 <DEFINE ACTORT (FORT PAT "AUX" (ACTOR <1 .FORT>) TEM1)
143 #DECL ((FORT) <PRIMTYPE LIST>)
147 (<EMPTY? <SET FORT <REST .FORT>>>
148 #FALSE (EMPTY-OR-MATCH!-ERRORS))
150 <REPEAT (TEM (AL ()))
153 (<OR <AND <TYPE? <SET TEM <1 .FORT>> ATOM>
155 <COND (<VALID-TYPE? .TEM>)
156 (<SET TEM1 <GET .TEM DECL>>
158 <AND <TYPE? .TEM ATOM> <AGAIN>>)
160 <SET TEM <TYPMAT .TEM .PAT>>>
161 <AND <TYPE? .TEM FORM SEGMENT> <SET TEM <TEXP1 .TEM .PAT>>>>
162 <COND (<==? .ACTOR OR>
165 <COND (<==? .TEM ANY> <RETURN ANY>)>
166 <COND (.ORF <SET AL <PUT-IN .AL .TEM>>)
168 <OR <MEMBER .TEM .AL>
169 <SET AL (.TEM !.AL)>>)>)>)
170 (ELSE <RETURN T>)>)>)
171 (<NOT <EMPTY? .TEM>> <RETURN .TEM>)>
172 <COND (<EMPTY? <SET FORT <REST .FORT>>>
173 <RETURN <AND <NOT <EMPTY? .AL>>
174 <COND (<EMPTY? <REST .AL>> <1 .AL>)
176 <ORSORT <CHTYPE (.ACTOR !.AL)
178 (<==? .ACTOR NOT> <NOT-IT .FORT .PAT>)
179 (ELSE <PTACT .FORT .PAT>)>>
181 <DEFINE PTACT (FORTYP PAT)
182 <COND (<TYPE? .FORTYP FORM SEGMENT>
183 <COND (<AND <2-ELEM .FORTYP> <==? <1 .FORTYP> PRIMTYPE>>
184 <PRIMATCH .FORTYP .PAT>)
185 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
186 (<TYPE? .FORTYP ATOM> <TYPMAT .FORTYP .PAT>)
187 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
191 <DEFINE STRUC (WRD TYP ACTAND)
194 <COND (<COND (<==? .WRD STRUCTURED>
195 <COND (<==? .TYP LOCATIVE> <>)
196 (<==? .TYP APPLICABLE>
197 <RETURN <COND (.ORF '<OR APPLICABLE STRUCTURED>)
199 '<OR RSUBR RSUBR-ENTRY FUNCTION CLOSURE MACRO>)>>)
200 (<AND <VALID-TYPE? .TYP>
201 <MEMQ <TYPEPRIM .TYP>
202 '![LIST VECTOR UVECTOR TEMPLATE STRING TUPLE
205 <MEMQ .TYP '![LOCL LOCAS LOCD LOCV LOCU LOCS LOCA!]>)
206 (<==? .WRD APPLICABLE>
207 <COND (<==? .TYP LOCATIVE> <RETURN <>>)
208 (<==? .TYP STRUCTURED>
209 <RETURN <STRUC .TYP .WRD .ACTAND>>)
211 '![RSUBR SUBR FIX FSUBR FUNCTION
212 RSUBR-ENTRY MACRO CLOSURE
214 <COND (.ORF .WRD) (ELSE .TYP)>)
216 <COND (<AND .ORF <NOT .ACTAND>> <ORSORT <FORM OR .WRD .TYP>>)
219 <DEFINE PRIMATCH (PTYP PAT "AUX" PAT1 ACTOR TEM)
220 #DECL ((PAT1) <PRIMTYPE LIST>
221 (PTYP) <OR <FORM ANY ANY> <SEGMENT ANY ANY>>)
222 <COND (<AND <TYPE? .PAT FORM SEGMENT>
224 <==? <LENGTH .PAT1> 2>
225 <==? <1 .PAT1> PRIMTYPE>>
226 <COND (<==? <2 .PAT1> <2 .PTYP>> .PAT1)
227 (ELSE <COND (.ORF <ORSORT <FORM OR .PAT1 .PTYP>>)>)>)
229 <COND (<==? .PAT ANY> <COND (.ORF ANY) (.ANDF .PTYP) (ELSE T)>)
230 (<MEMQ .PAT '![STRUCTURED LOCATIVE APPLICABLE!]>
231 <COND (<STRUC .PAT <2 .PTYP> T>
232 <COND (.ORF .PAT) (ELSE .PTYP)>)
233 (ELSE <COND (.ORF <ORSORT <FORM OR .PAT .PTYP>>)>)>)
234 (<AND <VALID-TYPE? .PAT>
235 <==? <TYPEPRIM .PAT> <2 .PTYP>>
236 <COND (.ORF .PTYP) (ELSE .PAT)>>)
237 (ELSE <COND (.ORF <ORSORT <FORM OR .PTYP .PAT>>)>)>)
238 (<AND <TYPE? .PAT FORM SEGMENT>
240 <NOT <EMPTY? .PAT1>>>
241 <COND (<==? <SET ACTOR <1 .PAT1>> OR> <ACTORT .PAT .PTYP>)
243 <COND (.ORF <NOT-IT .PAT .PTYP>)
245 <SET TEM <PRIMATCH .PTYP <2 .PAT1>>>
246 <COND (<AND <NOT .TEM> <EMPTY? .TEM>> .PTYP)
248 (<N=? .TEM .PTYP> ANY)>)>)
249 (<SET TEM <PRIMATCH .PTYP <1 .PAT1>>>
251 (.ANDF <COND (<TYPE? .PAT FORM>
252 <FORM .TEM !<REST .PAT1>>)
254 <CHTYPE (.TEM !<REST .PAT1>) SEGMENT>)>)
259 <DEFINE NOT-IT (NF PAT "AUX" T1)
260 #DECL ((NF) <OR FORM SEGMENT>)
261 <COND (<AND <TYPE? .PAT FORM SEGMENT>
263 <OR <==? <1 .PAT> OR> <==? <1 .PAT> AND>>>
266 <COND (<==? <LENGTH .NF> 2>
267 <COND (<NOT <SET T1 <TYPE-AND <2 .NF> .PAT>>>
268 <COND (.ORF .NF) (.ANDF .PAT) (ELSE T)>)
269 (<==? <2 .NF> ANY> <COND (.ORF .PAT)>)
270 (<AND <N==? .T1 .PAT>
272 <N=? <CANONICAL-DECL .PAT>
273 <CANONICAL-DECL .T1>>>
274 <COND (<OR .ANDF .ORF> ANY) (ELSE T)>)
276 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>>
279 <COND (<AND <TYPE? .D FORM SEGMENT>
283 (ELSE <FORM NOT .D>)>>
286 <DEFINE FORMATCH (FRM RPAT "AUX" TEM (PAT .RPAT) EX)
287 #DECL ((FRM) <OR <FORM ANY> <SEGMENT ANY>>
288 (RPAT) <OR ATOM FORM LIST SEGMENT VECTOR FIX>)
290 (<AND <TYPE? .RPAT ATOM> <TYPE? <1 .FRM> ATOM> <==? <1 .FRM> .RPAT>>
291 <COND (.ORF .RPAT) (ELSE .FRM)>)
293 <COND (<TYPE? .RPAT ATOM> <SET PAT <SET EX <GET .RPAT DECL '.RPAT>>>)
294 (ELSE <SET RPAT <1 .PAT>>)>
298 <COND (<AND .ORF <NOT <CTMATCH .PAT <1 .FRM> <> <> T>>>
299 <ORSORT <FORM OR .RPAT .FRM>>)
301 <COND (<TYPE? <1 .FRM> ATOM> <TYPMAT <1 .FRM> .PAT>)
302 (<TYPE? <1 .FRM> FORM> <ACTORT <1 .FRM> .PAT>)>)>>
303 <COND (<AND .ANDF <NOT .ORF> .TEM>
304 <COND (<TYPE? .FRM FORM> <CHTYPE (.TEM !<REST .FRM>) FORM>)
305 (ELSE <CHTYPE (.TEM !<REST .FRM>) SEGMENT>)>)
307 (<TYPE? .PAT FORM SEGMENT>
308 <COND (<MEMQ <1 .PAT> '![OR AND NOT PRIMTYPE!]> <ACTORT .PAT .FRM>)
310 <COND (<AND <==? <LENGTH .PAT> 2> <TYPE? <2 .PAT> LIST>>
311 <WRDFX .PAT .FRM .RPAT>)
312 (<AND <G=? <LENGTH .PAT> 2> <TYPE? <2 .PAT> FIX>>
313 <BYTES-HACK .PAT .FRM .RPAT>)
314 (<AND <G=? <LENGTH .FRM> 2> <TYPE? <2 .FRM> FIX>>
315 <BYTES-HACK .FRM .PAT <1 .FRM>>)
318 <NOT <CTMATCH .RPAT .FRM <> <> T>>>
319 <ORSORT <FORM OR .RPAT .FRM>>)
320 (<AND .ORF <NOT <CTMATCH .PAT .FRM <> <> T>>>
321 <ORSORT <FORM OR .PAT .FRM>>)
323 <SET TEM <ELETYPE .PAT .FRM .RPAT>>
325 <TYPE? .TEM FORM SEGMENT>
330 <AND <=? <1 .EL> .EX>
338 <DEFINE BYTES-HACK (F1 F2 RPAT "AUX" FST TL TEM SEGF MLF1 MLF2)
339 #DECL ((F1 F2) <OR FORM SEGMENT> (MLF1 MLF2) FIX)
340 <SET SEGF <SEGANDOR .F1 .F2 .ORF>>
341 <COND (<OR <EMPTY? .F1> <EMPTY? .F2>> #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))>
343 <COND (<TYPE? .RPAT ATOM>
344 <COND (<TYPE? <1 .F2> ATOM> <TYPMAT <1 .F2> .RPAT>)
345 (<TYPE? <1 .F2> FORM> <ACTORT <1 .F2> .RPAT>)
346 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
347 (<TYPE? .RPAT FORM> <ACTORT .RPAT <1 .F2>>)
348 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
353 (<CTMATCH .RPAT '<PRIMTYPE BYTES> <> <> <>>
354 <SET MLF1 <MINL .F1>>
355 <SET MLF2 <MINL .F2>>
356 <COND (<AND <G=? <LENGTH .F2> 2> <TYPE? <2 .F2> FIX>>
357 <COND (<CTMATCH <1 .F2> '<PRIMTYPE BYTES> <> <> <>>
359 <COND (<==? <2 .F2> <2 .F1>>
360 <FOSE .SEGF .FST <2 .F1> <MIN .MLF1 .MLF2>>)
361 (ELSE <ORSORT <FORM OR .F1 .F2>>)>)
362 (<AND <==? <2 .F2> <2 .F1>>
363 <NOT <AND <TYPE? .F1 SEGMENT>
365 <N==? <2 .F1> <2 .F2>>>>>
366 <FOSE .SEGF .FST <2 .F1> <MAX .MLF1 .MLF2>>)>)
367 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
368 (<TMATCH .F2 '<PRIMTYPE BYTES>>
381 <TYPE-MERGE .TEM .F2>)
382 (ELSE <ORSORT <FORM .F1 .F2>>)>)
385 <FOSE .SEGF STRUCTURED '[REST FIX]>)
391 <FOSE .SEGF .FST <2 .F1> <MAX .MLF2 .MLF1>>)>)
392 (ELSE <COND (.ORF <ORSORT <FORM OR .F1 .F2>>) (ELSE <>)>)>)
393 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>>
395 <DEFINE FOSE ("TUPLE" TUP "AUX" (FLG <1 .TUP>))
396 <COND (.FLG <CHTYPE (!<REST .TUP>) SEGMENT>)
397 (ELSE <CHTYPE (!<REST .TUP>) FORM>)>>
399 <DEFINE SEGANDOR (F1 F2 ORF)
400 <COND (.ORF <AND <TYPE? .F1 SEGMENT> <TYPE? .F2 SEGMENT>>)
401 (ELSE <OR <TYPE? .F1 SEGMENT> <TYPE? .F2 SEGMENT>>)>>
403 <DEFINE WRDFX (F1 F2 RPAT "AUX" FST TL)
404 #DECL ((F1 F2) <OR FORM SEGMENT>)
405 <COND (<OR <EMPTY? <SET F1 <CHTYPE .F1 FORM>>>
406 <EMPTY? <SET F2 <CHTYPE .F2 FORM>>>>
407 #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))>
409 <COND (<TYPE? .RPAT ATOM>
410 <COND (<TYPE? <1 .F2> ATOM> <TYPMAT <1 .F2> .RPAT>)
411 (<TYPE? <1 .F2> FORM> <ACTORT <1 .F2> .RPAT>)
412 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
413 (<TYPE? .RPAT FORM> <ACTORT .RPAT <1 .F2>>)
414 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
418 <COND (<CTMATCH .RPAT ,ALLWORDS <> <> <>>
419 <COND (<AND <LENGTH? .F2 2> <TYPE? <2 .F2> LIST>>
420 <COND (<CTMATCH <1 .F2> ,ALLWORDS <> <><>>
422 <SET TL <MAP-MERGE !<2 .F1> !<2 .F2>>>
423 <COND (<EMPTY? .TL> .FST)
424 (ELSE <FORM .FST .TL>)>)
425 (<SET TL <AND-MERGE <2 .F1> <2 .F2>>>
427 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
428 (ELSE <COND (.ORF <ORSORT <FORM OR .F1 .F2>>) (ELSE <>)>)>)
429 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>>
431 <DEFINE MAP-MERGE ("TUPLE" PAIRS "AUX" (HIGH <2 .PAIRS>) (LOW <1 .PAIRS>))
432 #DECL ((PAIRS) <TUPLE [REST FIX]> (HIGH LOW) FIX)
434 <COND (<EMPTY? <SET PAIRS <REST .PAIRS 2>>> <RETURN>)>
435 <SET HIGH <MAX .HIGH <2 .PAIRS>>>
436 <SET LOW <MIN .LOW <1 .PAIRS>>>>
437 <COND (<AND <==? .HIGH <CHTYPE <MIN> FIX>>
438 <==? .LOW <CHTYPE <MAX> FIX>>>
440 (ELSE (.LOW .HIGH))>>
443 <DEFINE AND-MERGE (L1 L2 "AUX" (FLG <>) HIGH LOW TEM (L (0)) (LL .L))
444 #DECL ((L LL L1 L2) <LIST [REST FIX]> (HIGH LOW) FIX)
445 <COND (<G? <LENGTH .L1> <LENGTH .L2>>
452 <REPEAT ((L1 .L1) LO HI)
453 #DECL ((L1) <LIST [REST FIX]> (LO HI) FIX)
454 <COND (<EMPTY? .L1> <RETURN>)>
456 <COND (<OR <AND <G=? <SET LO <1 .L1>> .LOW>
458 <AND <L=? .HI .HIGH> <G=? .HI .LOW>>
459 <AND <G=? .LOW .LO> <L=? .LOW .HI>>
460 <AND <L=? .HIGH .HI> <G=? .HIGH .LO>>>
461 <SET LOW <MAX .LOW .LO>>
462 <SET HIGH <MIN .HIGH .HI>>
463 <SET L <REST <PUTREST .L (.LOW .HIGH)> 2>>
466 <SET L1 <REST .L1 2>>>
467 <COND (<EMPTY? <SET L2 <REST .L2 2>>>
468 <RETURN <COND (.FLG <REST .LL>) (ELSE <>)>>)>>>
472 <DEFINE GET-RANGE (L1 "AUX" TT)
473 <COND (<AND <TYPE? .L1 FORM>
474 <TMATCH .L1 ,ALLWORDS>
475 <TYPE? <2 .L1> LIST>>
476 <COND (<NOT <EMPTY? <SET TT <MAP-MERGE !<2 .L1>>>>> .TT)>)>>
480 <DEFINE ELETYPE (F1 F2 RTYP
481 "AUX" (S1 <VECTOR .F1 <> 0 <> <> '[]>) (FAIL <>) (INOPT <>)
482 (S2 <VECTOR .F2 <> 0 <> <> '[]>) (FL ()) (FP '<>) FSTL
484 #DECL ((S1 S2) <VECTOR <PRIMTYPE LIST> ANY FIX ANY ANY ANY>
485 (F1 F2) <PRIMTYPE LIST> (FP) <OR FORM SEGMENT> (FL) LIST)
486 <SET SEGF <SEGANDOR .F1 .F2 .ORF>>
488 (<OR <EMPTY? .F1> <EMPTY? .F2>> #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))
489 (<AND .ANDF .ORF <NOT <TMATCH <1 .F2> .RTYP>>> <ORSORT <FORM OR .F1 .F2>>)
493 <COND (<TYPE? .RTYP ATOM>
494 <COND (<TYPE? <1 .F2> ATOM> <TYPMAT .RTYP <1 .F2>>)
495 (<TYPE? <1 .F2> FORM> <ACTORT <1 .F2> .RTYP>)
496 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
497 (<TYPE? .RTYP FORM> <ACTORT .RTYP <1 .F2>>)
498 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
502 <COND (.SEGF <CHTYPE (.FSTL) SEGMENT>)
503 (ELSE <FORM .FSTL>)>>
505 <PUT .S1 ,DECL-RESTED <REST .F1>>
506 <PUT .S2 ,DECL-RESTED <REST .F2>>
507 <REPEAT ((TEM1 <>) (TEM2 <>) T1 T2 TEM TT)
508 #DECL ((TT) <VECTOR FIX ANY>)
511 (<AND <OR <AND <SET TEM1 <NEXTP .S1>> <SET T1 <DECL-ELEMENT .S1>>>
512 <AND <EMPTY? .TEM1> <SET T1 ANY>>>
513 <OR <AND <SET TEM2 <NEXTP .S2>> <SET T2 <DECL-ELEMENT .S2>>>
514 <AND .TEM1 <EMPTY? .TEM2> <SET T2 ANY>>>>
515 <COND (<AND .ORF <OR <NOT .TEM1> <NOT .TEM2>>>
516 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>) (ELSE .FP)>>)>
520 <COND (<OR <TYPE? .F1 FORM> <DECL-IN-REST .S2>>
522 (ELSE <SET FAIL T> <>)>)
524 <COND (<OR <TYPE? .F2 FORM> <DECL-IN-REST .S1>>
526 (ELSE <SET FAIL T> <>)>)
527 (ELSE <DTMATCH .T1 .T2>)>>>
528 <COND (.ORF <SET TEM <ORSORT <FORM OR .T1 .T2>>>)
529 (.MAYBEF <COND (.FAIL <RETURN <>>) (ELSE <SET FAIL T>)>)
531 <COND (<AND <NOT .INOPT>
533 <OR <DECL-IN-COUNT-VEC .S1>
534 <DECL-IN-COUNT-VEC .S2>>>
537 <DECL-IN-COUNT-VEC .S1>
538 <DECL-IN-COUNT-VEC .S2>>>>
539 <SET INOPT <COND (.ANDF (OPTIONAL .TEM)) (ELSE ())>>)
541 <PUTREST <REST .INOPT <- <LENGTH .INOPT> 1>> (.TEM)>)>
544 <OR <0? <DECL-ITEM-COUNT .S1>>
545 <0? <DECL-ITEM-COUNT .S2>>>>
547 <0? <DECL-ITEM-COUNT .S1>>
548 <0? <DECL-ITEM-COUNT .S2>>>>>
549 <AND .ANDF <SET TEM [!.INOPT]>>
553 <OR <AND <DECL-IN-REST .S1> <EMPTY? <DECL-RESTED .S2>>>
554 <AND <DECL-IN-REST .S2> <EMPTY? <DECL-RESTED .S1>>>>>
555 <AND <OR <DECL-IN-REST .S1>
556 <AND .ANDF <OR <NOT .TEM1> <DECL-IN-COUNT-VEC .S1>>>>
557 <OR <DECL-IN-REST .S2>
559 <OR <NOT .TEM2> <DECL-IN-COUNT-VEC .S2>>>>>>
568 <TYPE? .F2 SEGMENT>>>>
570 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>)
573 <RETURN <COND (<AND <TYPE? .T1 FORM SEGMENT>
583 <TYPE? .F1 SEGMENT>>>>
585 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>)
588 <RETURN <COND (<AND <TYPE? .T1 FORM SEGMENT>
594 <OR <DECL-IN-REST .S1> <NOT .TEM1>>
595 <OR <DECL-IN-REST .S2> <NOT .TEM2>>>
597 <COND (<AND <NOT .INOPT>
600 <NOT <OR <DECL-IN-REST .S1> <DECL-IN-REST .S2>>>>>
601 <COND (<AND <TYPE? <1 .FL> VECTOR>
602 <=? <2 <SET TT <1 .FL>>> .TEM>>
603 <PUT .TT 1 <+ <1 .TT> 1>>)
604 (<AND <N==? <CHTYPE .FP LIST> .FL> <=? .TEM <1 .FL>>>
605 <PUT .FL 1 [2 .TEM]>)
606 (ELSE <SET FL <REST <PUTREST .FL (.TEM)>>>)>)>)
608 <COND (<AND <EMPTY? .TEM1> <EMPTY? <SET TEM1 .TEM2>>>
610 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>) (ELSE .FP)>>)
612 (ELSE <RETURN .TEM1>)>)>>)>)>>
616 <DEFINE RESTER? (S1 S2 FL FST SEGF
617 "AUX" (TT <DECL-REST-VEC .S1>) (TEM1 T) (TEM2 T) (OPTIT <>))
618 #DECL ((S1 S2) <VECTOR ANY ANY ANY ANY ANY VECTOR> (FL) <LIST ANY>
620 <COND (<AND <OR .ORF <DECL-IN-COUNT-VEC .S2>>
621 <EMPTY? <DECL-RESTED .S2>> <NOT <DECL-IN-REST .S2>>>
624 (<AND .SEGF <NOT .ORF> <OR <NOT <DECL-IN-REST .S1>>
625 <NOT <DECL-IN-REST .S2>>>> T)
626 (<AND <NOT <EMPTY? .TT>>
627 <OR <NOT <DECL-IN-REST .S2>> <G=? <LENGTH .TT>
628 <LENGTH <REST <TOP <DECL-REST-VEC .S2>>>>>>>
629 <SET TT <REST <TOP .TT>>>
631 <FUNCTION (SO "AUX" T1)
632 #DECL ((SO) <VECTOR ANY>)
634 <OR <AND <SET TEM1 <NEXTP .S2>> <DECL-ELEMENT .S2>>
636 <COND (.ORF <MAPLEAVE>) (ELSE ANY)>>>>
637 <AND <OR .ORF <DECL-IN-COUNT-VEC .S2>>
638 <EMPTY? <DECL-RESTED .S2>>
639 <NOT <DECL-IN-REST .S2>>
641 <COND (<NOT .TEM1> <AND <EMPTY? .TEM1> <SET TEM1 T>>)>
646 <DTMATCH <AND <NEXTP .S1>
647 <DECL-ELEMENT .S1>> .T1>>>)>
648 <AND <OR <NOT .T1> <NOT .TEM2>> <MAPLEAVE>>>
649 <REST <SET TT [REST .FST !<REST .TT>]> 2>>
650 <COND (.OPTIT <PUT .TT 1 OPTIONAL>)
651 (ELSE <SET TT <UNIQUE-VECTOR-CHECK .TT>>)>
652 <COND (<AND .TEM1 .TEM2> <PUTREST .FL (.TT)> T)
653 (<AND <NOT .TEM1> <NOT <EMPTY? .TEM1>>> .TEM1)
657 <DEFINE UNIQUE-VECTOR-CHECK (V "AUX" (FRST <2 .V>))
658 #DECL ((V) <VECTOR [2 ANY]>)
660 <FUNCTION (X) <COND (<N=? .X .FRST> <MAPLEAVE .V>)>>
662 (ELSE [REST .FRST])>>
665 <DEFINE NEXTP (S "AUX" TEM TT N)
666 #DECL ((S) <VECTOR <PRIMTYPE LIST> ANY FIX ANY ANY ANY> (N) FIX
668 <COND (<0? <DECL-ITEM-COUNT .S>> <PUT .S ,DECL-IN-COUNT-VEC <>>)>
669 <COND (<DECL-IN-REST .S> <NTHREST .S>)
670 (<NOT <0? <DECL-ITEM-COUNT .S>>>
671 <PUT .S ,DECL-ITEM-COUNT <- <DECL-ITEM-COUNT .S> 1>>
673 (<EMPTY? <SET TEM <DECL-RESTED .S>>> <>)
674 (<TYPE? <1 .TEM> ATOM FORM SEGMENT>
676 <PUT .S ,DECL-RESTED <REST <DECL-RESTED .S>>>
677 <PUT .S ,DECL-ELEMENT .TEM>)
678 (<TYPE? <1 .TEM> VECTOR>
680 <PUT .S ,DECL-RESTED <REST <DECL-RESTED .S>>>
681 <PUT .S ,DECL-REST-VEC <REST .TT>>
682 <COND (<G? <LENGTH .TT> 1>
683 <COND (<==? <1 .TT> REST>
684 <COND (<AND <==? <LENGTH .TT> 2>
688 <PUT .S ,DECL-IN-REST T>
691 <DECL-ELEMENT .TT>>)>)
692 (<OR <AND <TYPE? <1 .TT> FIX> <SET N <1 .TT>>>
693 <AND <MEMQ <1 .TT> '![OPT OPTIONAL!]>
695 <OR <TYPE? <1 .TT> FIX>
696 <PUT .S ,DECL-IN-COUNT-VEC T>>
699 <- <* .N <- <LENGTH .TT> 1>> 1>>
700 <PUT .S ,DECL-ELEMENT <2 .TT>>
701 <COND (<L=? .N 0> <>) (ELSE .S)>)
702 (#FALSE (BAD-VECTOR-SYNTAX!-ERRORS))>)
703 (ELSE #FALSE (BAD-FORM-SYNTAX!-ERRORS))>)
704 (ELSE #FALSE (BAD-FORM-SYNTAX!-ERRORS))>>
708 <DEFINE NTHREST (S "AUX" (TEM <REST <DECL-REST-VEC .S>>))
709 #DECL ((S) <VECTOR ANY ANY ANY ANY ANY VECTOR> (TEM) VECTOR)
710 <COND (<EMPTY? .TEM> <SET TEM <REST <TOP .TEM>>>)>
711 <PUT .S ,DECL-REST-VEC .TEM>
712 <PUT .S ,DECL-ELEMENT <1 .TEM>>>
715 <DEFINE GET-ELE-TYPE (DCL2 NN
716 "OPTIONAL" (RST <>) (PT <>)
717 "AUX" (LN 0) (CNT 0) ITYP DC SDC DCL (N 0) DC1 (QOK <>)
718 (FMOK <>) STRU (GD '<>) (GP ()) (K 0) (DCL1 .DCL2)
720 #DECL ((LN CNT K N) FIX (DCL) <PRIMTYPE LIST> (SDC DC) VECTOR
721 (GD) <OR FORM SEGMENT> (GP) LIST)
723 <COND (<AND .PT <SET TEM <ISTYPE? .DCL1>>>
724 <SET PT <TYPE-AND <GET-ELE-TYPE .TEM .NN> .PT>>)>
725 <AND <TYPE? .DCL1 ATOM> <SET DCL1 <GET .DCL1 DECL '.DCL1>>>
726 <COND (<TYPE? .DCL1 SEGMENT> <SET SEGF T>)>
727 <COND (<==? <STRUCTYP .DCL2> BYTES>
728 <RETURN <GET-ELE-BYTE .DCL2 .NN .RST .PT>>)>
729 <COND (.RST <SET STRU <COND (<STRUCTYP .DCL1>) (ELSE STRUCTURED)>>)
732 <COND (<ISTYPE? .DCL2>)
733 (<SET STRU <STRUCTYP .DCL1>> <FORM PRIMTYPE .STRU>)
734 (ELSE STRUCTURED)>>)>
736 (<AND <TYPE? .DCL1 FORM SEGMENT>
738 <G? <SET LN <LENGTH .DCL>> 1>
739 <NOT <SET FMOK <MEMQ <1 .DCL> '![OR AND NOT!]>>>
740 <NOT <SET QOK <==? <1 .DCL> QUOTE>>>
741 <NOT <==? <1 .DCL> PRIMTYPE>>>
744 <AND .PT <SET GP <CHTYPE <SET GD <FOSE .SEGF .STRU>> LIST>>>
746 <AND <TYPE? <SET DC1 <2 .DCL>> VECTOR>
750 <COND (<==? <LENGTH .DC> 2>
751 <COND (.RST <FORM .STRU [REST <2 .DC>]>)
752 (.PT <FORM .STRU [REST <TYPE-MERGE <2 .DC> .PT>]>)
754 (.RST <FORM .STRU [REST <TYPE-MERGE !<REST .DC>>]>)
759 <FUNCTION (D) <TYPE-MERGE .D .PT>>
761 (ELSE <TYPE-MERGE !<REST .DC>>)>>
762 <REPEAT (TT (CK <DCX <SET TT <2 .DCL>>>) (D .DCL) TEM)
763 #DECL ((D) <PRIMTYPE LIST>)
764 <COND (<EMPTY? <SET D <REST .D>>>
767 <AND <TYPE? .TT VECTOR> <==? <1 .TT> REST>>>>
769 <COND (.RST <FORM .STRU [REST .CK]>)
775 <SET CK <TYPE-MERGE .CK <DCX <SET TT <1 .D>>>>>
780 (<COND (<TYPE? .TT VECTOR>
787 <TYPE-MERGE .PT .TT>)>)>>>>>>)
790 <AND .PT <SET GP <CHTYPE <SET GD <FOSE .SEGF .STRU>> LIST>>>
791 <AND .RST <SET N <+ .N 1>>>
792 <COND (<EMPTY? <SET DCL <REST .DCL>>>
793 <RETURN <COND (.RST .STRU)
794 (.PT <FOSE .SEGF .STRU !<ANY-PAT <- .N 1>> .PT>)
800 (<EMPTY? <SET SDC <REST .SDC>>>
803 <0? <SET CNT <- .CNT 1>>>
804 <COND (<EMPTY? <SET DCL <REST .DCL>>>
805 <RETURN <COND (.RST .STRU)
807 <PUTREST .GP (!<ANY-PAT <- .N 1>> .PT)>
812 (<TYPE? <1 .DCL> ATOM FORM SEGMENT>
814 <SET DCL <REST .DCL>>)
815 (<TYPE? <SET DC1 <1 .DCL>> VECTOR>
819 <AND <OR <AND .RST <NOT <1? .N>>> .PT>
821 <=? <2 .DC> '<NOT ANY>>
823 <SET K <MOD <- .N 1> <- <LENGTH .DC> 1>>>
824 <SET N </ <- .N 1> <- <LENGTH .DC> 1>>>
831 (ELSE [REST <TYPE-MERGE !<REST .DC>>])>>)
835 (!<COND (<L=? .N 0> ())
836 (<1? .N> (!<REST .DC>))
837 (ELSE ([.N !<REST .DC>]))>
840 <COND (<==? <SET K <- .K 1>> -1> .PT)
845 (ELSE <NTH .DC <+ .K 2>>)>>)
846 (<OR <TYPE? <1 .DC> FIX> <==? <1 .DC> OPT> <==? <1 .DC> OPTIONAL>>
847 <SET CNT <COND (<TYPE? <1 .DC> FIX> <1 .DC>) (ELSE 1)>>
851 <0? <SET N <- .N 1>>>
855 <COND (<AND <EMPTY? .DCL> <0? .CNT>> .STRU)
858 !<COND (<0? .CNT> (.ITYP !.DCL))
859 (<N==? .SDC <REST .DC>>
860 <COND (<0? <SET CNT <- .CNT 1>>>
861 (!.SDC !<REST .DCL>))
866 (ELSE ([.CNT !.SDC] !<REST .DCL>))>>)>)
868 <SET GP <REST <PUTREST .GP (.PT)>>>
869 <AND <ASSIGNED? SDC> <SET SDC <REST .SDC>>>
870 <COND (<AND <EMPTY? .DCL> <0? .CNT>> .GD)
873 <AND <1? .CNT> <==? .SDC <REST .DC>>>>
875 (<==? .SDC <REST .DC>>
876 ([.CNT !<REST .DC>] !<REST .DCL>))
877 (<L=? <SET CNT <- .CNT 1>> 0>
878 (!.SDC !<REST .DCL>))
885 <AND <OR .PT .RST> <=? .ITYP '<NOT ANY>> <RETURN <>>>
886 <AND .PT <SET GP <REST <PUTREST .GP (.ITYP)>>>>
888 <RETURN <COND (.RST .STRU)
890 <PUTREST .GP (!<ANY-PAT <- .N 1>> .PT)>
893 (.QOK <SET DCL1 <GEN-DECL <2 .DCL>>> <AGAIN>)
894 (<AND .FMOK <==? <1 .FMOK> OR>>
896 <FUNCTION (D "AUX" IT)
897 <COND (<SET IT <GET-ELE-TYPE .D .NN .RST .PT>>
898 <AND <==? .IT ANY> <MAPLEAVE ANY>>
902 (<AND .FMOK <==? <1 .FMOK> AND>>
906 <SET ITYP <TYPE-OK? .ITYP <GET-ELE-TYPE .D .NN .RST>>>>
909 (.RST <COND (<STRUCTYP .DCL1>) (ELSE STRUCTURED)>)
911 <COND (<==? .NN ALL> .DCL1)
912 (ELSE <FOSE .SEGF .DCL1 !<ANY-PAT <- .NN 1>> .PT>)>)
917 <DEFINE GET-ELE-BYTE (DCL N RST PT "AUX" SIZ)
918 #DECL ((N) <OR ATOM FIX>)
920 <COND (<==? .N ALL> .DCL)
921 (<TYPE-AND .DCL <FORM STRUCTURED [.N FIX] [REST FIX]>>)>)
923 <COND (<==? .N ALL> <SET N <MINL .DCL>>)
924 (<G? .N <MINL .DCL>> <SET N 0>)
925 (ELSE <SET N <- <MINL .DCL> .N>>)>
926 <COND (<SET SIZ <GETBSYZ .DCL>> <FORM BYTES .SIZ .N>)
930 <DEFINE GETBSYZ (DCL "AUX" TEM)
931 <COND (<==? <SET TEM <STRUCTYP .DCL>> STRING> 7)
932 (<AND <==? .TEM BYTES> <TYPE? .DCL FORM SEGMENT> <G=? <LENGTH .DCL> 2>
933 <TYPE? <SET TEM <2 .DCL>> FIX>>
936 <DEFINE MINL (DCL "AUX" (N 0) DD D DC (LN 0) (QOK <>) (ANDOK <>) TT (OROK <>))
937 #DECL ((N VALUE LN) FIX (DC) <PRIMTYPE LIST> (D) VECTOR)
938 <AND <TYPE? .DCL ATOM> <SET DCL <GET .DCL DECL '.DCL>>>
940 (<AND <TYPE? .DCL FORM SEGMENT>
943 <N==? <SET TT <1 .DC>> PRIMTYPE>
944 <NOT <SET OROK <==? .TT OR>>>
945 <NOT <SET QOK <==? .TT QUOTE>>>
946 <NOT <SET ANDOK <==? .TT AND>>>
949 <COND (<AND <NOT <EMPTY? .DC>> <TYPE? <1 .DC> FIX>>
950 <OR <TMATCH .TT '<PRIMTYPE BYTES>>
951 <MESSAGE ERROR "BAD-DECL-SYNTAX" .DCL>>
952 <COND (<AND <==? <LENGTH .DC> 2> <TYPE? <2 .DC> FIX>>
958 <COND (<AND <TYPE? <SET DD <1 .DC>> VECTOR>
961 <COND (<MEMQ <1 .D> '[REST OPT OPTIONAL]> <RETURN .N>)
964 <SET N <+ .N <* .LN <- <LENGTH .D> 1>>>>)
965 (ELSE <MESSAGE ERROR "BAD DECL " .DCL>)>)
966 (<TYPE? .DD ATOM FORM SEGMENT> <SET N <+ .N 1>>)
967 (ELSE <MESSAGE ERROR "BAD DECL " .DCL>)>
968 <AND <EMPTY? <SET DC <REST .DC>>> <RETURN .N>>>)>)
969 (<OR .OROK .ANDOK> <CHTYPE <MAPF <COND (.OROK ,MIN) (ELSE ,MAX)> ,MINL <REST .DC>>
971 (.QOK <COND (<STRUCTURED? <2 .DC>> <LENGTH <2 .DC>>) (ELSE 0)>)
972 (<TYPE? .DCL ATOM FALSE FORM SEGMENT> 0)
973 (ELSE <MESSAGE "BAD DECL " .DCL>)>>
975 <DEFINE STRUCTYP (DCL)
976 <SET DCL <TYPE-AND .DCL STRUCTURED>>
977 <COND (<TYPE? .DCL ATOM>
978 <AND <VALID-TYPE? .DCL> <TYPEPRIM .DCL>>)
979 (<TYPE? .DCL FORM SEGMENT>
980 <COND (<PRIMHK .DCL T>)
981 (<TYPE? <1 .DCL> FORM> <PRIMHK <1 .DCL> <>>)>)>>
983 <DEFINE PRIMHK (FRM FLG "AUX" TEM (LN <LENGTH .FRM>))
984 #DECL ((FRM) <OR FORM SEGMENT> (LN) FIX)
985 <COND (<AND <==? .LN 2>
986 <COND (<==? <SET TEM <1 .FRM>> PRIMTYPE>
987 <AND <TYPE? <SET TEM <2 .FRM>> ATOM>
989 <STRUCTYP <2 .FRM>>>)
990 (<==? .TEM QUOTE> <PRIMTYPE <2 .FRM>>)
991 (<==? .TEM NOT> <>)>>)
993 <COND (<==? <SET TEM <1 .FRM>> OR>
997 <SET TEM <TYPE-MERGE <STRUCTYP .D> .TEM>>> <REST .FRM>>
998 <COND (<AND <TYPE? .TEM ATOM> <VALID-TYPE? .TEM>> .TEM)>)
1002 <COND (<SET TEM <STRUCTYP .D>> <MAPLEAVE>)>>
1005 (<AND <TYPE? .TEM ATOM> <VALID-TYPE? .TEM>>
1006 <TYPEPRIM .TEM>)>)>>
1010 <DEFINE TYPESAME (T1 T2)
1011 <AND <SET T1 <ISTYPE? .T1>>
1012 <==? .T1 <ISTYPE? .T2>>>>
1014 <DEFINE ISTYPE-GOOD? (TYP "OPTIONAL" (STRICT <>))
1015 <AND <SET TYP <ISTYPE? .TYP .STRICT>>
1016 <NOT <MEMQ <TYPEPRIM .TYP> '![BYTES STRING LOCD TUPLE FRAME!]>>
1019 <DEFINE TOP-TYPE (TYP "AUX" TT)
1020 <COND (<AND <TYPE? .TYP ATOM> <NOT <VALID-TYPE? .TYP>>
1021 <NOT <MEMQ .TYP '![STRUCTURED APPLICABLE ANY LOCATIVE]>>>
1022 <SET TYP <GET .TYP DECL '.TYP>>)>
1023 <COND (<TYPE? .TYP ATOM> .TYP)
1024 (<AND <TYPE? .TYP FORM SEGMENT> <NOT <LENGTH? .TYP 1>>>
1025 <COND (<==? <SET TT <1 .TYP>> OR>
1026 <MAPF ,TYPE-MERGE ,TOP-TYPE <REST .TYP>>)
1028 (<==? .TT QUOTE> <TYPE <2 .TYP>>)
1029 (<==? .TT PRIMTYPE> .TYP)
1032 <DEFINE ISTYPE? (TYP "OPTIONAL" (STRICT <>) "AUX" TY)
1034 <OR .STRICT <TYPE? .TYP ATOM> <SET TYP <TYPE-AND .TYP '<NOT
1037 (<TYPE? .TYP FORM SEGMENT>
1038 <COND (<AND <==? <LENGTH .TYP> 2> <==? <1 .TYP> QUOTE>>
1039 <SET TYP <TYPE <2 .TYP>>>)
1041 <SET TYP <ISTYPE? <2 <SET TY .TYP>>>>
1044 <COND (<N==? .TYP <ISTYPE? .Z>>
1045 <MAPLEAVE <SET TYP <>>>)>>
1047 (ELSE <SET TYP <1 .TYP>>)>)>
1048 <AND <TYPE? .TYP ATOM>
1049 <COND (<VALID-TYPE? .TYP> .TYP)
1050 (<SET TYP <GET .TYP DECL>> <AGAIN>)>>>>
1053 <DEFINE DCX (IT "AUX" TT LN)
1054 #DECL ((TT) VECTOR (LN) FIX)
1055 <COND (<AND <TYPE? .IT VECTOR>
1056 <G=? <SET LN <LENGTH <SET TT .IT>>> 2>
1057 <COND (<==? .LN 2> <2 .TT>)
1058 (ELSE <TYPE-MERGE !<REST .TT>>)>>)
1061 "DETERMINE IF A TYPE PATTERN REQUIRES DEFERMENT 0=> NO 1=> YES 2=> DONT KNOW "
1065 <DEFINE DEFERN (PAT "AUX" STATE TEM)
1070 <COND (<VALID-TYPE? .PAT>
1071 <COND (<MEMQ <SET PAT <TYPEPRIM .PAT>>
1072 '![STRING TUPLE LOCD FRAME BYTES!]>
1075 (<SET PAT <GET .PAT DECL>> <AGAIN>)
1077 (<AND <TYPE? .PAT FORM SEGMENT> <NOT <EMPTY? .PAT>>>
1078 <COND (<==? <SET TEM <1 .PAT>> QUOTE> <DEFERN <TYPE <2 .PAT>>>)
1079 (<==? .TEM PRIMTYPE> <DEFERN <2 .PAT>>)
1080 (<AND <==? .TEM OR> <NOT <EMPTY? <REST .PAT>>>>
1081 <SET STATE <DEFERN <2 .PAT>>>
1084 <OR <==? <DEFERN .P> .STATE> <SET STATE 2>>>
1092 <COND (<L? <SET STATE <DEFERN .P>> 2>
1096 (ELSE <DEFERN <1 .PAT>>)>)
1099 " Define a decl for a given quoted object for maximum winnage."
1103 <DEFINE GEN-DECL (OBJ)
1105 (<OR <MONAD? .OBJ> <APPLICABLE? .OBJ> <TYPE? .OBJ STRING>> <TYPE .OBJ>)
1106 (<==? <PRIMTYPE .OBJ> BYTES>
1107 <CHTYPE (<TYPE .OBJ> <BYTE-SIZE .OBJ> <LENGTH .OBJ>) SEGMENT>)
1109 <REPEAT ((DC <GEN-DECL <1 .OBJ>>) (CNT 1)
1110 (FRM <CHTYPE (<TYPE .OBJ>) SEGMENT>) (FRME .FRM) TT T1)
1111 #DECL ((CNT) FIX (FRME) <<PRIMTYPE LIST> ANY>)
1112 <COND (<EMPTY? <SET OBJ <REST .OBJ>>>
1114 <SET FRME <REST <PUTREST .FRME ([.CNT .DC])>>>)
1115 (ELSE <SET FRME <REST <PUTREST .FRME (.DC)>>>)>
1117 (<AND <=? <SET TT <GEN-DECL <1 .OBJ>>> .DC> .DC>
1118 <SET CNT <+ .CNT 1>>)
1121 <SET FRME <REST <PUTREST .FRME ([.CNT .DC])>>>)
1122 (ELSE <SET FRME <REST <PUTREST .FRME (.DC)>>>)>
1128 <DEFINE REST-DECL (DC N "AUX" TT TEM)
1131 (<TYPE? .DC FORM SEGMENT>
1133 (<OR <==? <SET TT <1 .DC>> OR> <==? .TT AND>>
1137 <FUNCTION (D "AUX" (IT <REST-DECL .D .N>))
1138 <COND (<==? .IT ANY>
1139 <COND (<==? .TT OR> <MAPLEAVE (ANY)>)
1144 <COND (<EMPTY? <REST .TT>> ANY)
1145 (<EMPTY? <REST .TT 2>> <2 .TT>)
1148 (<==? <STRUCTYP .DC> BYTES>
1149 <COND (<==? .TT PRIMTYPE>
1151 (<==? <LENGTH .DC> 2>
1152 <CHTYPE (!.DC .N) FORM>)
1153 (<FORM .TT <2 .DC> <+ <CHTYPE <3 .DC> FIX> .N>>)>)
1156 (ELSE <CHTYPE (.DC !<ANY-PAT .N>) FORM>)>)
1158 <FOSE <TYPE? .DC SEGMENT> <COND (<SET TEM <STRUCTYP .TT>> <FORM PRIMTYPE .TEM>)
1162 (<SET TEM <STRUCTYP .DC>>
1164 <==? .TEM BYTES>> <FORM PRIMTYPE .TEM>)
1165 (ELSE <CHTYPE (<FORM PRIMTYPE .TEM> !<ANY-PAT .N>) FORM>)>)
1167 <COND (<0? .N> STRUCTURED)
1168 (ELSE <CHTYPE (STRUCTURED !<ANY-PAT .N>) FORM>)>)>>
1172 <COND (<L=? .N 0> ()) (<1? .N> (ANY)) (ELSE ([.N ANY]))>>
1174 " TYPE-OK? are two type patterns compatible. If the patterns
1175 don't parse, send user a message."
1177 <DEFINE TYPE-OK? (P1 P2 "AUX" TEM)
1178 <COND (<OR <==? .P1 NO-RETURN> <==? .P2 NO-RETURN>> NO-RETURN)
1179 (<SET TEM <TYPE-AND .P1 .P2>> .TEM)
1180 (<EMPTY? .TEM> .TEM)
1181 (ELSE <MESSAGE ERROR " " <1 .TEM> " " .P1 " " .P2>)>>
1183 " TYPE-ATOM-OK? does an atom's initial value agree with its DECL?"
1185 <DEFINE TYPE-ATOM-OK? (P1 P2 ATM)
1187 <OR <TYPE-OK? .P1 .P2>
1188 <MESSAGE ERROR "TYPE MISUSE " .ATM>>>
1190 " Merge a group of type specs into an OR."
1194 <DEFINE TYPE-MERGE ("TUPLE" TYPS)
1195 #DECL ((TYPS) TUPLE (FTYP) FORM (LN) FIX)
1196 <COND (<EMPTY? .TYPS> <>)
1198 <REPEAT ((ORS <1 .TYPS>))
1199 <COND (<EMPTY? <SET TYPS <REST .TYPS>>> <RETURN .ORS>)>
1201 <COND (<==? <1 .TYPS> NO-RETURN> .ORS)
1202 (<==? .ORS NO-RETURN> <1 .TYPS>)
1203 (ELSE <TMERGE .ORS <1 .TYPS>>)>>>)>>
1205 <DEFINE PUT-IN (LST ELE)
1206 #DECL ((LST) <PRIMTYPE LIST> (VALUE) LIST)
1207 <COND (<AND <TYPE? .ELE FORM SEGMENT>
1210 <SET ELE <LIST !<REST .ELE>>>)
1211 (ELSE <SET ELE (.ELE)>)>
1214 <FUNCTION (L1 "AUX" TT)
1215 <COND (<EMPTY? .ELE> .L1)
1216 (<REPEAT ((A .ELE) B)
1218 <COND (<TMATCH <1 .A> .L1>
1219 <SET TT <TMERGE <1 .A> .L1>>
1220 <COND (<==? .A .ELE> <SET ELE <REST .ELE>>)
1221 (ELSE <PUTREST .B <REST .A>>)>
1223 <AND <EMPTY? <SET A <REST <SET B .A>>>>
1228 <LSORT <COND (<EMPTY? .ELE> .LST)
1229 (ELSE <PUTREST <REST .ELE <- <LENGTH .ELE> 1>> .LST> .ELE)>>>
1231 <DEFINE ORSORT (F) #DECL ((F) <FORM ANY ANY>) <PUTREST .F <LSORT <REST .F>>>>
1233 <DEFINE LSORT (L "AUX" (M ()) (B ()) (TMP ()) (IT ()) (N 0) A1 A2)
1234 #DECL ((L M B TMP IT VALUE) LIST (N) FIX (CMPRSN) <OR FALSE APPLICABLE>)
1236 <COND (<L? <SET N <LENGTH .L>> 2> <RETURN .L>)>
1237 <SET B <REST <SET TMP <REST .L <- </ .N 2> 1>>>>>
1244 <COND (<EMPTY? .TMP> <RETURN .B>)
1245 (ELSE <PUTREST .TMP .B> <RETURN .M>)>)
1247 <COND (<EMPTY? .TMP> <RETURN .L>)
1248 (ELSE <PUTREST .TMP .L> <RETURN .M>)>)
1252 <COND (<COND (<AND <TYPE? .A1 ATOM> <TYPE? .A2 ATOM>>
1253 <L? <STRCOMP .A1 .A2> 0>)
1254 (<TYPE? .A1 ATOM> T)
1255 (<TYPE? .A2 ATOM> <>)
1256 (ELSE <FCOMPARE .A1 .A2>)>
1257 <SET L <REST <SET IT .L>>>)
1258 (ELSE <SET B <REST <SET IT .B>>>)>
1260 <COND (<EMPTY? .M> <SET M <SET TMP .IT>>)
1261 (ELSE <SET TMP <REST <PUTREST .TMP .IT>>>)>)>>>>
1264 <DEFINE FCOMPARE (F1 F2 "AUX" (L1 <LENGTH .F1>) (L2 <LENGTH .F2>))
1265 #DECL ((F1 F2) <PRIMTYPE LIST> (L1 L2) FIX)
1266 <COND (<==? .L1 .L2>
1267 <L? <STRCOMP <UNPARSE .F1> <UNPARSE .F2>> 0>)
1271 <DEFINE CANONICAL-DECL (D)
1273 <COND (<AND <TYPE? .D FORM SEGMENT> <NOT <EMPTY? .D>>>
1274 <COND (<==? <1 .D> OR>
1275 <ORSORT <FORM OR !<CAN-ELE <REST .D>>>>)
1276 (<==? <1 .D> QUOTE> <CANONICAL-DECL <GEN-DECL <2 .D>>>)
1277 (ELSE <CAN-ELE .D>)>)
1281 <DEFINE CAN-ELE (L "AUX" (SAME <>) SAMCNT TT TEM)
1282 #DECL ((L) <PRIMTYPE LIST> (SAMCNT) FIX)
1284 (<CANONICAL-DECL <1 .L>>
1286 <FUNCTION (EL "AUX" (ELE <1 .EL>) (LAST <EMPTY? <REST .EL>>))
1288 (<TYPE? .ELE VECTOR>
1290 (<AND <==? <LENGTH .ELE> 2> <TYPE? <1 .ELE> FIX>>
1291 <SET TT <CANONICAL-DECL <2 .ELE>>>
1292 <COND (<AND .SAME <=? .SAME .TT>>
1293 <SET SAMCNT <+ .SAMCNT <1 .ELE>>>
1294 <COND (.LAST [.SAMCNT .TT]) (ELSE <MAPRET>)>)
1296 <COND (.SAME <SET TEM <GR-RET .SAME .SAMCNT>>)
1297 (ELSE <SET TEM <>>)>
1299 <SET SAMCNT <1 .ELE>>
1301 <COND (.TEM <MAPRET .TEM <GR-RET .TT .SAMCNT>>)
1302 (ELSE <GR-RET .TT .SAMCNT>)>)
1305 (<AND <==? <1 .ELE> REST>
1306 <==? <LENGTH .ELE> 2>
1309 <SET TEM <GR-RET .SAME .SAMCNT>>
1314 <COND (.SAME <SET TEM <GR-RET .SAME .SAMCNT>>)
1315 (ELSE <SET TEM <>>)>
1316 <SET TT <IVECTOR <LENGTH .ELE>>>
1317 <PUT .TT 1 <COND (<==? <1 .ELE> OPT> OPTIONAL) (ELSE <1 .ELE>)>>
1319 <FUNCTION (X Y) <PUT .X 1 <CANONICAL-DECL <1 .Y>>>>
1323 <COND (.TEM <MAPRET .TEM .TT>) (ELSE .TT)>)>)
1325 <SET ELE <CANONICAL-DECL .ELE>>
1326 <COND (<AND .SAME <=? .SAME .ELE>>
1327 <SET SAMCNT <+ .SAMCNT 1>>
1328 <COND (.LAST <GR-RET .ELE .SAMCNT>) (ELSE <MAPRET>)>)
1330 <COND (.SAME <SET TEM <GR-RET .SAME .SAMCNT>>)
1331 (ELSE <SET TEM <>>)>
1334 <COND (.LAST <COND (.TEM <MAPRET .TEM .ELE>) (ELSE .ELE)>)
1336 (ELSE <MAPRET>)>)>)>>
1340 <DEFINE GR-RET (X N) #DECL ((N) FIX)
1341 <COND (<1? .N> .X)(ELSE [.N .X])>>