2 <PACKAGE "PARSE-DEFINITIONS">
4 "Definitions of types and offsets appropriate for trees built by ADAPLEX
28 CLAUSE-LIST-OF-COMMANDS
87 "Define MSETG to SETG an atom and make it manifest as well"
89 <DEFINE MSETG (ATOM VAL) <SETG .ATOM .VAL> <MANIFEST .ATOM>>
92 "INDENTATION and INDENT-AMT are used in pretty printing of ADAPLEX"
98 "Define type for USE statement"
100 <NEWTYPE USETYPE LIST>
102 <DEFINE P-USETYPE (L) <IPRINC "USE ">
106 <NEWTYPE FOR-LOOP VECTOR '<<PRIMTYPE VECTOR> ITERATION LIST>>
108 "FOR loops have iteration spec and a list of commands"
110 <MSETG ITERATOR <OFFSET 1 FOR-LOOP>>
112 <MSETG FOR-BODY <OFFSET 2 FOR-LOOP>>
114 "Function to print for loops nicely"
116 <DEFINE PRINT-FOR (FL)
117 #DECL ((FL) FOR-LOOP)
118 <IPRINT <ITERATOR .FL>>
120 <SET INDENTATION <+ .INDENTATION ,INDENT-AMT>>
121 <PRINT-SEQ <FOR-BODY .FL>>
123 <SET INDENTATION <- .INDENTATION ,INDENT-AMT>>>
126 "Type ITERATION specifies the range of a for loop."
130 '<<PRIMTYPE VECTOR> <OR FALSE FIX>
135 <OR IDENTIFIER FALSE>>>
137 <MSETG LOOP-CONTROL <OFFSET 1 ITERATION>>
139 <MSETG LOOP-IDENTIFIER <OFFSET 2 ITERATION>>
141 <MSETG LOOP-SET-EXPRESSION <OFFSET 3 ITERATION>>
143 <MSETG LOOP-PREDICATE <OFFSET 4 ITERATION>>
145 <MSETG LOOP-ORDER <OFFSET 5 ITERATION>>
147 <MSETG LOOP-ORDER-FUNCTION <OFFSET 6 ITERATION>>
151 <DEFINE ITERATOR-PRINT (ITER)
152 #DECL ((ITER) ITERATION)
154 <COND (<LOOP-CONTROL .ITER>
156 <PRIN1 <LOOP-CONTROL .ITER>>)
157 (ELSE <PRINC "EACH">)>
159 <PRIN1 <LOOP-IDENTIFIER .ITER>>
161 <PRIN1 <LOOP-SET-EXPRESSION .ITER>>
162 <COND (<LOOP-PREDICATE .ITER>
164 <PRIN1 <LOOP-PREDICATE .ITER>>)>
165 <COND (<N==? <LOOP-ORDER .ITER> RANDOM>
167 <PRIN1 <LOOP-ORDER .ITER>>
169 <PRIN1 <LOOP-ORDER-FUNCTION .ITER>>)>>
171 "Type RETRIEVE is produced by a Retrieve statement in the language"
173 <NEWTYPE RETRIEVE VECTOR '<<PRIMTYPE VECTOR> ANY IDENTIFIER LIST>>
175 <MSETG RETRIEVE-SET <OFFSET 1 RETRIEVE>>
177 <MSETG RETRIEVE-WORKSPACE <OFFSET 2 RETRIEVE>>
179 <MSETG RETRIEVE-TARGET-LIST <OFFSET 3 RETRIEVE>>
181 <DEFINE PRINT-RETRIEVE (RETRV) #DECL ((RETRV) RETRIEVE)
183 <PRIN1 <RETRIEVE-SET .RETRV>>
185 <PRIN1 <RETRIEVE-WORKSPACE .RETRV>>
187 <PRINT-LIST <RETRIEVE-TARGET-LIST .RETRV>>
191 "Type PRINTYPE is produced for a PRINT command"
193 <NEWTYPE PRINTYPE LIST>
195 <DEFINE PRINT-PRINT (L)
199 "Various kinds of IFs become IFTYPE. IFTYPE is a list of CLAUSEs. Each
200 clause has a predicate and a list of things to do on truth."
202 <NEWTYPE IFTYPE LIST>
204 <DEFINE IFTYPE-PRINT (L "AUX" (FIRST T))
209 <COND (<==? <CLAUSE-PREDICATE .C> ELSE> <IPRINC "ELSE ">)
211 <COND (.FIRST <IPRINC "IF ">)
212 (ELSE <IPRINC "ELSEIF ">)>
213 <PRIN1 <CLAUSE-PREDICATE .C>>
216 <SET INDENTATION <+ .INDENTATION ,INDENT-AMT>>
217 <PRINT-SEQ <CLAUSE-LIST-OF-COMMANDS .C>>
218 <SET INDENTATION <- .INDENTATION ,INDENT-AMT>>
223 <NEWTYPE CLAUSE VECTOR '<<PRIMTYPE VECTOR> ANY LIST>>
225 <MSETG CLAUSE-PREDICATE <OFFSET 1 CLAUSE>>
227 <MSETG CLAUSE-LIST-OF-COMMANDS <OFFSET 2 CLAUSE>>
231 "Explicit sets become lists of the explicit objects in the set"
233 <NEWTYPE SETTYPE LIST>
235 <DEFINE SET-PRINT (L) <PRINT-LIST .L>>
237 "Type FCN is for entity function calls"
239 <NEWTYPE FCN VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY>>
241 <MSETG FCN-NAME <OFFSET 1 FCN>>
243 <MSETG FCN-ARGUMENT <OFFSET 2 FCN>>
245 <DEFINE FCN-PRINT (FC) #DECL ((FC) FCN)
246 <PRIN1 <FCN-NAME .FC>>
248 <PRIN1 <FCN-ARGUMENT .FC>>
251 "Type RESTRICTION is for restricted sets. It has a variable, an input set and
254 <NEWTYPE RESTRICTION VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY ANY>>
256 <MSETG RESTRICT-ID <OFFSET 1 RESTRICTION>>
258 <MSETG RESTRICT-SET <OFFSET 2 RESTRICTION>>
260 <MSETG RESTRICT-PRED <OFFSET 3 RESTRICTION>>
262 <DEFINE RESTRICT-PRINT (RES) #DECL ((RES) RESTRICTION)
264 <PRIN1 <RESTRICT-ID .RES>>
266 <PRIN1 <RESTRICT-SET .RES>>
268 <PRIN1 <RESTRICT-PRED .RES>>
271 "Type OPERATOR is for +,- etc."
273 <NEWTYPE OPERATOR VECTOR '<<PRIMTYPE VECTOR> ATOM ANY ANY>>
275 <MSETG OP-NAME <OFFSET 1 OPERATOR>>
277 <MSETG OP-OP1 <OFFSET 2 OPERATOR>>
279 <MSETG OP-OP2 <OFFSET 3 OPERATOR>>
281 <DEFINE OP-PRINT (OP) #DECL ((OP) OPERATOR)
282 <COND (<OP-OP2 .OP> ;"Binary operator"
283 <COND (<TYPE? <OP-OP1 .OP> OPERATOR>
286 <COND (<TYPE? <OP-OP1 .OP> OPERATOR>
288 <COND (<L=? <LENGTH <SPNAME <OP-NAME .OP>>> 2>
289 <PRINC <OP-NAME .OP>>)
292 <PRINC <OP-NAME .OP>>
294 <COND (<TYPE? <OP-OP2 .OP> OPERATOR>
297 <COND (<TYPE? <OP-OP2 .OP> OPERATOR>
300 <COND (<L=? <LENGTH <SPNAME <OP-NAME .OP>>> 2>
301 <PRINC <OP-NAME .OP>>)
303 <PRINC <OP-NAME .OP>>
305 <PRIN1 <OP-OP1 .OP>>)>>
308 "Type QUANTIFIER is for DAPLEX quantifiers FOR SOME etc."
312 '<<PRIMTYPE VECTOR> ATOM FIX IDENTIFIER ANY ANY ANY>>
314 <MSETG QUANT-TYPE <OFFSET 1 QUANTIFIER>>
316 <MSETG QUANT-NUM <OFFSET 2 QUANTIFIER>>
318 <MSETG QUANT-ID <OFFSET 3 QUANTIFIER>>
320 <MSETG QUANT-SET <OFFSET 4 QUANTIFIER>>
322 <MSETG QUANT-PRED <OFFSET 5 QUANTIFIER>>
324 <MSETG QUANT-TEST <OFFSET 6 QUANTIFIER>>
326 <DEFINE QUANT-PRINT (Q)
327 #DECL ((Q) QUANTIFIER)
329 <COND (<0? <QUANT-NUM .Q>> <PRIN1 <QUANT-TYPE .Q>>)
331 <PRINC <COND (<==? <QUANT-TYPE .Q> AT-LEAST> "AT LEAST ")
333 <PRIN1 <QUANT-NUM .Q>>)>
335 <PRIN1 <QUANT-ID .Q>>
337 <PRIN1 <QUANT-SET .Q>>
338 <COND (<QUANT-PRED .Q> <PRINC " WHERE "> <PRIN1 <QUANT-PRED .Q>>)>
340 <PRIN1 <QUANT-TEST .Q>>>
342 <NEWTYPE EXISTS VECTOR '<<PRIMTYPE VECTOR> ATOM FIX ANY>>
344 <MSETG EXISTS-TYPE <OFFSET 1 EXISTS>>
346 <MSETG EXISTS-NUM <OFFSET 2 EXISTS>>
348 <MSETG EXISTS-SET <OFFSET 3 EXISTS>>
352 '<<PRIMTYPE VECTOR> ATOM <OR IDENTIFIER FALSE> ANY <OR FALSE ATOM>>>
354 <MSETG AGG-NAME <OFFSET 1 AGGREGATE>>
356 <MSETG AGG-FCN <OFFSET 2 AGGREGATE>>
358 <MSETG AGG-SET <OFFSET 3 AGGREGATE>>
360 <MSETG AGG-OVER <OFFSET 4 AGGREGATE>>
362 <NEWTYPE IDENTIFIER VECTOR '<<PRIMTYPE VECTOR> ATOM ANY ANY>>
364 <MSETG ID-NAME <OFFSET 1 IDENTIFIER>>
366 <MSETG ID-TYPE <OFFSET 1 IDENTIFIER>>
368 <MSETG ID-OTHER <OFFSET 1 IDENTIFIER>>
370 <DEFINE PRINT-ID (ID) #DECL ((ID) IDENTIFIER) <PRIN1 <ID-NAME .ID>>>
372 <NEWTYPE SUPERTYPE LIST>
374 <NEWTYPE COTYPE LIST>
376 <NEWTYPE FCN-DFN VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY>>
378 <MSETG FCN-DFN-NAME <OFFSET 1 FCN-DFN>>
380 <MSETG FCN-DFN-FORMAT <OFFSET 2 FCN-DFN>>
384 '<<PRIMTYPE VECTOR> IDENTIFIER
385 <OR JOIN RESTRICTION PROJECT>
386 <LIST [REST FCNMAP]>>>
388 <MSETG EXTENT-NAME <OFFSET 1 EXTENT>>
390 <MSETG EXTENT-EMAP <OFFSET 2 EXTENT>>
392 <MSETG EXTENT-FMAP <OFFSET 3 EXTENT>>
396 <NEWTYPE PROJECT VECTOR '<<PRIMTYPE VECTOR> LIST LIST>>
398 <MSETG PROJECT-MAPLIST <OFFSET 1 PROJECT>>
400 <MSETG PROJECT-FCNLIST <OFFSET 2 PROJECT>>
402 <NEWTYPE FCNMAP VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY>>
404 <MSETG FCNMAP-NAME <OFFSET 1 FCNMAP>>
406 <MSETG FCNMAP-SETEXP <OFFSET 2 FCNMAP>>
410 '<<PRIMTYPE VECTOR> IDENTIFIER
412 <OR FALSE <LIST ANY>>
413 <OR FALSE <LIST ANY>>
417 <MSETG ENTITY-DEF-NAME <OFFSET 1 ENTITY-DEF>>
419 <MSETG ENTITY-DEF-FCN-LIST <OFFSET 2 ENTITY-DEF>>
421 <MSETG ENTITY-DEF-SUPERTYPES <OFFSET 3 ENTITY-DEF>>
423 <MSETG ENTITY-DEF-COTYPES <OFFSET 4 ENTITY-DEF>>
425 <MSETG ENTITY-DEF-VIRTUAL? <OFFSET 5 ENTITY-DEF>>
427 <MSETG ENTITY-DEF-EXTENT <OFFSET 6 ENTITY-DEF>>
430 "Utility print stuff"
432 <DEFINE PRINT-LIST (L) #DECL ((L) <PRIMTYPE LIST>)
435 <FUNCTION (LL "AUX" (X <1 .LL>))
437 <COND (<EMPTY? <REST .LL>> <PRINC ")">)
438 (ELSE <PRINC ", ">)>>
441 <DEFINE PRINT-SEQ (L) #DECL ((L) <PRIMTYPE LIST>)
449 <INDENT-TO .INDENTATION>
453 <INDENT-TO .INDENTATION>
459 <MAPF <> <FUNCTION (TYPE FCN) <PRINTTYPE .TYPE .FCN>> ,TYPES ,PSUBRS>>
461 <DEFINE NOT-PRETTY ()
462 <MAPF <> <FUNCTION (TYPE) <PRINTTYPE .TYPE ,PRINT>> ,TYPES>>