<clr>/parse-definitions.mud.1

   1
   2 <PACKAGE "PARSE-DEFINITIONS">
   3
   4 "Definitions of types and offsets appropriate for trees built by ADAPLEX
   5  parser"
   6
   7 <ENTRY PRETTY
   8        NOT-PRETTY
   9        USETYPE
  10        FOR-LOOP
  11        ITERATOR
  12        FOR-BODY
  13        ITERATION
  14        LOOP-CONTROL
  15        LOOP-IDENTIFIER
  16        LOOP-SET-EXPRESSION
  17        LOOP-PREDICATE
  18        LOOP-ORDER
  19        LOOP-ORDER-FUNCTION
  20        RETRIEVE
  21        RETRIEVE-SET
  22        RETRIEVE-WORKSPACE
  23        RETRIEVE-TARGET-LIST
  24        PRINTYPE
  25        IFTYPE
  26        CLAUSE
  27        CLAUSE-PREDICATE
  28        CLAUSE-LIST-OF-COMMANDS
  29        SETTYPE
  30        FCN
  31        FCN-NAME
  32        FCN-ARGUMENT
  33        RESTRICTION
  34        RESTRICT-ID
  35        RESTRICT-SET
  36        RESTRICT-PRED
  37        OPERATOR
  38        OP-NAME
  39        OP-OP1
  40        OP-OP2
  41        QUANTIFIER
  42        QUANT-TYPE
  43        QUANT-NUM
  44        QUANT-ID
  45        QUANT-SET
  46        QUANT-PRED
  47        QUANT-TEST
  48        EXISTS
  49        EXISTS-TYPE
  50        EXISTS-SET
  51        AGGREGATE
  52        AGG-NAME
  53        AGG-FCN
  54        AGG-SET
  55        AGG-OVER
  56        IDENTIFIER
  57        ID-NAME
  58        ID-TYPE
  59        ID-OTHER
  60        VIRTUAL
  61        ENTITY-DEF-EXTENT
  62        ENTITY-DEF-VIRTUAL?
  63        SUPERTYPE
  64        COTYPE
  65        FCN-DFN
  66        FCN-DFN-NAME
  67        FCN-DFN-FORMAT
  68        EXTENT
  69        EXTENT-NAME
  70        EXTENT-EMAP
  71        EXTENT-FMAP
  72        JOIN
  73        PROJECT
  74        PROJECT-MAPLIST
  75        PROJECT-FCNLIST
  76        FCNMAP
  77        FCNMAP-NAME
  78        FCNMAP-SETEXP
  79        ENTITY-DEF
  80        ENTITY-DEF-NAME
  81        ENTITY-DEF-FCN-LIST
  82        ENTITY-DEF-SUPERTYPES
  83        ENTITY-DEF-COTYPES>
  84
  85 "\f"
  86
  87 "Define MSETG to SETG an atom and make it manifest as well"
  88
  89 <DEFINE MSETG (ATOM VAL) <SETG .ATOM .VAL> <MANIFEST .ATOM>>
  90
  91
  92 "INDENTATION and INDENT-AMT are used in pretty printing of ADAPLEX"
  93
  94 <SET INDENTATION 0>
  95
  96 <MSETG INDENT-AMT 8>
  97
  98 "Define type for USE statement"
  99
 100 <NEWTYPE USETYPE LIST>
 101
 102 <DEFINE P-USETYPE (L) <IPRINC "USE ">
 103         <PRINT-LIST .L>
 104         <PRINC !\;>>
 105
 106 <NEWTYPE FOR-LOOP VECTOR '<<PRIMTYPE VECTOR> ITERATION LIST>>
 107
 108 "FOR loops have iteration spec and a list of commands"
 109
 110 <MSETG ITERATOR <OFFSET 1 FOR-LOOP>>
 111
 112 <MSETG FOR-BODY <OFFSET 2 FOR-LOOP>>
 113
 114 "Function to print for loops nicely"
 115
 116 <DEFINE PRINT-FOR (FL)
 117         #DECL ((FL) FOR-LOOP)
 118         <IPRINT <ITERATOR .FL>>
 119         <CRLF>
 120         <SET INDENTATION <+ .INDENTATION ,INDENT-AMT>>
 121         <PRINT-SEQ <FOR-BODY .FL>>
 122         <IPRINC "END;">
 123         <SET INDENTATION <- .INDENTATION ,INDENT-AMT>>>
 124
 125 "\f"
 126 "Type ITERATION specifies the range of a for loop."
 127
 128 <NEWTYPE ITERATION
 129          VECTOR
 130          '<<PRIMTYPE VECTOR> <OR FALSE FIX>
 131                              IDENTIFIER
 132                              ANY
 133                              ANY
 134                              ATOM
 135                              <OR IDENTIFIER FALSE>>>
 136
 137 <MSETG LOOP-CONTROL <OFFSET 1 ITERATION>>
 138
 139 <MSETG LOOP-IDENTIFIER <OFFSET 2 ITERATION>>
 140
 141 <MSETG LOOP-SET-EXPRESSION <OFFSET 3 ITERATION>>
 142
 143 <MSETG LOOP-PREDICATE <OFFSET 4 ITERATION>>
 144
 145 <MSETG LOOP-ORDER <OFFSET 5 ITERATION>>
 146
 147 <MSETG LOOP-ORDER-FUNCTION <OFFSET 6 ITERATION>>
 148
 149
 150
 151 <DEFINE ITERATOR-PRINT (ITER)
 152         #DECL ((ITER) ITERATION)
 153         <IPRINC "FOR ">
 154         <COND (<LOOP-CONTROL .ITER>
 155                <PRINC "UP TO ">
 156                <PRIN1 <LOOP-CONTROL .ITER>>)
 157               (ELSE <PRINC "EACH">)>
 158         <PRINC " ">
 159         <PRIN1 <LOOP-IDENTIFIER .ITER>>
 160         <PRINC " IN ">
 161         <PRIN1 <LOOP-SET-EXPRESSION .ITER>>
 162         <COND (<LOOP-PREDICATE .ITER>
 163                <PRINC " WHERE ">
 164                <PRIN1 <LOOP-PREDICATE .ITER>>)>
 165         <COND (<N==? <LOOP-ORDER .ITER> RANDOM>
 166                <PRINC " IN ">
 167                <PRIN1 <LOOP-ORDER .ITER>>
 168                <PRINC " BY ">
 169                <PRIN1 <LOOP-ORDER-FUNCTION .ITER>>)>>
 170
 171 "Type RETRIEVE is produced by a Retrieve statement in the language"
 172
 173 <NEWTYPE RETRIEVE VECTOR '<<PRIMTYPE VECTOR> ANY IDENTIFIER LIST>>
 174
 175 <MSETG RETRIEVE-SET <OFFSET 1 RETRIEVE>>
 176
 177 <MSETG RETRIEVE-WORKSPACE <OFFSET 2 RETRIEVE>>
 178
 179 <MSETG RETRIEVE-TARGET-LIST <OFFSET 3 RETRIEVE>>
 180
 181 <DEFINE PRINT-RETRIEVE (RETRV) #DECL ((RETRV) RETRIEVE)
 182         <IPRINC "RETRIEVE ">
 183         <PRIN1 <RETRIEVE-SET .RETRV>>
 184         <PRINC " INTO ">
 185         <PRIN1 <RETRIEVE-WORKSPACE .RETRV>>
 186         <PRINC " ">
 187         <PRINT-LIST <RETRIEVE-TARGET-LIST .RETRV>>
 188         <PRINC ";">>
 189
 190 "\f"
 191 "Type PRINTYPE is produced for a PRINT command"
 192
 193 <NEWTYPE PRINTYPE LIST>
 194
 195 <DEFINE PRINT-PRINT (L)
 196         <IPRINC "PRINT ">
 197         <PRINT-LIST .L>>
 198
 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."
 201
 202 <NEWTYPE IFTYPE LIST>
 203
 204 <DEFINE IFTYPE-PRINT (L "AUX" (FIRST T))
 205         #DECL ((L) IFTYPE)
 206         <MAPF <>
 207               <FUNCTION (C)
 208                       #DECL ((C) CLAUSE)
 209                       <COND (<==? <CLAUSE-PREDICATE .C> ELSE> <IPRINC "ELSE ">)
 210                             (ELSE
 211                              <COND (.FIRST <IPRINC "IF ">)
 212                                    (ELSE <IPRINC "ELSEIF ">)>
 213                              <PRIN1 <CLAUSE-PREDICATE .C>>
 214                              <PRINC " THEN ">)>
 215                       <CRLF>
 216                       <SET INDENTATION <+ .INDENTATION ,INDENT-AMT>>
 217                       <PRINT-SEQ <CLAUSE-LIST-OF-COMMANDS .C>>
 218                       <SET INDENTATION <- .INDENTATION ,INDENT-AMT>>
 219                       <SET FIRST <>>>
 220               .L>
 221         <IPRINC "END IF">>
 222
 223 <NEWTYPE CLAUSE VECTOR '<<PRIMTYPE VECTOR> ANY LIST>>
 224
 225 <MSETG CLAUSE-PREDICATE <OFFSET 1 CLAUSE>>
 226
 227 <MSETG CLAUSE-LIST-OF-COMMANDS <OFFSET 2 CLAUSE>>
 228
 229 "\f"
 230
 231 "Explicit sets become lists of the explicit objects in the set"
 232
 233 <NEWTYPE SETTYPE LIST>
 234
 235 <DEFINE SET-PRINT (L) <PRINT-LIST .L>>
 236
 237 "Type FCN is for entity function calls"
 238
 239 <NEWTYPE FCN VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY>>
 240
 241 <MSETG FCN-NAME <OFFSET 1 FCN>>
 242
 243 <MSETG FCN-ARGUMENT <OFFSET 2 FCN>>
 244
 245 <DEFINE FCN-PRINT (FC) #DECL ((FC) FCN)
 246         <PRIN1 <FCN-NAME .FC>>
 247         <PRINC " (">
 248         <PRIN1 <FCN-ARGUMENT .FC>>
 249         <PRINC ")">>
 250
 251 "Type RESTRICTION is for restricted sets.  It has a variable, an input set and
 252  a predicate"
 253
 254 <NEWTYPE RESTRICTION VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY ANY>>
 255
 256 <MSETG RESTRICT-ID <OFFSET 1 RESTRICTION>>
 257
 258 <MSETG RESTRICT-SET <OFFSET 2 RESTRICTION>>
 259
 260 <MSETG RESTRICT-PRED <OFFSET 3 RESTRICTION>>
 261
 262 <DEFINE RESTRICT-PRINT (RES) #DECL ((RES) RESTRICTION)
 263         <PRINC "(">
 264         <PRIN1 <RESTRICT-ID .RES>>
 265         <PRINC " IN ">
 266         <PRIN1 <RESTRICT-SET .RES>>
 267         <PRINC " WHERE ">
 268         <PRIN1 <RESTRICT-PRED .RES>>
 269         <PRINC ")">>
 270 "\f"
 271 "Type OPERATOR is for +,- etc."
 272
 273 <NEWTYPE OPERATOR VECTOR '<<PRIMTYPE VECTOR> ATOM ANY ANY>>
 274
 275 <MSETG OP-NAME <OFFSET 1 OPERATOR>>
 276
 277 <MSETG OP-OP1 <OFFSET 2 OPERATOR>>
 278
 279 <MSETG OP-OP2 <OFFSET 3 OPERATOR>>
 280
 281 <DEFINE OP-PRINT (OP) #DECL ((OP) OPERATOR)
 282         <COND (<OP-OP2 .OP>     ;"Binary operator"
 283                <COND (<TYPE? <OP-OP1 .OP> OPERATOR>
 284                       <PRINC "(">)>
 285                <PRIN1 <OP-OP1 .OP>>
 286                <COND (<TYPE? <OP-OP1 .OP> OPERATOR>
 287                       <PRINC ")">)>
 288                <COND (<L=? <LENGTH <SPNAME <OP-NAME .OP>>> 2>
 289                       <PRINC <OP-NAME .OP>>)
 290                      (ELSE
 291                       <PRINC " ">
 292                       <PRINC <OP-NAME .OP>>
 293                       <PRINC " ">)>
 294                <COND (<TYPE? <OP-OP2 .OP> OPERATOR>
 295                       <PRINC "(">)>
 296                <PRIN1 <OP-OP2 .OP>>
 297                <COND (<TYPE? <OP-OP2 .OP> OPERATOR>
 298                       <PRINC ")">)>)
 299               (ELSE
 300                <COND (<L=? <LENGTH <SPNAME <OP-NAME .OP>>> 2>
 301                       <PRINC <OP-NAME .OP>>)
 302                      (ELSE
 303                       <PRINC <OP-NAME .OP>>
 304                       <PRINC " ">)>
 305                <PRIN1 <OP-OP1 .OP>>)>>
 306
 307 "\f"
 308 "Type QUANTIFIER is for DAPLEX quantifiers FOR SOME etc."
 309
 310 <NEWTYPE QUANTIFIER
 311          VECTOR
 312          '<<PRIMTYPE VECTOR> ATOM FIX IDENTIFIER ANY ANY ANY>>
 313
 314 <MSETG QUANT-TYPE <OFFSET 1 QUANTIFIER>>
 315
 316 <MSETG QUANT-NUM <OFFSET 2 QUANTIFIER>>
 317
 318 <MSETG QUANT-ID <OFFSET 3 QUANTIFIER>>
 319
 320 <MSETG QUANT-SET <OFFSET 4 QUANTIFIER>>
 321
 322 <MSETG QUANT-PRED <OFFSET 5 QUANTIFIER>>
 323
 324 <MSETG QUANT-TEST <OFFSET 6 QUANTIFIER>>
 325
 326 <DEFINE QUANT-PRINT (Q)
 327         #DECL ((Q) QUANTIFIER)
 328         <PRINC "FOR ">
 329         <COND (<0? <QUANT-NUM .Q>> <PRIN1 <QUANT-TYPE .Q>>)
 330               (ELSE
 331                <PRINC <COND (<==? <QUANT-TYPE .Q> AT-LEAST> "AT LEAST ")
 332                             (ELSE "AT MOST ")>>
 333                <PRIN1 <QUANT-NUM .Q>>)>
 334         <PRINC " ">
 335         <PRIN1 <QUANT-ID .Q>>
 336         <PRINC " IN ">
 337         <PRIN1 <QUANT-SET .Q>>
 338         <COND (<QUANT-PRED .Q> <PRINC " WHERE "> <PRIN1 <QUANT-PRED .Q>>)>
 339         <PRINC " TEST ">
 340         <PRIN1 <QUANT-TEST .Q>>>
 341
 342 <NEWTYPE EXISTS VECTOR '<<PRIMTYPE VECTOR> ATOM FIX ANY>>
 343
 344 <MSETG EXISTS-TYPE <OFFSET 1 EXISTS>>
 345
 346 <MSETG EXISTS-NUM <OFFSET 2 EXISTS>>
 347
 348 <MSETG EXISTS-SET <OFFSET 3 EXISTS>>
 349
 350 <NEWTYPE AGGREGATE
 351          VECTOR
 352          '<<PRIMTYPE VECTOR> ATOM <OR IDENTIFIER FALSE> ANY <OR FALSE ATOM>>>
 353
 354 <MSETG AGG-NAME <OFFSET 1 AGGREGATE>>
 355
 356 <MSETG AGG-FCN <OFFSET 2 AGGREGATE>>
 357
 358 <MSETG AGG-SET <OFFSET 3 AGGREGATE>>
 359
 360 <MSETG AGG-OVER <OFFSET 4 AGGREGATE>>
 361
 362 <NEWTYPE IDENTIFIER VECTOR '<<PRIMTYPE VECTOR> ATOM ANY ANY>>
 363
 364 <MSETG ID-NAME <OFFSET 1 IDENTIFIER>>
 365
 366 <MSETG ID-TYPE <OFFSET 1 IDENTIFIER>>
 367
 368 <MSETG ID-OTHER <OFFSET 1 IDENTIFIER>>
 369
 370 <DEFINE PRINT-ID (ID) #DECL ((ID) IDENTIFIER) <PRIN1 <ID-NAME .ID>>>
 371
 372 <NEWTYPE SUPERTYPE LIST>
 373
 374 <NEWTYPE COTYPE LIST>
 375
 376 <NEWTYPE FCN-DFN VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY>>
 377
 378 <MSETG FCN-DFN-NAME <OFFSET 1 FCN-DFN>>
 379
 380 <MSETG FCN-DFN-FORMAT <OFFSET 2 FCN-DFN>>
 381
 382 <NEWTYPE EXTENT
 383          VECTOR
 384          '<<PRIMTYPE VECTOR> IDENTIFIER
 385                              <OR JOIN RESTRICTION PROJECT>
 386                              <LIST [REST FCNMAP]>>>
 387
 388 <MSETG EXTENT-NAME <OFFSET 1 EXTENT>>
 389
 390 <MSETG EXTENT-EMAP <OFFSET 2 EXTENT>>
 391
 392 <MSETG EXTENT-FMAP <OFFSET 3 EXTENT>>
 393
 394 <NEWTYPE JOIN LIST>
 395
 396 <NEWTYPE PROJECT VECTOR '<<PRIMTYPE VECTOR> LIST LIST>>
 397
 398 <MSETG PROJECT-MAPLIST <OFFSET 1 PROJECT>>
 399
 400 <MSETG PROJECT-FCNLIST <OFFSET 2 PROJECT>>
 401
 402 <NEWTYPE FCNMAP VECTOR '<<PRIMTYPE VECTOR> IDENTIFIER ANY>>
 403
 404 <MSETG FCNMAP-NAME <OFFSET 1 FCNMAP>>
 405
 406 <MSETG FCNMAP-SETEXP <OFFSET 2 FCNMAP>>
 407
 408 <NEWTYPE ENTITY-DEF
 409          VECTOR
 410          '<<PRIMTYPE VECTOR> IDENTIFIER
 411                              LIST
 412                              <OR FALSE <LIST ANY>>
 413                              <OR FALSE <LIST ANY>>
 414                              <OR FALSE ATOM>
 415                              <OR EXTENT FALSE>>>
 416
 417 <MSETG ENTITY-DEF-NAME <OFFSET 1 ENTITY-DEF>>
 418
 419 <MSETG ENTITY-DEF-FCN-LIST <OFFSET 2 ENTITY-DEF>>
 420
 421 <MSETG ENTITY-DEF-SUPERTYPES <OFFSET 3 ENTITY-DEF>>
 422
 423 <MSETG ENTITY-DEF-COTYPES <OFFSET 4 ENTITY-DEF>>
 424
 425 <MSETG ENTITY-DEF-VIRTUAL? <OFFSET 5 ENTITY-DEF>>
 426
 427 <MSETG ENTITY-DEF-EXTENT <OFFSET 6 ENTITY-DEF>>
 428
 429
 430 "Utility print stuff"
 431
 432 <DEFINE PRINT-LIST (L) #DECL ((L) <PRIMTYPE LIST>)
 433         <PRINC "(">
 434         <MAPR <>
 435               <FUNCTION (LL "AUX" (X <1 .LL>))
 436                 <PRIN1 .X>
 437                 <COND (<EMPTY? <REST .LL>> <PRINC ")">)
 438                       (ELSE <PRINC ", ">)>>
 439               .L>>
 440
 441 <DEFINE PRINT-SEQ (L) #DECL ((L) <PRIMTYPE LIST>)
 442         <MAPF <>
 443               <FUNCTION (X)
 444                 <IPRINT .X>
 445                 <PRINC ";">
 446                 <CRLF>> .L>>
 447
 448 <DEFINE IPRINT (OBJ)
 449         <INDENT-TO .INDENTATION>
 450         <PRIN1 .OBJ>>
 451
 452 <DEFINE IPRINC (OBJ)
 453         <INDENT-TO .INDENTATION>
 454         <PRINC .OBJ>>
 455
 456
 457
 458 <DEFINE PRETTY ()
 459         <MAPF <> <FUNCTION (TYPE FCN) <PRINTTYPE .TYPE .FCN>> ,TYPES ,PSUBRS>>
 460
 461 <DEFINE NOT-PRETTY ()
 462         <MAPF <> <FUNCTION (TYPE) <PRINTTYPE .TYPE ,PRINT>> ,TYPES>>
 463
 464 <SETG TYPES
 465       '![USETYPE
 466          FOR-LOOP
 467          ITERATION
 468          RETRIEVE
 469          PRINTYPE
 470          IFTYPE
 471          SETTYPE
 472          FCN
 473          RESTRICTION
 474          OPERATOR
 475          QUANTIFIER
 476          IDENTIFIER!]>
 477
 478 <SETG PSUBRS
 479       [,P-USETYPE
 480        ,PRINT-FOR
 481        ,ITERATOR-PRINT
 482        ,PRINT-RETRIEVE
 483        ,PRINT-PRINT
 484        ,IFTYPE-PRINT
 485        ,SET-PRINT
 486        ,FCN-PRINT
 487        ,RESTRICT-PRINT
 488        ,OP-PRINT
 489        ,QUANT-PRINT
 490        ,PRINT-ID]>
 491
 492 <ENDPACKAGE>
 493 \0