gcc/m2/mc/mcp2.bnf

   1 --
   2 -- mc-2.bnf grammar and associated actions for mcp2.
   3 --
   4 -- Copyright (C) 2015-2022 Free Software Foundation, Inc.
   5 -- Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   6 --
   7 -- This file is part of GNU Modula-2.
   8 --
   9 -- GNU Modula-2 is free software; you can redistribute it and/or modify
  10 -- it under the terms of the GNU General Public License as published by
  11 -- the Free Software Foundation; either version 3, or (at your option)
  12 -- any later version.
  13 --
  14 -- GNU Modula-2 is distributed in the hope that it will be useful, but
  15 -- WITHOUT ANY WARRANTY; without even the implied warranty of
  16 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 -- General Public License for more details.
  18 --
  19 -- You should have received a copy of the GNU General Public License
  20 -- along with GNU Modula-2; see the file COPYING3.  If not see
  21 -- <http://www.gnu.org/licenses/>.
  22 % module mcp2 begin
  23 (* output from mc-2.bnf, automatically generated do not edit.
  24
  25 Copyright (C) 2015-2022 Free Software Foundation, Inc.
  26 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
  27
  28 This file is part of GNU Modula-2.
  29
  30 GNU Modula-2 is free software; you can redistribute it and/or modify
  31 it under the terms of the GNU General Public License as published by
  32 the Free Software Foundation; either version 3, or (at your option)
  33 any later version.
  34
  35 GNU Modula-2 is distributed in the hope that it will be useful, but
  36 WITHOUT ANY WARRANTY; without even the implied warranty of
  37 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  38 General Public License for more details.
  39
  40 You should have received a copy of the GNU General Public License
  41 along with GNU Modula-2; see the file COPYING.  If not,
  42 see <https://www.gnu.org/licenses/>.  *)
  43
  44 IMPLEMENTATION MODULE mcp2 ;
  45
  46 FROM DynamicStrings IMPORT String, InitString, KillString, Mark,
  47                            ConCat, ConCatChar ;
  48
  49 FROM mcError IMPORT errorStringAt ;
  50 FROM nameKey IMPORT NulName, Name, makekey ;
  51 FROM mcPrintf IMPORT printf0, printf1 ;
  52 FROM mcDebug IMPORT assert ;
  53 FROM mcReserved IMPORT toktype ;
  54
  55 FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken,
  56                      insertTokenAndRewind, getTokenNo ;
  57
  58 FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName,
  59                  makeType, makeVar, makeConst,
  60                  enterScope, leaveScope,
  61                  addImportedModule, getCurrentModule,
  62                  makeEnum, makeEnumField, putType, lookupSym, isDef,
  63                  lookupInScope, setEnumsComplete ;
  64
  65
  66 CONST
  67    Pass1     = FALSE ;
  68    Debugging = FALSE ;
  69
  70 VAR
  71    WasNoError: BOOLEAN ;
  72    curident  : Name ;
  73    typeDes,
  74    typeExp,
  75    curproc,
  76    curmodule : node ;
  77
  78
  79 PROCEDURE ErrorString (s: String) ;
  80 BEGIN
  81    errorStringAt (s, getTokenNo ()) ;
  82    WasNoError := FALSE
  83 END ErrorString ;
  84
  85
  86 PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
  87 BEGIN
  88    ErrorString (InitString (a))
  89 END ErrorArray ;
  90
  91
  92 (*
  93    checkEndName - if module does not have, name, then issue an error containing, desc.
  94 *)
  95
  96 PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ;
  97 VAR
  98    s: String ;
  99 BEGIN
 100    IF getSymName (module)#name
 101    THEN
 102       s := InitString ('inconsistent module name found with this ') ;
 103       s := ConCat (s, Mark (InitString (desc))) ;
 104       ErrorString (s)
 105    END
 106 END checkEndName ;
 107
 108 % declaration mcp2 begin
 109
 110
 111 (*
 112    SyntaxError - after a syntax error we skip all tokens up until we reach
 113                  a stop symbol.
 114 *)
 115
 116 PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 117 BEGIN
 118    DescribeError ;
 119    IF Debugging
 120    THEN
 121       printf0('\nskipping token *** ')
 122    END ;
 123    (*
 124       yes the ORD(currenttoken) looks ugly, but it is *much* safer than
 125       using currenttoken<sometok as a change to the ordering of the
 126       token declarations below would cause this to break. Using ORD() we are
 127       immune from such changes
 128    *)
 129    WHILE NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
 130               ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
 131               ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
 132    DO
 133       getToken
 134    END ;
 135    IF Debugging
 136    THEN
 137       printf0(' ***\n')
 138    END
 139 END SyntaxError ;
 140
 141
 142 (*
 143    SyntaxCheck -
 144 *)
 145
 146 PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 147 BEGIN
 148    (* and again (see above re: ORD)
 149     *)
 150    IF NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
 151            ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
 152            ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))
 153    THEN
 154       SyntaxError (stopset0, stopset1, stopset2)
 155    END
 156 END SyntaxCheck ;
 157
 158
 159 (*
 160    WarnMissingToken - generates a warning message about a missing token, t.
 161 *)
 162
 163 PROCEDURE WarnMissingToken (t: toktype) ;
 164 VAR
 165    s0 : SetOfStop0 ;
 166    s1 : SetOfStop1 ;
 167    s2 : SetOfStop2 ;
 168    str: String ;
 169 BEGIN
 170    s0 := SetOfStop0{} ;
 171    s1 := SetOfStop1{} ;
 172    s2 := SetOfStop2{} ;
 173    IF ORD(t)<32
 174    THEN
 175       s0 := SetOfStop0{t}
 176    ELSIF ORD(t)<64
 177    THEN
 178       s1 := SetOfStop1{t}
 179    ELSE
 180       s2 := SetOfStop2{t}
 181    END ;
 182    str := DescribeStop (s0, s1, s2) ;
 183
 184    str := ConCat (InitString ('syntax error,'), Mark (str)) ;
 185    errorStringAt (str, getTokenNo ())
 186 END WarnMissingToken ;
 187
 188
 189 (*
 190    MissingToken - generates a warning message about a missing token, t.
 191 *)
 192
 193 PROCEDURE MissingToken (t: toktype) ;
 194 BEGIN
 195    WarnMissingToken (t) ;
 196    IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok)
 197    THEN
 198       IF Debugging
 199       THEN
 200          printf0 ('inserting token\n')
 201       END ;
 202       insertToken (t)
 203    END
 204 END MissingToken ;
 205
 206
 207 (*
 208    CheckAndInsert -
 209 *)
 210
 211 PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
 212 BEGIN
 213    IF ((ORD(t)<32) AND (t IN stopset0)) OR
 214       ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
 215       ((ORD(t)>=64) AND (t IN stopset2))
 216    THEN
 217       WarnMissingToken (t) ;
 218       insertTokenAndRewind (t) ;
 219       RETURN( TRUE )
 220    ELSE
 221       RETURN( FALSE )
 222    END
 223 END CheckAndInsert ;
 224
 225
 226 (*
 227    InStopSet
 228 *)
 229
 230 PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ;
 231 BEGIN
 232    IF ((ORD(t)<32) AND (t IN stopset0)) OR
 233       ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR
 234       ((ORD(t)>=64) AND (t IN stopset2))
 235    THEN
 236       RETURN( TRUE )
 237    ELSE
 238       RETURN( FALSE )
 239    END
 240 END InStopSet ;
 241
 242
 243 (*
 244    PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken
 245                If it is not then it will insert a token providing the token
 246                is one of ; ] ) } . OF END ,
 247
 248                if the stopset contains <identtok> then we do not insert a token
 249 *)
 250
 251 PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 252 BEGIN
 253    (* and again (see above re: ORD)
 254     *)
 255    IF (NOT (((ORD(currenttoken)<32)  AND (currenttoken IN stopset0)) OR
 256             ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR
 257             ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND
 258       (NOT InStopSet(identtok, stopset0, stopset1, stopset2))
 259    THEN
 260       (* SyntaxCheck would fail since currentoken is not part of the stopset
 261          we check to see whether any of currenttoken might be a commonly omitted token *)
 262       IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR
 263          CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR
 264          CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR
 265          CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR
 266          CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR
 267          CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR
 268          CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR
 269          CheckAndInsert(commatok, stopset0, stopset1, stopset2)
 270       THEN
 271       END
 272    END
 273 END PeepToken ;
 274
 275
 276 (*
 277    Expect -
 278 *)
 279
 280 PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 281 BEGIN
 282    IF currenttoken=t
 283    THEN
 284       getToken ;
 285       IF Pass1
 286       THEN
 287          PeepToken(stopset0, stopset1, stopset2)
 288       END
 289    ELSE
 290       MissingToken(t)
 291    END ;
 292    SyntaxCheck(stopset0, stopset1, stopset2)
 293 END Expect ;
 294
 295
 296 (*
 297    CompilationUnit - returns TRUE if the input was correct enough to parse
 298                      in future passes.
 299 *)
 300
 301 PROCEDURE CompilationUnit () : BOOLEAN ;
 302 BEGIN
 303    WasNoError := TRUE ;
 304    FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
 305    RETURN( WasNoError )
 306 END CompilationUnit ;
 307
 308
 309 (*
 310    Ident - error checking varient of Ident
 311 *)
 312
 313 PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 314 BEGIN
 315    curident := makekey (currentstring) ;
 316    Expect(identtok, stopset0, stopset1, stopset2)
 317 END Ident ;
 318
 319
 320 (*
 321    string -
 322 *)
 323
 324 PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 325 BEGIN
 326 (*
 327    PushTF(makekey(currentstring), stringtok) ;
 328    BuildString
 329 *)
 330    Expect(stringtok, stopset0, stopset1, stopset2)
 331 END string ;
 332
 333
 334 (*
 335    Integer -
 336 *)
 337
 338 PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 339 BEGIN
 340 (*
 341    PushTF(makekey(currentstring), integertok) ;
 342    BuildNumber
 343 *)
 344    Expect(integertok, stopset0, stopset1, stopset2)
 345 END Integer ;
 346
 347
 348 (*
 349    Real -
 350 *)
 351
 352 PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ;
 353 BEGIN
 354 (*
 355    PushTF(makekey(currentstring), realtok) ;
 356    BuildNumber
 357 *)
 358    Expect(realtok, stopset0, stopset1, stopset2)
 359 END Real ;
 360
 361
 362 (*
 363    registerImport - looks up module, ident, and adds it to the
 364                     current module import list.
 365 *)
 366
 367 PROCEDURE registerImport (ident: Name; scoped: BOOLEAN) ;
 368 VAR
 369    n: node ;
 370 BEGIN
 371    n := lookupDef (ident) ;
 372    addImportedModule (getCurrentModule (), n, scoped)
 373 END registerImport ;
 374
 375
 376 % module mcp2 end
 377 END mcp2.
 378 % rules
 379 error       'ErrorArray' 'ErrorString'
 380 tokenfunc   'currenttoken'
 381
 382 token   ''                eoftok      -- internal token
 383 token   '+'               plustok
 384 token   '-'               minustok
 385 token   '*'               timestok
 386 token   '/'               dividetok
 387 token   ':='              becomestok
 388 token   '&'               ambersandtok
 389 token   "."               periodtok
 390 token   ","               commatok
 391 token   ";"               semicolontok
 392 token   '('               lparatok
 393 token   ')'               rparatok
 394 token   '['               lsbratok   -- left  square brackets
 395 token   ']'               rsbratok   -- right square brackets
 396 token   '{'               lcbratok   -- left  curly brackets
 397 token   '}'               rcbratok   -- right curly brackets
 398 token   '^'               uparrowtok
 399 token   "'"               singlequotetok
 400 token   '='               equaltok
 401 token   '#'               hashtok
 402 token   '<'               lesstok
 403 token   '>'               greatertok
 404 token   '<>'              lessgreatertok
 405 token   '<='              lessequaltok
 406 token   '>='              greaterequaltok
 407 token   '<*'              ldirectivetok
 408 token   '*>'              rdirectivetok
 409 token   '..'              periodperiodtok
 410 token   ':'               colontok
 411 token   '"'               doublequotestok
 412 token   '|'               bartok
 413 token   'AND'             andtok
 414 token   'ARRAY'           arraytok
 415 token   'BEGIN'           begintok
 416 token   'BY'              bytok
 417 token   'CASE'            casetok
 418 token   'CONST'           consttok
 419 token   'DEFINITION'      definitiontok
 420 token   'DIV'             divtok
 421 token   'DO'              dotok
 422 token   'ELSE'            elsetok
 423 token   'ELSIF'           elsiftok
 424 token   'END'             endtok
 425 token   'EXCEPT'          excepttok
 426 token   'EXIT'            exittok
 427 token   'EXPORT'          exporttok
 428 token   'FINALLY'         finallytok
 429 token   'FOR'             fortok
 430 token   'FROM'            fromtok
 431 token   'IF'              iftok
 432 token   'IMPLEMENTATION'  implementationtok
 433 token   'IMPORT'          importtok
 434 token   'IN'              intok
 435 token   'LOOP'            looptok
 436 token   'MOD'             modtok
 437 token   'MODULE'          moduletok
 438 token   'NOT'             nottok
 439 token   'OF'              oftok
 440 token   'OR'              ortok
 441 token   'PACKEDSET'       packedsettok
 442 token   'POINTER'         pointertok
 443 token   'PROCEDURE'       proceduretok
 444 token   'QUALIFIED'       qualifiedtok
 445 token   'UNQUALIFIED'     unqualifiedtok
 446 token   'RECORD'          recordtok
 447 token   'REM'             remtok
 448 token   'REPEAT'          repeattok
 449 token   'RETRY'           retrytok
 450 token   'RETURN'          returntok
 451 token   'SET'             settok
 452 token   'THEN'            thentok
 453 token   'TO'              totok
 454 token   'TYPE'            typetok
 455 token   'UNTIL'           untiltok
 456 token   'VAR'             vartok
 457 token   'WHILE'           whiletok
 458 token   'WITH'            withtok
 459 token   'ASM'             asmtok
 460 token   'VOLATILE'        volatiletok
 461 token   '...'             periodperiodperiodtok
 462 token   '__DATE__'        datetok
 463 token   '__LINE__'        linetok
 464 token   '__FILE__'        filetok
 465 token   '__ATTRIBUTE__'   attributetok
 466 token   '__BUILTIN__'     builtintok
 467 token   '__INLINE__'      inlinetok
 468 token   'integer number'  integertok
 469 token   'identifier'      identtok
 470 token   'real number'     realtok
 471 token   'string'          stringtok
 472
 473 special Ident             first { < identtok > } follow { }
 474 special Integer           first { < integertok > } follow { }
 475 special Real              first { < realtok > } follow { }
 476 special string            first { < stringtok > } follow { }
 477
 478 BNF
 479
 480 -- the following are provided by the module m2flex and also handbuild procedures below
 481 -- Ident := Letter { ( Letter | Digit ) } =:
 482 -- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) |
 483 --           Digit { HexDigit } " H " =:
 484 -- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =:
 485 -- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =:
 486 -- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =:
 487 -- Digit := OctalDigit | " 8 " | " 9 " =:
 488 -- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =:
 489 -- String
 490
 491 FileUnit := DefinitionModule | ImplementationOrProgramModule
 492           =:
 493
 494 ProgramModule := "MODULE"
 495                   Ident                                                % curmodule := lookupModule (curident) %
 496                                                                        % enterScope (curmodule) %
 497                   [ Priority
 498                   ]
 499                   ";"
 500                   { Import }
 501                   Block
 502                   Ident                                                % checkEndName (curmodule, curident, 'program module') %
 503                                                                        % leaveScope %
 504                                                                        % setEnumsComplete (curmodule) %
 505                   "."
 506                   =:
 507
 508 ImplementationModule := "IMPLEMENTATION" "MODULE"
 509                          Ident                                         % curmodule := lookupImp (curident) %
 510                                                                        % enterScope (lookupDef (curident)) %
 511                                                                        % enterScope (curmodule) %
 512                          [ Priority
 513                          ] ";"
 514                          { Import }
 515                          Block
 516                          Ident                                         % checkEndName (curmodule, curident, 'implementation module') %
 517                                                                        % leaveScope ; leaveScope %
 518                                                                        % setEnumsComplete (curmodule) %
 519                          "."
 520                       =:
 521
 522 ImplementationOrProgramModule := ImplementationModule | ProgramModule
 523                                =:
 524
 525 Number := Integer | Real =:
 526
 527 --
 528 --  Qualident needs some care as we must only parse module.module.ident
 529 --  and not ident.recordfield.  We leave the ident.recordfield to be parsed by
 530 --  SubDesignator.  Note that Qualident is called by SubDesignator so if
 531 --  IsAutoPushOff then we just consume tokens.
 532 --
 533
 534 Qualident :=
 535              Ident { "." Ident }
 536            =:
 537
 538 ConstantDeclaration := Ident "=" ConstExpression
 539                      =:
 540
 541 ConstExpression := SimpleConstExpr [ Relation SimpleConstExpr ] =:
 542
 543 Relation := "="
 544             | "#"
 545             | "<>"
 546             | "<"
 547             | "<="
 548             | ">"
 549             | ">="
 550             | "IN"
 551          =:
 552
 553 SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =:
 554
 555 UnaryOrConstTerm := "+"
 556                     ConstTerm
 557                     |
 558                     "-"
 559                     ConstTerm
 560                     |
 561                     ConstTerm =:
 562
 563 AddOperator :=   "+"
 564                | "-"
 565                | "OR"
 566             =:
 567
 568 ConstTerm := ConstFactor { MulOperator ConstFactor
 569                          } =:
 570
 571 MulOperator := "*"
 572                | "/"
 573                | "DIV"
 574                | "MOD"
 575                | "REM"
 576                | "AND"
 577                | "&"
 578             =:
 579
 580 ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction |
 581                "(" ConstExpression ")" | "NOT" ConstFactor
 582                | ConstAttribute =:
 583
 584 -- to help satisfy LL1
 585
 586 ConstString := string =:
 587
 588 ComponentElement := ConstExpression [ ".." ConstExpression ]
 589                   =:
 590
 591 ComponentValue := ComponentElement [ 'BY' ConstExpression ]
 592                 =:
 593
 594 ArraySetRecordValue := ComponentValue { ',' ComponentValue }
 595                      =:
 596
 597 Constructor := '{'
 598                   [ ArraySetRecordValue ]
 599                '}' =:
 600
 601 ConstSetOrQualidentOrFunction := Qualident
 602                                  [ Constructor | ConstActualParameters
 603                                                                        ]
 604                                    |
 605                                      Constructor =:
 606
 607 ConstActualParameters :=
 608                          ActualParameters
 609                        =:
 610
 611 ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "("
 612                   ConstAttributeExpression
 613                   ")" ")" =:
 614
 615 ConstAttributeExpression :=
 616                             Ident
 617                                   | "<" Qualident ',' Ident
 618                                                               ">"
 619                           =:
 620
 621 ByteAlignment := '<*' AttributeExpression '*>'
 622                =:
 623
 624 OptAlignmentExpression := [ AlignmentExpression ] =:
 625
 626 AlignmentExpression := "(" ConstExpression ")" =:
 627
 628 Alignment := [ ByteAlignment ] =:
 629
 630 TypeDeclaration := Ident                                                % typeDes := lookupSym (curident) %
 631                          "=" Type Alignment
 632                  =:
 633
 634 Type := ( DefSimpleType | ArrayType
 635           | RecordType
 636           | SetType
 637           | PointerType
 638           | ProcedureType )
 639       =:
 640
 641 SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
 642
 643 EnumIdentList :=                                                        % VAR n, f: node ; %
 644                                                                         % n := makeEnum () %
 645                     Ident                                               % f := makeEnumField (n, curident) %
 646                           { "," Ident                                   % f := makeEnumField (n, curident) %
 647                                       }
 648                   =:
 649
 650 Enumeration := "(" ( EnumIdentList )
 651                ")"
 652              =:
 653
 654 IdentList := Ident { "," Ident }
 655            =:
 656
 657 SubrangeType := "[" ConstExpression  ".." ConstExpression "]"
 658               =:
 659
 660 ArrayType := "ARRAY"
 661               SimpleType
 662               { ","
 663                 SimpleType
 664               } "OF"
 665              Type
 666            =:
 667
 668 RecordType := "RECORD" [ DefaultRecordAttributes ] FieldListSequence "END" =:
 669
 670 DefaultRecordAttributes := '<*'
 671                                 AttributeExpression
 672
 673                                                     '*>' =:
 674
 675 RecordFieldPragma := [ '<*' FieldPragmaExpression
 676                             { ',' FieldPragmaExpression } '*>' ] =:
 677
 678 FieldPragmaExpression := Ident PragmaConstExpression =:
 679
 680 PragmaConstExpression := [ '(' ConstExpression ')' ] =:
 681
 682 AttributeExpression := Ident '(' ConstExpression ')' =:
 683
 684 FieldListSequence := FieldListStatement { ";" FieldListStatement } =:
 685
 686 -- at present FieldListStatement is as follows:
 687 FieldListStatement := [ FieldList ] =:
 688 -- later replace it with FieldList to comply with PIM2
 689
 690 -- sadly the PIM rules are not LL1 as Ident and Qualident have the same first
 691 -- symbols. We rewrite FieldList to inline qualident
 692 -- was
 693 -- FieldList := IdentList ":"
 694 --                           Type |
 695 --             "CASE" [ Ident ":" ] Qualident "OF" Varient { "|" Varient }
 696 --                    [ "ELSE" FieldListSequence ] "END" =:
 697
 698 FieldList := IdentList ":"
 699                            Type RecordFieldPragma
 700              |
 701              "CASE"
 702                     CaseTag "OF"
 703                                  Varient { "|" Varient }
 704               [ "ELSE"
 705                 FieldListSequence
 706               ] "END"
 707            =:
 708
 709 TagIdent := [ Ident ] =:
 710
 711 CaseTag :=  TagIdent [":" Qualident ] =:
 712
 713 Varient := [
 714              VarientCaseLabelList ":" FieldListSequence
 715                                                         ] =:
 716
 717 VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =:
 718
 719 VarientCaseLabels := ConstExpression [ ".." ConstExpression ]
 720                    =:
 721
 722 --
 723 --  the following rules are a copy of the ConstExpression ebnf rules but without
 724 --  any actions all prefixed with Silent.
 725 --  At present they are only used by CaseLabels, if this continues to be true we
 726 --  might consider restricting the SilentConstExpression.  Eg it makes no sence to allow
 727 --  String in these circumstances!
 728 --
 729
 730 SilentConstExpression :=
 731                          SilentSimpleConstExpr
 732                          [ SilentRelation SilentSimpleConstExpr ]
 733                       =:
 734
 735 SilentRelation := "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" =:
 736
 737 SilentSimpleConstExpr := SilentUnaryOrConstTerm { SilentAddOperator SilentConstTerm } =:
 738
 739 SilentUnaryOrConstTerm := "+" SilentConstTerm | "-" SilentConstTerm | SilentConstTerm =:
 740
 741 SilentAddOperator := "+" | "-" | "OR" =:
 742
 743 SilentConstTerm := SilentConstFactor { SilentMulOperator SilentConstFactor } =:
 744
 745 SilentMulOperator := "*" | "/" | "DIV" | "MOD" | "REM" | "AND" | "&" =:
 746
 747 SilentConstFactor := Number | SilentConstString | SilentConstSetOrQualidentOrFunction |
 748                      "(" SilentConstExpression ")" | "NOT" SilentConstFactor
 749                      | SilentConstAttribute =:
 750
 751 SilentConstString := string =:
 752
 753 SilentConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" SilentConstAttributeExpression ")" ")" =:
 754
 755 SilentConstAttributeExpression := Ident | "<" Ident ',' SilentConstString ">" =:
 756
 757 SilentComponentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
 758
 759 SilentComponentValue := SilentComponentElement [ 'BY' SilentConstExpression ] =:
 760
 761 SilentArraySetRecordValue := SilentComponentValue { ',' SilentComponentValue } =:
 762
 763 SilentConstructor := '{'
 764                          [ SilentArraySetRecordValue ] '}' =:
 765
 766 SilentConstSetOrQualidentOrFunction := SilentConstructor | Qualident
 767                                        [ SilentConstructor | SilentActualParameters ] =:
 768
 769 SilentElement := SilentConstExpression [ ".." SilentConstExpression ] =:
 770
 771 SilentActualParameters := "(" [ SilentExpList ] ")" =:
 772
 773 SilentExpList := SilentConstExpression { "," SilentConstExpression } =:
 774
 775 -- end of the Silent constant rules
 776
 777 SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType =:
 778
 779 PointerType := "POINTER" "TO" Type
 780              =:
 781
 782 ProcedureType := "PROCEDURE" [ FormalTypeList ] =:
 783
 784 FormalTypeList := "(" ( ")" FormalReturn |
 785                         ProcedureParameters ")" FormalReturn ) =:
 786
 787 FormalReturn := [ ":" OptReturnType ] =:
 788
 789 OptReturnType := "[" Qualident "]" | Qualident =:
 790
 791 ProcedureParameters := ProcedureParameter
 792                        { "," ProcedureParameter } =:
 793
 794 ProcedureParameter := "..." | "VAR" FormalType | FormalType =:
 795
 796
 797 VarIdent := Ident [ "[" ConstExpression "]" ]
 798           =:
 799
 800 VarIdentList := VarIdent { "," VarIdent }
 801               =:
 802
 803 VariableDeclaration := VarIdentList ":"
 804                        Type Alignment
 805                      =:
 806
 807 DefVarIdent := Ident
 808                      [ "[" ConstExpression "]" ]
 809              =:
 810
 811 DefVarIdentList := DefVarIdent { "," DefVarIdent }
 812                  =:
 813
 814 DefVariableDeclaration :=                                               % typeDes := NIL %
 815                           DefVarIdentList ":" Type Alignment
 816                         =:
 817
 818 Designator := Qualident
 819               { SubDesignator } =:
 820
 821 SubDesignator := "."
 822                  Ident
 823                  | "[" ArrayExpList
 824                    "]"
 825                  | "^"
 826                =:
 827
 828 ArrayExpList :=
 829                 Expression
 830                 { ","
 831                    Expression
 832                 }
 833               =:
 834
 835 ExpList := Expression { "," Expression }
 836          =:
 837
 838 Expression := SimpleExpression [ Relation SimpleExpression ]
 839            =:
 840
 841 SimpleExpression := UnaryOrTerm { AddOperator Term } =:
 842
 843 UnaryOrTerm := "+" Term
 844                | "-" Term
 845                | Term
 846              =:
 847
 848 Term := Factor { MulOperator Factor
 849                } =:
 850
 851 Factor := Number | string | SetOrDesignatorOrFunction |
 852           "(" Expression ")" | "NOT" ( Factor
 853           | ConstAttribute
 854                                 ) =:
 855
 856 SetOrDesignatorOrFunction := Qualident
 857                               [ Constructor |
 858                                 SimpleDes [ ActualParameters ]
 859                               ]                                |
 860                               Constructor =:
 861
 862 -- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =:
 863 SimpleDes := { SubDesignator } =:
 864
 865 ActualParameters := "(" [ ExpList ] ")" =:
 866
 867 ExitStatement := "EXIT"
 868                =:
 869
 870 ReturnStatement := "RETURN" [ Expression ]
 871                  =:
 872
 873 Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement |
 874                WhileStatement | RepeatStatement | LoopStatement |
 875                ForStatement | WithStatement | AsmStatement |
 876                ExitStatement | ReturnStatement | RetryStatement
 877              ]
 878           =:
 879
 880 RetryStatement := "RETRY"
 881                 =:
 882
 883 AssignmentOrProcedureCall := Designator
 884                              ( ":=" Expression
 885                                 |
 886                                   ActualParameters |                     % (* epsilon *) %
 887                              )
 888                            =:
 889
 890 -- these two break LL1 as both start with a Designator
 891 -- ProcedureCall := Designator [ ActualParameters ] =:
 892 -- Assignment := Designator ":=" Expression =:
 893
 894 StatementSequence := Statement { ";" Statement }
 895                   =:
 896
 897 IfStatement := "IF"
 898                     Expression "THEN"
 899                 StatementSequence
 900               { "ELSIF"
 901
 902                         Expression "THEN"
 903                                           StatementSequence
 904               }
 905               [ "ELSE"
 906                       StatementSequence ] "END"
 907             =:
 908
 909 CaseStatement := "CASE"
 910                         Expression
 911                                    "OF" Case { "|" Case }
 912                  CaseEndStatement
 913                =:
 914
 915 CaseEndStatement := "END"
 916                     | "ELSE"
 917                            StatementSequence "END"
 918                  =:
 919
 920 Case := [ CaseLabelList ":" StatementSequence ]
 921       =:
 922
 923 CaseLabelList := CaseLabels { "," CaseLabels } =:
 924
 925 CaseLabels := ConstExpression [ ".." ConstExpression ]
 926             =:
 927
 928 WhileStatement := "WHILE" Expression "DO"
 929                       StatementSequence
 930                   "END"
 931                 =:
 932
 933 RepeatStatement := "REPEAT"
 934                        StatementSequence
 935                    "UNTIL" Expression
 936                  =:
 937
 938 ForStatement :=
 939                 "FOR" Ident ":=" Expression "TO" Expression [ "BY" ConstExpression ] "DO"
 940                     StatementSequence
 941                 "END"
 942               =:
 943
 944 LoopStatement := "LOOP"
 945                       StatementSequence
 946                  "END"
 947                =:
 948
 949 WithStatement := "WITH" Designator "DO"
 950                      StatementSequence
 951                  "END"
 952                =:
 953
 954 ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock
 955                         Ident
 956                       =:
 957
 958 ProcedureIdent := Ident                                                   % curproc := lookupSym (curident) %
 959                 =:
 960
 961 DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ]
 962                       =:
 963
 964 ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent            % enterScope (curproc) %
 965                                                          [ FormalParameters ]
 966                                                          AttributeNoReturn )
 967                   =:
 968
 969 Builtin := [ "__BUILTIN__" | "__INLINE__" ] =:
 970
 971 DefProcedureHeading := "PROCEDURE" Builtin ( ProcedureIdent
 972                                              [ DefFormalParameters ]
 973                                              AttributeNoReturn )
 974                      =:
 975
 976 -- introduced procedure block so we can produce more informative
 977 -- error messages
 978
 979 ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END"             % leaveScope %
 980                 =:
 981
 982 Block := { Declaration } InitialBlock FinalBlock "END"
 983        =:
 984
 985 InitialBlock := [ "BEGIN" InitialBlockBody ] =:
 986
 987 FinalBlock := [ "FINALLY" FinalBlockBody ] =:
 988
 989 InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
 990
 991 FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
 992
 993 ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =:
 994
 995 NormalPart := StatementSequence =:
 996
 997 ExceptionalPart := StatementSequence
 998                  =:
 999
