7 <SETG DECL-ITEM-COUNT 3>
11 <SETG DECL-IN-COUNT-VEC 5>
13 <SETG DECL-REST-VEC 6>
26 <MANIFEST HIGHBOUND LOWBOUND>
28 <SETG ALLWORDS '<PRIMTYPE WORD>>
30 <DEFINE TASTEFUL-DECL (D "AUX" TEM)
31 <COND (<OR <NOT .D> <==? .D NO-RETURN>> ANY)
32 (<AND <TYPE? .D ATOM> <VALID-TYPE? .D>> .D)
33 (<AND <OR <TYPE? <SET TEM .D> ATOM> <SET TEM <ISTYPE? .D>>>
36 (<TYPE? .D FORM SEGMENT>
38 <OR <AND <EMPTY? .D> ANY> <TASTEFUL-DECL <1 .D>>>)
39 (<==? <1 .D> FIX> FIX)
40 (<AND <==? <LENGTH .D> 2> <==? <1 .D> NOT>> ANY)
42 <CHTYPE <MAPF ,LIST ,TASTEFUL-DECL .D> SEGMENT>)
43 (ELSE <CHTYPE <MAPF ,LIST ,TASTEFUL-DECL .D> FORM>)>)
45 [<COND (<==? <1 .D> OPT> OPTIONAL) (ELSE <1 .D>)>
46 !<MAPF ,LIST ,TASTEFUL-DECL <REST .D>>])
49 <DEFINE TMERGE (P1 P2)
50 <COND (<OR <AND <TYPE? .P1 FORM SEGMENT>
53 <AND <TYPE? .P2 FORM SEGMENT>
56 <CTMATCH .P1 .P2 <> <> T>>
57 <CTMATCH .P1 .P2 T T <>>)
58 (<=? .P1 '<NOT ANY>> .P2)
59 (<=? .P2 '<NOT ANY>> .P1)
60 (ELSE <CHTYPE (OR !<PUT-IN <PUT-IN () .P1> .P2>) FORM>)>>
62 <DEFINE TYPE-AND (P1 P2) <CTMATCH .P1 .P2 T <> <>>>
64 <DEFINE TMATCH (P1 P2) <CTMATCH .P1 .P2 <> <> <>>>
66 <DEFINE CTMATCH (P1 P2 ANDF ORF MAYBEF)
67 #DECL ((ANDF ORF MAYBEF) <SPECIAL <OR FALSE ATOM>>)
70 <DEFINE DTMATCH (PAT1 PAT2)
71 <OR .PAT1 <SET PAT1 ANY>>
72 <OR .PAT2 <SET PAT2 ANY>>
73 <COND (<=? .PAT1 .PAT2> .PAT1)
74 (<TYPE? <SET PAT1 <VTS .PAT1>> ATOM> <TYPMAT .PAT1 <VTS .PAT2>>)
75 (<TYPE? <SET PAT2 <VTS .PAT2>> ATOM> <TYPMAT .PAT2 .PAT1>)
76 (<AND <TYPE? .PAT1 FORM SEGMENT> <TYPE? .PAT2 FORM SEGMENT>>
78 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
81 <OR <AND <TYPE? .X ATOM>
83 <MEMQ .X '![STRUCTURED LOCATIVE APPLICABLE ANY!]>>
85 <AND <TYPE? .X ATOM> <GET .X DECL>>
89 #DECL ((OBJ) <PRIMTYPE LIST>)
90 <AND <NOT <EMPTY? .OBJ>> <NOT <EMPTY? <REST .OBJ>>>>>
92 <DEFINE TYPMAT (TYP PAT "AUX" TEM)
95 <COND (<TYPE? .PAT ATOM>
96 <OR <AND <==? .PAT ANY> <COND (.ORF ANY) (ELSE .TYP)>>
97 <AND <==? .TYP ANY> <COND (.ORF ANY) (ELSE .PAT)>>
98 <AND <=? .PAT .TYP> .TYP>
100 <STRUC .PAT .TYP <>>>)
101 (<TYPE? .PAT FORM SEGMENT> <TEXP1 .PAT .TYP>)
102 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
104 <OR <AND <N==? <SET TEM <VTS .TYP>> .TYP> <DTMATCH .TEM .PAT>>
105 <AND <N==? <SET TEM <VTS .PAT>> .PAT>
106 <TYPMAT .TYP .TEM>>>>>>
110 <DEFINE TEXP1 (FORT PAT)
111 #DECL ((FORT) <OR FORM SEGMENT>)
112 <COND (<EMPTY? .FORT> #FALSE (EMPTY-TYPE-FORM!-ERRORS))
113 (<MEMQ <1 .FORT> '![OR AND NOT PRIMTYPE!]> <ACTORT .FORT .PAT>)
114 (<AND <==? <1 .FORT> QUOTE> <2-ELEM .FORT>>
115 <DTMATCH <GEN-DECL <2 .FORT>> .PAT>)
116 (ELSE <FORMATCH .FORT .PAT>)>>
118 <DEFINE ACTORT (FORT PAT "AUX" (ACTOR <1 .FORT>) TEM1)
119 #DECL ((FORT) <PRIMTYPE LIST>)
123 (<EMPTY? <SET FORT <REST .FORT>>>
124 #FALSE (EMPTY-OR-MATCH!-ERRORS))
126 <REPEAT (TEM (AL ()))
129 (<OR <AND <TYPE? <SET TEM <1 .FORT>> ATOM>
131 <COND (<VALID-TYPE? .TEM>)
132 (<SET TEM1 <GET .TEM DECL>>
134 <AND <TYPE? .TEM ATOM> <AGAIN>>)
136 <SET TEM <TYPMAT .TEM .PAT>>>
137 <AND <TYPE? .TEM FORM SEGMENT> <SET TEM <TEXP1 .TEM .PAT>>>>
138 <COND (<==? .ACTOR OR>
141 <COND (<==? .TEM ANY> <RETURN ANY>)>
142 <COND (.ORF <SET AL <PUT-IN .AL .TEM>>)
144 <OR <MEMBER .TEM .AL>
145 <SET AL (.TEM !.AL)>>)>)>)
146 (ELSE <RETURN T>)>)>)
147 (<NOT <EMPTY? .TEM>> <RETURN .TEM>)>
148 <COND (<EMPTY? <SET FORT <REST .FORT>>>
149 <RETURN <AND <NOT <EMPTY? .AL>>
150 <COND (<EMPTY? <REST .AL>> <1 .AL>)
152 <ORSORT <CHTYPE (.ACTOR !.AL)
154 (<==? .ACTOR NOT> <NOT-IT .FORT .PAT>)
155 (ELSE <PTACT .FORT .PAT>)>>
157 <DEFINE PTACT (FORTYP PAT)
158 <COND (<TYPE? .FORTYP FORM SEGMENT>
159 <COND (<AND <2-ELEM .FORTYP> <==? <1 .FORTYP> PRIMTYPE>>
160 <PRIMATCH .FORTYP .PAT>)
161 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
162 (<TYPE? .FORTYP ATOM> <TYPMAT .FORTYP .PAT>)
163 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
167 <DEFINE STRUC (WRD TYP ACTAND)
170 <COND (<COND (<==? .WRD STRUCTURED>
171 <COND (<==? .TYP LOCATIVE> <>)
172 (<==? .TYP APPLICABLE>
173 <RETURN <COND (.ORF '<OR APPLICABLE STRUCTURED>)
175 '<OR RSUBR RSUBR-ENTRY FUNCTION CLOSURE MACRO>)>>)
176 (<AND <VALID-TYPE? .TYP>
177 <MEMQ <TYPEPRIM .TYP>
178 '![LIST VECTOR UVECTOR TEMPLATE STRING TUPLE
181 <MEMQ .TYP '![LOCL LOCAS LOCD LOCV LOCU LOCS LOCA!]>)
182 (<==? .WRD APPLICABLE>
183 <COND (<==? .TYP LOCATIVE> <RETURN <>>)
184 (<==? .TYP STRUCTURED>
185 <RETURN <STRUC .TYP .WRD .ACTAND>>)
187 '![RSUBR SUBR FIX FSUBR FUNCTION
188 RSUBR-ENTRY MACRO CLOSURE
190 <COND (.ORF .WRD) (ELSE .TYP)>)
192 <COND (<AND .ORF <NOT .ACTAND>> <ORSORT <FORM OR .WRD .TYP>>)
195 <DEFINE PRIMATCH (PTYP PAT "AUX" PAT1 ACTOR TEM)
196 #DECL ((PAT1) <PRIMTYPE LIST>
197 (PTYP) <OR <FORM ANY ANY> <SEGMENT ANY ANY>>)
198 <COND (<AND <TYPE? .PAT FORM SEGMENT>
200 <==? <LENGTH .PAT1> 2>
201 <==? <1 .PAT1> PRIMTYPE>>
202 <COND (<==? <2 .PAT1> <2 .PTYP>> .PAT1)
203 (ELSE <COND (.ORF <ORSORT <FORM OR .PAT1 .PTYP>>)>)>)
205 <COND (<==? .PAT ANY> <COND (.ORF ANY) (.ANDF .PTYP) (ELSE T)>)
206 (<MEMQ .PAT '![STRUCTURED LOCATIVE APPLICABLE!]>
207 <COND (<STRUC .PAT <2 .PTYP> T>
208 <COND (.ORF .PAT) (ELSE .PTYP)>)
209 (ELSE <COND (.ORF <ORSORT <FORM OR .PAT .PTYP>>)>)>)
210 (<AND <VALID-TYPE? .PAT>
211 <==? <TYPEPRIM .PAT> <2 .PTYP>>
212 <COND (.ORF .PTYP) (ELSE .PAT)>>)
213 (ELSE <COND (.ORF <ORSORT <FORM OR .PTYP .PAT>>)>)>)
214 (<AND <TYPE? .PAT FORM SEGMENT>
216 <NOT <EMPTY? .PAT1>>>
217 <COND (<==? <SET ACTOR <1 .PAT1>> OR> <ACTORT .PAT .PTYP>)
219 <COND (.ORF <NOT-IT .PAT .PTYP>)
221 <SET TEM <PRIMATCH .PTYP <2 .PAT1>>>
222 <COND (<AND <NOT .TEM> <EMPTY? .TEM>> .PTYP)
224 (<N=? .TEM .PTYP> ANY)>)>)
225 (<SET TEM <PRIMATCH .PTYP <1 .PAT1>>>
227 (.ANDF <COND (<TYPE? .PAT FORM>
228 <FORM .TEM !<REST .PAT1>>)
230 <CHTYPE (.TEM !<REST .PAT1>) SEGMENT>)>)
235 <DEFINE NOT-IT (NF PAT "AUX" T1)
236 #DECL ((NF) <OR FORM SEGMENT>)
237 <COND (<AND <TYPE? .PAT FORM SEGMENT>
239 <OR <==? <1 .PAT> OR> <==? <1 .PAT> AND>>>
242 <COND (<==? <LENGTH .NF> 2>
243 <COND (<NOT <SET T1 <TYPE-AND <2 .NF> .PAT>>>
244 <COND (.ORF .NF) (.ANDF .PAT) (ELSE T)>)
245 (<==? <2 .NF> ANY> <COND (.ORF .PAT)>)
246 (<AND <N==? .T1 .PAT>
248 <N=? <CANONICAL-DECL .PAT>
249 <CANONICAL-DECL .T1>>>
250 <COND (<OR .ANDF .ORF> ANY) (ELSE T)>)
252 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>>
255 <COND (<AND <TYPE? .D FORM SEGMENT>
259 (ELSE <FORM NOT .D>)>>
262 <DEFINE FORMATCH (FRM RPAT "AUX" TEM (PAT .RPAT) EX)
263 #DECL ((FRM) <OR <FORM ANY> <SEGMENT ANY>>
264 (RPAT) <OR ATOM FORM LIST SEGMENT VECTOR FIX>)
266 (<AND <TYPE? .RPAT ATOM> <TYPE? <1 .FRM> ATOM> <==? <1 .FRM> .RPAT>>
267 <COND (.ORF .RPAT) (ELSE .FRM)>)
269 <COND (<TYPE? .RPAT ATOM> <SET PAT <SET EX <GET .RPAT DECL '.RPAT>>>)
270 (ELSE <SET RPAT <1 .PAT>>)>
274 <COND (<AND .ORF <NOT <CTMATCH .PAT <1 .FRM> <> <> T>>>
275 <ORSORT <FORM OR .RPAT .FRM>>)
277 <COND (<TYPE? <1 .FRM> ATOM> <TYPMAT <1 .FRM> .PAT>)
278 (<TYPE? <1 .FRM> FORM> <ACTORT <1 .FRM> .PAT>)>)>>
279 <COND (<AND .ANDF <NOT .ORF> .TEM>
280 <COND (<TYPE? .FRM FORM> <CHTYPE (.TEM !<REST .FRM>) FORM>)
281 (ELSE <CHTYPE (.TEM !<REST .FRM>) SEGMENT>)>)
283 (<TYPE? .PAT FORM SEGMENT>
284 <COND (<MEMQ <1 .PAT> '![OR AND NOT PRIMTYPE!]> <ACTORT .PAT .FRM>)
286 <COND (<AND <==? <LENGTH .PAT> 2> <TYPE? <2 .PAT> LIST>>
287 <WRDFX .PAT .FRM .RPAT>)
288 (<AND <G=? <LENGTH .PAT> 2> <TYPE? <2 .PAT> FIX>>
289 <BYTES-HACK .PAT .FRM .RPAT>)
290 (<AND <G=? <LENGTH .FRM> 2> <TYPE? <2 .FRM> FIX>>
291 <BYTES-HACK .FRM .PAT <1 .FRM>>)
294 <NOT <CTMATCH .RPAT .FRM <> <> T>>>
295 <ORSORT <FORM OR .RPAT .FRM>>)
296 (<AND .ORF <NOT <CTMATCH .PAT .FRM <> <> T>>>
297 <ORSORT <FORM OR .PAT .FRM>>)
299 <SET TEM <ELETYPE .PAT .FRM .RPAT>>
301 <TYPE? .TEM FORM SEGMENT>
306 <AND <=? <1 .EL> .EX>
314 <DEFINE BYTES-HACK (F1 F2 RPAT "AUX" FST TL TEM SEGF MLF1 MLF2)
315 #DECL ((F1 F2) <OR FORM SEGMENT> (MLF1 MLF2) FIX)
316 <SET SEGF <SEGANDOR .F1 .F2 .ORF>>
317 <COND (<OR <EMPTY? .F1> <EMPTY? .F2>> #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))>
319 <COND (<TYPE? .RPAT ATOM>
320 <COND (<TYPE? <1 .F2> ATOM> <TYPMAT <1 .F2> .RPAT>)
321 (<TYPE? <1 .F2> FORM> <ACTORT <1 .F2> .RPAT>)
322 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
323 (<TYPE? .RPAT FORM> <ACTORT .RPAT <1 .F2>>)
324 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
329 (<CTMATCH .RPAT '<PRIMTYPE BYTES> <> <> <>>
330 <SET MLF1 <MINL .F1>>
331 <SET MLF2 <MINL .F2>>
332 <COND (<AND <G=? <LENGTH .F2> 2> <TYPE? <2 .F2> FIX>>
333 <COND (<CTMATCH <1 .F2> '<PRIMTYPE BYTES> <> <> <>>
335 <COND (<==? <2 .F2> <2 .F1>>
336 <FOSE .SEGF .FST <2 .F1> <MIN .MLF1 .MLF2>>)
337 (ELSE <ORSORT <FORM OR .F1 .F2>>)>)
338 (<AND <==? <2 .F2> <2 .F1>>
339 <NOT <AND <TYPE? .F1 SEGMENT>
341 <N==? <2 .F1> <2 .F2>>>>>
342 <FOSE .SEGF .FST <2 .F1> <MAX .MLF1 .MLF2>>)>)
343 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
344 (<TMATCH .F2 '<PRIMTYPE BYTES>>
357 <TYPE-MERGE .TEM .F2>)
358 (ELSE <ORSORT <FORM .F1 .F2>>)>)
361 <FOSE .SEGF STRUCTURED '[REST FIX]>)
367 <FOSE .SEGF .FST <2 .F1> <MAX .MLF2 .MLF1>>)>)
368 (ELSE <COND (.ORF <ORSORT <FORM OR .F1 .F2>>) (ELSE <>)>)>)
369 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>>
371 <DEFINE FOSE ("TUPLE" TUP "AUX" (FLG <1 .TUP>))
372 <COND (.FLG <CHTYPE (!<REST .TUP>) SEGMENT>)
373 (ELSE <CHTYPE (!<REST .TUP>) FORM>)>>
375 <DEFINE SEGANDOR (F1 F2 ORF)
376 <COND (.ORF <AND <TYPE? .F1 SEGMENT> <TYPE? .F2 SEGMENT>>)
377 (ELSE <OR <TYPE? .F1 SEGMENT> <TYPE? .F2 SEGMENT>>)>>
379 <DEFINE WRDFX (F1 F2 RPAT "AUX" FST TL)
380 #DECL ((F1 F2) <OR FORM SEGMENT>)
381 <COND (<OR <EMPTY? <SET F1 <CHTYPE .F1 FORM>>>
382 <EMPTY? <SET F2 <CHTYPE .F2 FORM>>>>
383 #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))>
385 <COND (<TYPE? .RPAT ATOM>
386 <COND (<TYPE? <1 .F2> ATOM> <TYPMAT <1 .F2> .RPAT>)
387 (<TYPE? <1 .F2> FORM> <ACTORT <1 .F2> .RPAT>)
388 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
389 (<TYPE? .RPAT FORM> <ACTORT .RPAT <1 .F2>>)
390 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
394 <COND (<CTMATCH .RPAT ,ALLWORDS <> <> <>>
395 <COND (<AND <LENGTH? .F2 2> <TYPE? <2 .F2> LIST>>
396 <COND (<CTMATCH <1 .F2> ,ALLWORDS <> <><>>
398 <SET TL <MAP-MERGE !<2 .F1> !<2 .F2>>>
399 <COND (<EMPTY? .TL> .FST)
400 (ELSE <FORM .FST .TL>)>)
401 (<SET TL <AND-MERGE <2 .F1> <2 .F2>>>
403 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
404 (ELSE <COND (.ORF <ORSORT <FORM OR .F1 .F2>>) (ELSE <>)>)>)
405 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>>
407 <DEFINE MAP-MERGE ("TUPLE" PAIRS "AUX" (HIGH <2 .PAIRS>) (LOW <1 .PAIRS>))
408 #DECL ((PAIRS) <TUPLE [REST FIX]> (HIGH LOW) FIX)
410 <COND (<EMPTY? <SET PAIRS <REST .PAIRS 2>>> <RETURN>)>
411 <SET HIGH <MAX .HIGH <2 .PAIRS>>>
412 <SET LOW <MIN .LOW <1 .PAIRS>>>>
413 <COND (<AND <==? .HIGH <CHTYPE <MIN> FIX>>
414 <==? .LOW <CHTYPE <MAX> FIX>>>
416 (ELSE (.LOW .HIGH))>>
419 <DEFINE AND-MERGE (L1 L2 "AUX" (FLG <>) HIGH LOW TEM (L (0)) (LL .L))
420 #DECL ((L LL L1 L2) <LIST [REST FIX]> (HIGH LOW) FIX)
421 <COND (<G? <LENGTH .L1> <LENGTH .L2>>
428 <REPEAT ((L1 .L1) LO HI)
429 #DECL ((L1) <LIST [REST FIX]> (LO HI) FIX)
430 <COND (<EMPTY? .L1> <RETURN>)>
432 <COND (<OR <AND <G=? <SET LO <1 .L1>> .LOW>
434 <AND <L=? .HI .HIGH> <G=? .HI .LOW>>
435 <AND <G=? .LOW .LO> <L=? .LOW .HI>>
436 <AND <L=? .HIGH .HI> <G=? .HIGH .LO>>>
437 <SET LOW <MAX .LOW .LO>>
438 <SET HIGH <MIN .HIGH .HI>>
439 <SET L <REST <PUTREST .L (.LOW .HIGH)> 2>>
442 <SET L1 <REST .L1 2>>>
443 <COND (<EMPTY? <SET L2 <REST .L2 2>>>
444 <RETURN <COND (.FLG <REST .LL>) (ELSE <>)>>)>>>
448 <DEFINE GET-RANGE (L1 "AUX" TT)
449 <COND (<AND <TYPE? .L1 FORM>
450 <TMATCH .L1 ,ALLWORDS>
451 <TYPE? <2 .L1> LIST>>
452 <COND (<NOT <EMPTY? <SET TT <MAP-MERGE !<2 .L1>>>>> .TT)>)>>
456 <DEFINE ELETYPE (F1 F2 RTYP
457 "AUX" (S1 <VECTOR .F1 <> 0 <> <> '[]>) (FAIL <>) (INOPT <>)
458 (S2 <VECTOR .F2 <> 0 <> <> '[]>) (FL ()) (FP '<>) FSTL
460 #DECL ((S1 S2) <VECTOR <PRIMTYPE LIST> ANY FIX ANY ANY ANY>
461 (F1 F2) <PRIMTYPE LIST> (FP) <OR FORM SEGMENT> (FL) LIST)
462 <SET SEGF <SEGANDOR .F1 .F2 .ORF>>
464 (<OR <EMPTY? .F1> <EMPTY? .F2>> #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))
465 (<AND .ANDF .ORF <NOT <TMATCH <1 .F2> .RTYP>>> <ORSORT <FORM OR .F1 .F2>>)
469 <COND (<TYPE? .RTYP ATOM>
470 <COND (<TYPE? <1 .F2> ATOM> <TYPMAT .RTYP <1 .F2>>)
471 (<TYPE? <1 .F2> FORM> <ACTORT <1 .F2> .RTYP>)
472 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)
473 (<TYPE? .RTYP FORM> <ACTORT .RTYP <1 .F2>>)
474 (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>>
478 <COND (.SEGF <CHTYPE (.FSTL) SEGMENT>)
479 (ELSE <FORM .FSTL>)>>
481 <PUT .S1 ,DECL-RESTED <REST .F1>>
482 <PUT .S2 ,DECL-RESTED <REST .F2>>
483 <REPEAT ((TEM1 <>) (TEM2 <>) T1 T2 TEM TT)
484 #DECL ((TT) <VECTOR FIX ANY>)
487 (<AND <OR <AND <SET TEM1 <NEXTP .S1>> <SET T1 <DECL-ELEMENT .S1>>>
488 <AND <EMPTY? .TEM1> <SET T1 ANY>>>
489 <OR <AND <SET TEM2 <NEXTP .S2>> <SET T2 <DECL-ELEMENT .S2>>>
490 <AND .TEM1 <EMPTY? .TEM2> <SET T2 ANY>>>>
491 <COND (<AND .ORF <OR <NOT .TEM1> <NOT .TEM2>>>
492 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>) (ELSE .FP)>>)>
496 <COND (<OR <TYPE? .F1 FORM> <DECL-IN-REST .S2>>
498 (ELSE <SET FAIL T> <>)>)
500 <COND (<OR <TYPE? .F2 FORM> <DECL-IN-REST .S1>>
502 (ELSE <SET FAIL T> <>)>)
503 (ELSE <DTMATCH .T1 .T2>)>>>
504 <COND (.ORF <SET TEM <ORSORT <FORM OR .T1 .T2>>>)
505 (.MAYBEF <COND (.FAIL <RETURN <>>) (ELSE <SET FAIL T>)>)
507 <COND (<AND <NOT .INOPT>
509 <OR <DECL-IN-COUNT-VEC .S1>
510 <DECL-IN-COUNT-VEC .S2>>>
513 <DECL-IN-COUNT-VEC .S1>
514 <DECL-IN-COUNT-VEC .S2>>>>
515 <SET INOPT <COND (.ANDF (OPTIONAL .TEM)) (ELSE ())>>)
517 <PUTREST <REST .INOPT <- <LENGTH .INOPT> 1>> (.TEM)>)>
520 <OR <0? <DECL-ITEM-COUNT .S1>>
521 <0? <DECL-ITEM-COUNT .S2>>>>
523 <0? <DECL-ITEM-COUNT .S1>>
524 <0? <DECL-ITEM-COUNT .S2>>>>>
525 <AND .ANDF <SET TEM [!.INOPT]>>
529 <OR <AND <DECL-IN-REST .S1> <EMPTY? <DECL-RESTED .S2>>>
530 <AND <DECL-IN-REST .S2> <EMPTY? <DECL-RESTED .S1>>>>>
531 <AND <OR <DECL-IN-REST .S1>
532 <AND .ANDF <OR <NOT .TEM1> <DECL-IN-COUNT-VEC .S1>>>>
533 <OR <DECL-IN-REST .S2>
535 <OR <NOT .TEM2> <DECL-IN-COUNT-VEC .S2>>>>>>
544 <TYPE? .F2 SEGMENT>>>>
546 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>)
549 <RETURN <COND (<AND <TYPE? .T1 FORM SEGMENT>
559 <TYPE? .F1 SEGMENT>>>>
561 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>)
564 <RETURN <COND (<AND <TYPE? .T1 FORM SEGMENT>
570 <OR <DECL-IN-REST .S1> <NOT .TEM1>>
571 <OR <DECL-IN-REST .S2> <NOT .TEM2>>>
573 <COND (<AND <NOT .INOPT>
576 <NOT <OR <DECL-IN-REST .S1> <DECL-IN-REST .S2>>>>>
577 <COND (<AND <TYPE? <1 .FL> VECTOR>
578 <=? <2 <SET TT <1 .FL>>> .TEM>>
579 <PUT .TT 1 <+ <1 .TT> 1>>)
580 (<AND <N==? <CHTYPE .FP LIST> .FL> <=? .TEM <1 .FL>>>
581 <PUT .FL 1 [2 .TEM]>)
582 (ELSE <SET FL <REST <PUTREST .FL (.TEM)>>>)>)>)
584 <COND (<AND <EMPTY? .TEM1> <EMPTY? <SET TEM1 .TEM2>>>
586 <RETURN <COND (<LENGTH? .FP 1> <1 .FP>) (ELSE .FP)>>)
588 (ELSE <RETURN .TEM1>)>)>>)>)>>
592 <DEFINE RESTER? (S1 S2 FL FST SEGF
593 "AUX" (TT <DECL-REST-VEC .S1>) (TEM1 T) (TEM2 T) (OPTIT <>))
594 #DECL ((S1 S2) <VECTOR ANY ANY ANY ANY ANY VECTOR> (FL) <LIST ANY>
596 <COND (<AND <OR .ORF <DECL-IN-COUNT-VEC .S2>>
597 <EMPTY? <DECL-RESTED .S2>> <NOT <DECL-IN-REST .S2>>>
600 (<AND .SEGF <NOT .ORF> <OR <NOT <DECL-IN-REST .S1>>
601 <NOT <DECL-IN-REST .S2>>>> T)
602 (<AND <NOT <EMPTY? .TT>>
603 <OR <NOT <DECL-IN-REST .S2>> <G=? <LENGTH .TT>
604 <LENGTH <REST <TOP <DECL-REST-VEC .S2>>>>>>>
605 <SET TT <REST <TOP .TT>>>
607 <FUNCTION (SO "AUX" T1)
608 #DECL ((SO) <VECTOR ANY>)
610 <OR <AND <SET TEM1 <NEXTP .S2>> <DECL-ELEMENT .S2>>
612 <COND (.ORF <MAPLEAVE>) (ELSE ANY)>>>>
613 <AND <OR .ORF <DECL-IN-COUNT-VEC .S2>>
614 <EMPTY? <DECL-RESTED .S2>>
615 <NOT <DECL-IN-REST .S2>>
617 <COND (<NOT .TEM1> <AND <EMPTY? .TEM1> <SET TEM1 T>>)>
622 <DTMATCH <AND <NEXTP .S1>
623 <DECL-ELEMENT .S1>> .T1>>>)>
624 <AND <OR <NOT .T1> <NOT .TEM2>> <MAPLEAVE>>>
625 <REST <SET TT [REST .FST !<REST .TT>]> 2>>
626 <COND (.OPTIT <PUT .TT 1 OPTIONAL>)
627 (ELSE <SET TT <UNIQUE-VECTOR-CHECK .TT>>)>
628 <COND (<AND .TEM1 .TEM2> <PUTREST .FL (.TT)> T)
629 (<AND <NOT .TEM1> <NOT <EMPTY? .TEM1>>> .TEM1)
633 <DEFINE UNIQUE-VECTOR-CHECK (V "AUX" (FRST <2 .V>))
634 #DECL ((V) <VECTOR [2 ANY]>)
636 <FUNCTION (X) <COND (<N=? .X .FRST> <MAPLEAVE .V>)>>
638 (ELSE [REST .FRST])>>
641 <DEFINE NEXTP (S "AUX" TEM TT N)
642 #DECL ((S) <VECTOR <PRIMTYPE LIST> ANY FIX ANY ANY ANY> (N) FIX
644 <COND (<0? <DECL-ITEM-COUNT .S>> <PUT .S ,DECL-IN-COUNT-VEC <>>)>
645 <COND (<DECL-IN-REST .S> <NTHREST .S>)
646 (<NOT <0? <DECL-ITEM-COUNT .S>>>
647 <PUT .S ,DECL-ITEM-COUNT <- <DECL-ITEM-COUNT .S> 1>>
649 (<EMPTY? <SET TEM <DECL-RESTED .S>>> <>)
650 (<TYPE? <1 .TEM> ATOM FORM SEGMENT>
652 <PUT .S ,DECL-RESTED <REST <DECL-RESTED .S>>>
653 <PUT .S ,DECL-ELEMENT .TEM>)
654 (<TYPE? <1 .TEM> VECTOR>
656 <PUT .S ,DECL-RESTED <REST <DECL-RESTED .S>>>
657 <PUT .S ,DECL-REST-VEC <REST .TT>>
658 <COND (<G? <LENGTH .TT> 1>
659 <COND (<==? <1 .TT> REST>
660 <COND (<AND <==? <LENGTH .TT> 2>
664 <PUT .S ,DECL-IN-REST T>
667 <DECL-ELEMENT .TT>>)>)
668 (<OR <AND <TYPE? <1 .TT> FIX> <SET N <1 .TT>>>
669 <AND <MEMQ <1 .TT> '![OPT OPTIONAL!]>
671 <OR <TYPE? <1 .TT> FIX>
672 <PUT .S ,DECL-IN-COUNT-VEC T>>
675 <- <* .N <- <LENGTH .TT> 1>> 1>>
676 <PUT .S ,DECL-ELEMENT <2 .TT>>
677 <COND (<L=? .N 0> <>) (ELSE .S)>)
678 (#FALSE (BAD-VECTOR-SYNTAX!-ERRORS))>)
679 (ELSE #FALSE (BAD-FORM-SYNTAX!-ERRORS))>)
680 (ELSE #FALSE (BAD-FORM-SYNTAX!-ERRORS))>>
684 <DEFINE NTHREST (S "AUX" (TEM <REST <DECL-REST-VEC .S>>))
685 #DECL ((S) <VECTOR ANY ANY ANY ANY ANY VECTOR> (TEM) VECTOR)
686 <COND (<EMPTY? .TEM> <SET TEM <REST <TOP .TEM>>>)>
687 <PUT .S ,DECL-REST-VEC .TEM>
688 <PUT .S ,DECL-ELEMENT <1 .TEM>>>
691 <DEFINE GET-ELE-TYPE (DCL2 NN
692 "OPTIONAL" (RST <>) (PT <>)
693 "AUX" (LN 0) (CNT 0) ITYP DC SDC DCL (N 0) DC1 (QOK <>)
694 (FMOK <>) STRU (GD '<>) (GP ()) (K 0) (DCL1 .DCL2)
696 #DECL ((LN CNT K N) FIX (DCL) <PRIMTYPE LIST> (SDC DC) VECTOR
697 (GD) <OR FORM SEGMENT> (GP) LIST)
699 <COND (<AND .PT <SET TEM <ISTYPE? .DCL1>>>
700 <SET PT <TYPE-AND <GET-ELE-TYPE .TEM .NN> .PT>>)>
701 <AND <TYPE? .DCL1 ATOM> <SET DCL1 <GET .DCL1 DECL '.DCL1>>>
702 <COND (<TYPE? .DCL1 SEGMENT> <SET SEGF T>)>
703 <COND (<==? <STRUCTYP .DCL2> BYTES>
704 <RETURN <GET-ELE-BYTE .DCL2 .NN .RST .PT>>)>
705 <COND (.RST <SET STRU <COND (<STRUCTYP .DCL1>) (ELSE STRUCTURED)>>)
708 <COND (<ISTYPE? .DCL2>)
709 (<SET STRU <STRUCTYP .DCL1>> <FORM PRIMTYPE .STRU>)
710 (ELSE STRUCTURED)>>)>
712 (<AND <TYPE? .DCL1 FORM SEGMENT>
714 <G? <SET LN <LENGTH .DCL>> 1>
715 <NOT <SET FMOK <MEMQ <1 .DCL> '![OR AND NOT!]>>>
716 <NOT <SET QOK <==? <1 .DCL> QUOTE>>>
717 <NOT <==? <1 .DCL> PRIMTYPE>>>
720 <AND .PT <SET GP <CHTYPE <SET GD <FOSE .SEGF .STRU>> LIST>>>
722 <AND <TYPE? <SET DC1 <2 .DCL>> VECTOR>
726 <COND (<==? <LENGTH .DC> 2>
727 <COND (.RST <FORM .STRU [REST <2 .DC>]>)
728 (.PT <FORM .STRU [REST <TYPE-MERGE <2 .DC> .PT>]>)
730 (.RST <FORM .STRU [REST <TYPE-MERGE !<REST .DC>>]>)
735 <FUNCTION (D) <TYPE-MERGE .D .PT>>
737 (ELSE <TYPE-MERGE !<REST .DC>>)>>
738 <REPEAT (TT (CK <DCX <SET TT <2 .DCL>>>) (D .DCL) TEM)
739 #DECL ((D) <PRIMTYPE LIST>)
740 <COND (<EMPTY? <SET D <REST .D>>>
743 <AND <TYPE? .TT VECTOR> <==? <1 .TT> REST>>>>
745 <COND (.RST <FORM .STRU [REST .CK]>)
751 <SET CK <TYPE-MERGE .CK <DCX <SET TT <1 .D>>>>>
756 (<COND (<TYPE? .TT VECTOR>
763 <TYPE-MERGE .PT .TT>)>)>>>>>>)
766 <AND .PT <SET GP <CHTYPE <SET GD <FOSE .SEGF .STRU>> LIST>>>
767 <AND .RST <SET N <+ .N 1>>>
768 <COND (<EMPTY? <SET DCL <REST .DCL>>>
769 <RETURN <COND (.RST .STRU)
770 (.PT <FOSE .SEGF .STRU !<ANY-PAT <- .N 1>> .PT>)
776 (<EMPTY? <SET SDC <REST .SDC>>>
779 <0? <SET CNT <- .CNT 1>>>
780 <COND (<EMPTY? <SET DCL <REST .DCL>>>
781 <RETURN <COND (.RST .STRU)
783 <PUTREST .GP (!<ANY-PAT <- .N 1>> .PT)>
788 (<TYPE? <1 .DCL> ATOM FORM SEGMENT>
790 <SET DCL <REST .DCL>>)
791 (<TYPE? <SET DC1 <1 .DCL>> VECTOR>
795 <AND <OR <AND .RST <NOT <1? .N>>> .PT>
797 <=? <2 .DC> '<NOT ANY>>
799 <SET K <MOD <- .N 1> <- <LENGTH .DC> 1>>>
800 <SET N </ <- .N 1> <- <LENGTH .DC> 1>>>
807 (ELSE [REST <TYPE-MERGE !<REST .DC>>])>>)
811 (!<COND (<L=? .N 0> ())
812 (<1? .N> (!<REST .DC>))
813 (ELSE ([.N !<REST .DC>]))>
816 <COND (<==? <SET K <- .K 1>> -1> .PT)
821 (ELSE <NTH .DC <+ .K 2>>)>>)
822 (<OR <TYPE? <1 .DC> FIX> <==? <1 .DC> OPT> <==? <1 .DC> OPTIONAL>>
823 <SET CNT <COND (<TYPE? <1 .DC> FIX> <1 .DC>) (ELSE 1)>>
827 <0? <SET N <- .N 1>>>
831 <COND (<AND <EMPTY? .DCL> <0? .CNT>> .STRU)
834 !<COND (<0? .CNT> (.ITYP !.DCL))
835 (<N==? .SDC <REST .DC>>
836 <COND (<0? <SET CNT <- .CNT 1>>>
837 (!.SDC !<REST .DCL>))
842 (ELSE ([.CNT !.SDC] !<REST .DCL>))>>)>)
844 <SET GP <REST <PUTREST .GP (.PT)>>>
845 <AND <ASSIGNED? SDC> <SET SDC <REST .SDC>>>
846 <COND (<AND <EMPTY? .DCL> <0? .CNT>> .GD)
849 <AND <1? .CNT> <==? .SDC <REST .DC>>>>
851 (<==? .SDC <REST .DC>>
852 ([.CNT !<REST .DC>] !<REST .DCL>))
853 (<L=? <SET CNT <- .CNT 1>> 0>
854 (!.SDC !<REST .DCL>))
861 <AND <OR .PT .RST> <=? .ITYP '<NOT ANY>> <RETURN <>>>
862 <AND .PT <SET GP <REST <PUTREST .GP (.ITYP)>>>>
864 <RETURN <COND (.RST .STRU)
866 <PUTREST .GP (!<ANY-PAT <- .N 1>> .PT)>
869 (.QOK <SET DCL1 <GEN-DECL <2 .DCL>>> <AGAIN>)
870 (<AND .FMOK <==? <1 .FMOK> OR>>
872 <FUNCTION (D "AUX" IT)
873 <COND (<SET IT <GET-ELE-TYPE .D .NN .RST .PT>>
874 <AND <==? .IT ANY> <MAPLEAVE ANY>>
878 (<AND .FMOK <==? <1 .FMOK> AND>>
882 <SET ITYP <TYPE-OK? .ITYP <GET-ELE-TYPE .D .NN .RST>>>>
885 (.RST <COND (<STRUCTYP .DCL1>) (ELSE STRUCTURED)>)
887 <COND (<==? .NN ALL> .DCL1)
888 (ELSE <FOSE .SEGF .DCL1 !<ANY-PAT <- .NN 1>> .PT>)>)
893 <DEFINE GET-ELE-BYTE (DCL N RST PT "AUX" SIZ)
894 #DECL ((N) <OR ATOM FIX>)
896 <COND (<==? .N ALL> .DCL)
897 (<TYPE-AND .DCL <FORM STRUCTURED [.N FIX] [REST FIX]>>)>)
899 <COND (<==? .N ALL> <SET N <MINL .DCL>>)
900 (<G? .N <MINL .DCL>> <SET N 0>)
901 (ELSE <SET N <- <MINL .DCL> .N>>)>
902 <COND (<SET SIZ <GETBSYZ .DCL>> <FORM BYTES .SIZ .N>)
906 <DEFINE GETBSYZ (DCL "AUX" TEM)
907 <COND (<==? <SET TEM <STRUCTYP .DCL>> STRING> 7)
908 (<AND <==? .TEM BYTES> <TYPE? .DCL FORM SEGMENT> <G=? <LENGTH .DCL> 2>
909 <TYPE? <SET TEM <2 .DCL>> FIX>>
912 <DEFINE MINL (DCL "AUX" (N 0) DD D DC (LN 0) (QOK <>) (ANDOK <>) TT (OROK <>))
913 #DECL ((N VALUE LN) FIX (DC) <PRIMTYPE LIST> (D) VECTOR)
914 <AND <TYPE? .DCL ATOM> <SET DCL <GET .DCL DECL '.DCL>>>
916 (<AND <TYPE? .DCL FORM SEGMENT>
919 <N==? <SET TT <1 .DC>> PRIMTYPE>
920 <NOT <SET OROK <==? .TT OR>>>
921 <NOT <SET QOK <==? .TT QUOTE>>>
922 <NOT <SET ANDOK <==? .TT AND>>>
925 <COND (<AND <NOT <EMPTY? .DC>> <TYPE? <1 .DC> FIX>>
926 <OR <TMATCH .TT '<PRIMTYPE BYTES>>
927 <MESSAGE ERROR "BAD-DECL-SYNTAX" .DCL>>
928 <COND (<AND <==? <LENGTH .DC> 2> <TYPE? <2 .DC> FIX>>
934 <COND (<AND <TYPE? <SET DD <1 .DC>> VECTOR>
937 <COND (<MEMQ <1 .D> '[REST OPT OPTIONAL]> <RETURN .N>)
940 <SET N <+ .N <* .LN <- <LENGTH .D> 1>>>>)
941 (ELSE <MESSAGE ERROR "BAD DECL " .DCL>)>)
942 (<TYPE? .DD ATOM FORM SEGMENT> <SET N <+ .N 1>>)
943 (ELSE <MESSAGE ERROR "BAD DECL " .DCL>)>
944 <AND <EMPTY? <SET DC <REST .DC>>> <RETURN .N>>>)>)
945 (<OR .OROK .ANDOK> <CHTYPE <MAPF <COND (.OROK ,MIN) (ELSE ,MAX)> ,MINL <REST .DC>>
947 (.QOK <COND (<STRUCTURED? <2 .DC>> <LENGTH <2 .DC>>) (ELSE 0)>)
948 (<TYPE? .DCL ATOM FALSE FORM SEGMENT> 0)
949 (ELSE <MESSAGE "BAD DECL " .DCL>)>>
951 <DEFINE STRUCTYP (DCL)
952 <SET DCL <TYPE-AND .DCL STRUCTURED>>
953 <COND (<TYPE? .DCL ATOM>
954 <AND <VALID-TYPE? .DCL> <TYPEPRIM .DCL>>)
955 (<TYPE? .DCL FORM SEGMENT>
956 <COND (<PRIMHK .DCL T>)
957 (<TYPE? <1 .DCL> FORM> <PRIMHK <1 .DCL> <>>)>)>>
959 <DEFINE PRIMHK (FRM FLG "AUX" TEM (LN <LENGTH .FRM>))
960 #DECL ((FRM) <OR FORM SEGMENT> (LN) FIX)
961 <COND (<AND <==? .LN 2>
962 <COND (<==? <SET TEM <1 .FRM>> PRIMTYPE>
963 <AND <TYPE? <SET TEM <2 .FRM>> ATOM>
965 <STRUCTYP <2 .FRM>>>)
966 (<==? .TEM QUOTE> <PRIMTYPE <2 .FRM>>)
967 (<==? .TEM NOT> <>)>>)
969 <COND (<==? <SET TEM <1 .FRM>> OR>
973 <SET TEM <TYPE-MERGE <STRUCTYP .D> .TEM>>> <REST .FRM>>
974 <COND (<AND <TYPE? .TEM ATOM> <VALID-TYPE? .TEM>> .TEM)>)
978 <COND (<SET TEM <STRUCTYP .D>> <MAPLEAVE>)>>
981 (<AND <TYPE? .TEM ATOM> <VALID-TYPE? .TEM>>
986 <DEFINE TYPESAME (T1 T2)
987 <AND <SET T1 <ISTYPE? .T1>>
988 <==? .T1 <ISTYPE? .T2>>>>
990 <DEFINE ISTYPE-GOOD? (TYP "OPTIONAL" (STRICT <>))
991 <AND <SET TYP <ISTYPE? .TYP .STRICT>>
992 <NOT <MEMQ <TYPEPRIM .TYP> '![BYTES STRING LOCD TUPLE FRAME!]>>
995 <DEFINE TOP-TYPE (TYP "AUX" TT)
996 <COND (<AND <TYPE? .TYP ATOM> <NOT <VALID-TYPE? .TYP>>
997 <NOT <MEMQ .TYP '![STRUCTURED APPLICABLE ANY LOCATIVE]>>>
998 <SET TYP <GET .TYP DECL '.TYP>>)>
999 <COND (<TYPE? .TYP ATOM> .TYP)
1000 (<AND <TYPE? .TYP FORM SEGMENT> <NOT <LENGTH? .TYP 1>>>
1001 <COND (<==? <SET TT <1 .TYP>> OR>
1002 <MAPF ,TYPE-MERGE ,TOP-TYPE <REST .TYP>>)
1004 (<==? .TT QUOTE> <TYPE <2 .TYP>>)
1005 (<==? .TT PRIMTYPE> .TYP)
1008 <DEFINE ISTYPE? (TYP "OPTIONAL" (STRICT <>) "AUX" TY)
1010 <OR .STRICT <TYPE? .TYP ATOM> <SET TYP <TYPE-AND .TYP '<NOT
1013 (<TYPE? .TYP FORM SEGMENT>
1014 <COND (<AND <==? <LENGTH .TYP> 2> <==? <1 .TYP> QUOTE>>
1015 <SET TYP <TYPE <2 .TYP>>>)
1017 <SET TYP <ISTYPE? <2 <SET TY .TYP>>>>
1020 <COND (<N==? .TYP <ISTYPE? .Z>>
1021 <MAPLEAVE <SET TYP <>>>)>>
1023 (ELSE <SET TYP <1 .TYP>>)>)>
1024 <AND <TYPE? .TYP ATOM>
1025 <COND (<VALID-TYPE? .TYP> .TYP)
1026 (<SET TYP <GET .TYP DECL>> <AGAIN>)>>>>
1029 <DEFINE DCX (IT "AUX" TT LN)
1030 #DECL ((TT) VECTOR (LN) FIX)
1031 <COND (<AND <TYPE? .IT VECTOR>
1032 <G=? <SET LN <LENGTH <SET TT .IT>>> 2>
1033 <COND (<==? .LN 2> <2 .TT>)
1034 (ELSE <TYPE-MERGE !<REST .TT>>)>>)
1037 "DETERMINE IF A TYPE PATTERN REQUIRES DEFERMENT 0=> NO 1=> YES 2=> DONT KNOW "
1041 <DEFINE DEFERN (PAT "AUX" STATE TEM)
1046 <COND (<VALID-TYPE? .PAT>
1047 <COND (<MEMQ <SET PAT <TYPEPRIM .PAT>>
1048 '![STRING TUPLE LOCD FRAME BYTES!]>
1051 (<SET PAT <GET .PAT DECL>> <AGAIN>)
1053 (<AND <TYPE? .PAT FORM SEGMENT> <NOT <EMPTY? .PAT>>>
1054 <COND (<==? <SET TEM <1 .PAT>> QUOTE> <DEFERN <TYPE <2 .PAT>>>)
1055 (<==? .TEM PRIMTYPE> <DEFERN <2 .PAT>>)
1056 (<AND <==? .TEM OR> <NOT <EMPTY? <REST .PAT>>>>
1057 <SET STATE <DEFERN <2 .PAT>>>
1060 <OR <==? <DEFERN .P> .STATE> <SET STATE 2>>>
1068 <COND (<L? <SET STATE <DEFERN .P>> 2>
1072 (ELSE <DEFERN <1 .PAT>>)>)
1075 " Define a decl for a given quoted object for maximum winnage."
1079 <DEFINE GEN-DECL (OBJ)
1081 (<OR <MONAD? .OBJ> <APPLICABLE? .OBJ> <TYPE? .OBJ STRING>> <TYPE .OBJ>)
1082 (<==? <PRIMTYPE .OBJ> BYTES>
1083 <CHTYPE (<TYPE .OBJ> <BYTE-SIZE .OBJ> <LENGTH .OBJ>) SEGMENT>)
1085 <REPEAT ((DC <GEN-DECL <1 .OBJ>>) (CNT 1)
1086 (FRM <CHTYPE (<TYPE .OBJ>) SEGMENT>) (FRME .FRM) TT T1)
1087 #DECL ((CNT) FIX (FRME) <<PRIMTYPE LIST> ANY>)
1088 <COND (<EMPTY? <SET OBJ <REST .OBJ>>>
1090 <SET FRME <REST <PUTREST .FRME ([.CNT .DC])>>>)
1091 (ELSE <SET FRME <REST <PUTREST .FRME (.DC)>>>)>
1093 (<AND <=? <SET TT <GEN-DECL <1 .OBJ>>> .DC> .DC>
1094 <SET CNT <+ .CNT 1>>)
1097 <SET FRME <REST <PUTREST .FRME ([.CNT .DC])>>>)
1098 (ELSE <SET FRME <REST <PUTREST .FRME (.DC)>>>)>
1104 <DEFINE REST-DECL (DC N "AUX" TT TEM)
1107 (<TYPE? .DC FORM SEGMENT>
1109 (<OR <==? <SET TT <1 .DC>> OR> <==? .TT AND>>
1113 <FUNCTION (D "AUX" (IT <REST-DECL .D .N>))
1114 <COND (<==? .IT ANY>
1115 <COND (<==? .TT OR> <MAPLEAVE (ANY)>)
1120 <COND (<EMPTY? <REST .TT>> ANY)
1121 (<EMPTY? <REST .TT 2>> <2 .TT>)
1124 (<==? <STRUCTYP .DC> BYTES>
1125 <COND (<==? .TT PRIMTYPE>
1127 (<==? <LENGTH .DC> 2>
1128 <CHTYPE (!.DC .N) FORM>)
1129 (<FORM .TT <2 .DC> <+ <CHTYPE <3 .DC> FIX> .N>>)>)
1132 (ELSE <CHTYPE (.DC !<ANY-PAT .N>) FORM>)>)
1134 <FOSE <TYPE? .DC SEGMENT> <COND (<SET TEM <STRUCTYP .TT>> <FORM PRIMTYPE .TEM>)
1138 (<SET TEM <STRUCTYP .DC>>
1140 <==? .TEM BYTES>> <FORM PRIMTYPE .TEM>)
1141 (ELSE <CHTYPE (<FORM PRIMTYPE .TEM> !<ANY-PAT .N>) FORM>)>)
1143 <COND (<0? .N> STRUCTURED)
1144 (ELSE <CHTYPE (STRUCTURED !<ANY-PAT .N>) FORM>)>)>>
1148 <COND (<L=? .N 0> ()) (<1? .N> (ANY)) (ELSE ([.N ANY]))>>
1150 " TYPE-OK? are two type patterns compatible. If the patterns
1151 don't parse, send user a message."
1153 <DEFINE TYPE-OK? (P1 P2 "AUX" TEM)
1154 <COND (<OR <==? .P1 NO-RETURN> <==? .P2 NO-RETURN>> NO-RETURN)
1155 (<SET TEM <TYPE-AND .P1 .P2>> .TEM)
1156 (<EMPTY? .TEM> .TEM)
1157 (ELSE <MESSAGE ERROR " " <1 .TEM> " " .P1 " " .P2>)>>
1159 " TYPE-ATOM-OK? does an atom's initial value agree with its DECL?"
1161 <DEFINE TYPE-ATOM-OK? (P1 P2 ATM)
1163 <OR <TYPE-OK? .P1 .P2>
1164 <MESSAGE ERROR "TYPE MISUSE " .ATM>>>
1166 " Merge a group of type specs into an OR."
1170 <DEFINE TYPE-MERGE ("TUPLE" TYPS)
1171 #DECL ((TYPS) TUPLE (FTYP) FORM (LN) FIX)
1172 <COND (<EMPTY? .TYPS> <>)
1174 <REPEAT ((ORS <1 .TYPS>))
1175 <COND (<EMPTY? <SET TYPS <REST .TYPS>>> <RETURN .ORS>)>
1177 <COND (<==? <1 .TYPS> NO-RETURN> .ORS)
1178 (<==? .ORS NO-RETURN> <1 .TYPS>)
1179 (ELSE <TMERGE .ORS <1 .TYPS>>)>>>)>>
1181 <DEFINE PUT-IN (LST ELE)
1182 #DECL ((LST) <PRIMTYPE LIST> (VALUE) LIST)
1183 <COND (<AND <TYPE? .ELE FORM SEGMENT>
1186 <SET ELE <LIST !<REST .ELE>>>)
1187 (ELSE <SET ELE (.ELE)>)>
1190 <FUNCTION (L1 "AUX" TT)
1191 <COND (<EMPTY? .ELE> .L1)
1192 (<REPEAT ((A .ELE) B)
1194 <COND (<TMATCH <1 .A> .L1>
1195 <SET TT <TMERGE <1 .A> .L1>>
1196 <COND (<==? .A .ELE> <SET ELE <REST .ELE>>)
1197 (ELSE <PUTREST .B <REST .A>>)>
1199 <AND <EMPTY? <SET A <REST <SET B .A>>>>
1204 <LSORT <COND (<EMPTY? .ELE> .LST)
1205 (ELSE <PUTREST <REST .ELE <- <LENGTH .ELE> 1>> .LST> .ELE)>>>
1207 <DEFINE ORSORT (F) #DECL ((F) <FORM ANY ANY>) <PUTREST .F <LSORT <REST .F>>>>
1209 <DEFINE LSORT (L "AUX" (M ()) (B ()) (TMP ()) (IT ()) (N 0) A1 A2)
1210 #DECL ((L M B TMP IT VALUE) LIST (N) FIX (CMPRSN) <OR FALSE APPLICABLE>)
1212 <COND (<L? <SET N <LENGTH .L>> 2> <RETURN .L>)>
1213 <SET B <REST <SET TMP <REST .L <- </ .N 2> 1>>>>>
1220 <COND (<EMPTY? .TMP> <RETURN .B>)
1221 (ELSE <PUTREST .TMP .B> <RETURN .M>)>)
1223 <COND (<EMPTY? .TMP> <RETURN .L>)
1224 (ELSE <PUTREST .TMP .L> <RETURN .M>)>)
1228 <COND (<COND (<AND <TYPE? .A1 ATOM> <TYPE? .A2 ATOM>>
1229 <L? <STRCOMP .A1 .A2> 0>)
1230 (<TYPE? .A1 ATOM> T)
1231 (<TYPE? .A2 ATOM> <>)
1232 (ELSE <FCOMPARE .A1 .A2>)>
1233 <SET L <REST <SET IT .L>>>)
1234 (ELSE <SET B <REST <SET IT .B>>>)>
1236 <COND (<EMPTY? .M> <SET M <SET TMP .IT>>)
1237 (ELSE <SET TMP <REST <PUTREST .TMP .IT>>>)>)>>>>
1240 <DEFINE FCOMPARE (F1 F2 "AUX" (L1 <LENGTH .F1>) (L2 <LENGTH .F2>))
1241 #DECL ((F1 F2) <PRIMTYPE LIST> (L1 L2) FIX)
1242 <COND (<==? .L1 .L2>
1243 <L? <STRCOMP <UNPARSE .F1> <UNPARSE .F2>> 0>)
1247 <DEFINE CANONICAL-DECL (D)
1249 <COND (<AND <TYPE? .D FORM SEGMENT> <NOT <EMPTY? .D>>>
1250 <COND (<==? <1 .D> OR>
1251 <ORSORT <FORM OR !<CAN-ELE <REST .D>>>>)
1252 (<==? <1 .D> QUOTE> <CANONICAL-DECL <GEN-DECL <2 .D>>>)
1253 (ELSE <CAN-ELE .D>)>)
1257 <DEFINE CAN-ELE (L "AUX" (SAME <>) SAMCNT TT TEM)
1258 #DECL ((L) <PRIMTYPE LIST> (SAMCNT) FIX)
1260 (<CANONICAL-DECL <1 .L>>
1262 <FUNCTION (EL "AUX" (ELE <1 .EL>) (LAST <EMPTY? <REST .EL>>))
1264 (<TYPE? .ELE VECTOR>
1266 (<AND <==? <LENGTH .ELE> 2> <TYPE? <1 .ELE> FIX>>
1267 <SET TT <CANONICAL-DECL <2 .ELE>>>
1268 <COND (<AND .SAME <=? .SAME .TT>>
1269 <SET SAMCNT <+ .SAMCNT <1 .ELE>>>
1270 <COND (.LAST [.SAMCNT .TT]) (ELSE <MAPRET>)>)
1272 <COND (.SAME <SET TEM <GR-RET .SAME .SAMCNT>>)
1273 (ELSE <SET TEM <>>)>
1275 <SET SAMCNT <1 .ELE>>
1277 <COND (.TEM <MAPRET .TEM <GR-RET .TT .SAMCNT>>)
1278 (ELSE <GR-RET .TT .SAMCNT>)>)
1281 (<AND <==? <1 .ELE> REST>
1282 <==? <LENGTH .ELE> 2>
1285 <SET TEM <GR-RET .SAME .SAMCNT>>
1290 <COND (.SAME <SET TEM <GR-RET .SAME .SAMCNT>>)
1291 (ELSE <SET TEM <>>)>
1292 <SET TT <IVECTOR <LENGTH .ELE>>>
1293 <PUT .TT 1 <COND (<==? <1 .ELE> OPT> OPTIONAL) (ELSE <1 .ELE>)>>
1295 <FUNCTION (X Y) <PUT .X 1 <CANONICAL-DECL <1 .Y>>>>
1299 <COND (.TEM <MAPRET .TEM .TT>) (ELSE .TT)>)>)
1301 <SET ELE <CANONICAL-DECL .ELE>>
1302 <COND (<AND .SAME <=? .SAME .ELE>>
1303 <SET SAMCNT <+ .SAMCNT 1>>
1304 <COND (.LAST <GR-RET .ELE .SAMCNT>) (ELSE <MAPRET>)>)
1306 <COND (.SAME <SET TEM <GR-RET .SAME .SAMCNT>>)
1307 (ELSE <SET TEM <>>)>
1310 <COND (.LAST <COND (.TEM <MAPRET .TEM .ELE>) (ELSE .ELE)>)
1312 (ELSE <MAPRET>)>)>)>>
1316 <DEFINE GR-RET (X N) #DECL ((N) FIX)
1317 <COND (<1? .N> .X)(ELSE [.N .X])>>