1000 Declaration := "CONST" { ConstantDeclaration ";" } |
1001                "TYPE" { TypeDeclaration ";" } |
1002                "VAR" { VariableDeclaration ";" } |
1003                ProcedureDeclaration ";" |
1004                ModuleDeclaration ";" =:
1005
1006 DefFormalParameters := "(" [ DefMultiFPSection ] ")" FormalReturn =:
1007
1008 DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =:
1009
1010 FormalParameters := "(" [ MultiFPSection ] ")" FormalReturn =:
1011
1012 AttributeNoReturn := [ "<*" Ident "*>" ] =:
1013
1014 AttributeUnused := [ "<*" Ident "*>" ] =:
1015
1016 MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =:
1017
1018 FPSection := NonVarFPSection | VarFPSection =:
1019
1020 DefExtendedFP := DefOptArg | "..." =:
1021
1022 ExtendedFP := OptArg | "..." =:
1023
1024 VarFPSection := "VAR" IdentList ":" FormalType [ AttributeUnused ] =:
1025
1026 NonVarFPSection := IdentList ":" FormalType [ AttributeUnused ] =:
1027
1028 OptArg := "[" Ident ":" FormalType [ "=" ConstExpression ] "]" =:
1029
1030 DefOptArg := "[" Ident ":" FormalType "=" ConstExpression "]" =:
1031
1032 FormalType := { "ARRAY" "OF" } Qualident =:
1033
1034 ModuleDeclaration := "MODULE" Ident [ Priority ] ";"
1035                         { Import } [ Export ]
1036                       Block Ident
1037                      =:
1038
1039 Priority := "[" ConstExpression "]" =:
1040
1041 Export := "EXPORT" ( "QUALIFIED"
1042                                  IdentList |
1043                      "UNQUALIFIED"
1044                                  IdentList |
1045                      IdentList ) ";" =:
1046
1047 FromImport := "FROM" Ident "IMPORT" IdentList ";"
1048             =:
1049
1050 ImportModuleList := Ident { "," Ident }
1051                   =:
1052
1053 WithoutFromImport := "IMPORT" ImportModuleList ";"
1054                    =:
1055
1056 Import := FromImport | WithoutFromImport =:
1057
1058 DefinitionModule := "DEFINITION" "MODULE" [ "FOR" string ] Ident ";"   % curmodule := lookupDef (curident) %
1059                                                                        % enterScope (curmodule) %
1060                       { Import } [ Export ]
1061                       { Definition }
1062                     "END" Ident "."                                    % checkEndName (curmodule, curident, 'definition module') %
1063                                                                        % leaveScope %
1064                                                                        % setEnumsComplete (curmodule) %
1065                   =:
1066
1067 DefQualident :=
1068                 Ident                                                  % typeExp := lookupSym (curident) %
1069                       [ "."                                            % IF NOT isDef (typeExp)
1070                                                                          THEN
1071                                                                             ErrorArray ('the first component of this qualident must be a definition module')
1072                                                                          END %
1073                             Ident                                      % typeExp := lookupInScope (typeExp, curident) ;
1074                                                                          IF typeExp=NIL
1075                                                                          THEN
1076                                                                             ErrorArray ('identifier not found in definition module')
1077                                                                          END %
1078                                   ]
1079               =:
1080
1081 DefOptSubrange := [ SubrangeType |                                      % putType (typeDes, typeExp) %
1082                   ]
1083                 =:
1084
1085 DefTypeEquiv := DefQualident DefOptSubrange =:
1086
1087 DefEnumIdentList :=                                                     % VAR n, f: node ; %
1088                                                                         % n := makeEnum () %
1089                     Ident                                               % f := makeEnumField (n, curident) %
1090                           { "," Ident                                   % f := makeEnumField (n, curident) %
1091                                                                  }      % IF typeDes # NIL THEN putType (typeDes, n) END %
1092                   =:
1093
1094 DefEnumeration := "(" DefEnumIdentList ")" =:
1095
1096 DefSimpleType := DefTypeEquiv | DefEnumeration | SubrangeType
1097                =:
1098
1099 DefType := DefSimpleType | ArrayType | RecordType | SetType |
1100            PointerType | ProcedureType
1101          =:
1102
1103 DefTypeDeclaration := { Ident                                           % typeDes := lookupSym (curident) %
1104                         ( ";" | "=" DefType Alignment ";" ) }
1105                     =:
1106
1107 DefConstantDeclaration := Ident
1108                                 "=" ConstExpression
1109                         =:
1110
1111 Definition := "CONST" { DefConstantDeclaration ";" } |
1112               "TYPE" { DefTypeDeclaration } |
1113               "VAR" { DefVariableDeclaration ";" } |
1114               DefProcedureHeading ";" =:
1115
1116 AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =:
1117
1118 AsmOperands := string [ AsmOperandSpec ]
1119              =:
1120
1121 AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ]
1122                 =:
1123
1124 AsmList := [ AsmElement ] { ',' AsmElement } =:
1125
1126 NamedOperand := '[' Ident ']' =:
1127
1128 AsmOperandName := [ NamedOperand ]
1129                 =:
1130
1131 AsmElement := AsmOperandName string '(' Expression ')'
1132             =:
1133
1134 TrashList := [ string ] { ',' string } =:
1135
1136 FNB