/* Copyright (C) 1989, Digital Equipment Corporation           */
/* All rights reserved.                                        */
/* See the file COPYRIGHT for a full description.              */

/* Last modified on Tue Mar 13 01:36:33 1990 by muller         */
/*      modified on Tue Nov 14 09:03:00 1989 by kalsow         */


/*      modified on Mon Jun  1 11:37:54 1987 by firefly        */
/*      modified on  hania, Wed Jan  8 16:38:12 1986           */

/* A yacc source file for the Modula-3 pretty-printer. This grammar
   was constructed from the grammar given in the Modula-3 report;
   the main problem was to get it right for yacc (an expression can
   start by a type). */

/* Expect 1 shift/reduce conflict */

/* The effect of yyparse is to parse a fragment of the Modula 3
   language and emit a stream of characters and formatting codes
   to a separate process that performs the formatting. This process
   is actually Formatter. 

   Several of the non-terminals in this grammar derive the empty
   string and are just used to cause semantic rouintes to be called.
   These non-terminals are:

        G  begins a group.
	B  begins an indented object.
	B0 begins a non-indented object.
	E  ends a group or object.
	A  inserts a space followed by an optimal, ununited breakpoint.
	AN inserts a space followed by a non-optimal, ununited breakpoint.
	AZ inserts a space followed by an outdented, ununited breakpoint.
	V  inserts a space followed by a united breakpoint.
	VZ inserts a space followed by an outdented, united breakpoint.
        Z  inserts a united breakpoint if it follows a blank line.
	SP inserts a space.
	BL inserts a forced breakpoint.
	AL2 begins a 2-column aligned object.
	AL3 begins a 3-column aligned object.
	ALZ3 begins a 3-column aligned object that may fit on a single line.
	SPNL inserts a space or united breakpoint depending on the style.
	NL inserts a forced breakpoint.
	Inc increases depth, which is used to distinguish outer level
	   comments, which are formatted differently from inner comments.
	Dec decreases depth.

   These semantic routines use the C procedures:

        BE(n) inserts a Formatter.Begin with offset n.
	EN()  inserts a Formatter.End ().
	GR()  inserts a Formatter.Group ().
	BL()  inserts a forced breakpoint with offset 0.
        P(c) inserts the character c, except that if c is
          newline, it is treated as a forced breakpoint with
          a large negative offset.
        Pr(s) applies P to each character of the string s.
        Flush() flushes the buffers of the formatted stream.
        Reset() does nothing.
	NL()  inserts a new line.
	DoSPNL() inserts a space or forced breakpoint depending on the style.
	DoAlign() starts an aligned object.
	DoBreak() inserts a breakpoint.

   */

/* The lexical analyzer communicates with the parser through
   a buffer capable of holding two lexemes; since YACC uses
   only one-token lookahead, and since lexemes are reduced
   immediately to non-terminals, and since the character string
   for a lexeme is used by the pretty-printer only when the
   lexeme is first reduced to a non-terminal, it follows that
   a two-lexeme buffer is sufficient.  (This buffer is only
   used for lexemes, like Identifiers and integers, that are
   not completely characterized by their token number.)
   The buffer is called  lexbuf ; it contains two null-terminated
   character strings, one beginning at position 0, the other at
   position 500.  The variable lexptr, used by the lexical
   analyzer, Identifer which of these two positions is current.   */

%{

#define lexbufsize 500
char lexbuf[2 * lexbufsize];
int lexptr = 0;
int lexposition = 0;
  /* See BufferLexeme and AddLexLength in Parse.lex */

int comdepth = 0;
  /* depth of comments, used only by lexer. */

int depth = 0;
  /* depth of nesting in blocks, used by NPS for formatting comments */

int blanklinep;  
  /* Set by NPS if the non-program-sequence that it parses ends
     with a blank line. */

int calledFromEmacs;
  /* set to one by main if called from Emacs, to zero otherwise */

int capSwitch;
  /* 1 if -cap switch was set, 0 otherwise. */

int formatter;
  /* the opaque Formatter.T object */

int offset = 2;

typedef enum {SRC_STYLE, EM_STYLE} STYLE;
STYLE style = SRC_STYLE;

%}

/* basic tokens */
%token ENDOFFILE 0

%token AMPERSAND ASSIGN ASTERISK BAR COLON COMMA DOT DOTDOT
%token EQUAL GREATER GREQUAL LESS LSEQUAL MINUS SHARP PERIOD PLUS
%token RARROW RBRACE RBRACKET RPAREN SEMICOLON SLASH
%token SUBTYPE UPARROW 
%token LPAREN LBRACKET LBRACE ENDPRAGMA

%token IDENT CARD_CONST REAL_CONST CHAR_CONST STR_CONST

/* reserved words */ 
%token AND ARRAY ASSERT BGN BITS BRANDED BY CASE CONST 
%token DIV DO ELSE ELSIF END EVAL EXCEPT EXCEPTION EXIT EXPORTS EXTERNAL
%token FINALLY FOR FROM IF IMPORT IN INLINE INTERFACE LOCK LOOP
%token METHODS MOD MODULE NOT OBJECT OF OR PROCEDURE RAISE RAISES
%token READONLY RECORD REF REPEAT RETURN REVEAL SET THEN TO
%token TRY TYPE TYPECASE UNSAFE UNTIL UNTRACED VALUE VAR WHILE WITH

/* token to force error from scanner */
%token BAD

/* Tokens needed only by the pretty-printer */
%token BGNCOMMENT NLBGNCOMMENT ENDCOMMENT WORD BLANKLINE SLC NLSLC
%token NLSLCNL TABLINE MODUNIT DEFUNIT

/* BGNCOMMENT is a begin-comment lexeme that appears on a line with */
/* something to its left.  NLBGNCOMMENT is a begin-comment lexeme that */
/* is the first lexeme on its line. MODUNIT and DEFUNIT are needed only */
/* when the pretty-printer is called from Emacs. */

%start FormattingUnit

%%

/*--------------------- modules ------------------------*/

FormattingUnit:
      { depth=0; } CompilationUnit
    | { depth=0; } MODUNIT ModUnit
    | { depth=0; } DEFUNIT DefUnit
    ;

ModUnit:
      declaration_list
    | CompilationUnit
    | B Inc Begin stmts VZ Dec End SP Ident E
    ;

DefUnit:
      interface_declaration_list
    | CompilationUnit
    ;

CompilationUnit:
      interface
    | Unsafe SP interface
    | module
    | Unsafe SP module
    | InitialNPS A interface
    | InitialNPS A Unsafe SP interface
    | InitialNPS A module
    | InitialNPS A Unsafe SP module
    ;

interface:
      Interface SP Ident Z Semi V
        import_list
        interface_declaration_list
        SP NL End SP Ident Z Dot
    ;

module:
      Module SP Ident exports Z Semi V
        import_list
        named_block Z Dot
    ;

exports:
      /* empty */
    | A B Exports SP id_list E
    ;

import_list:
      /* empty */
    | import_list import VZ
    ;

import:
      From SP Ident SP Import SP B id_list Z E Semi
    |                  Import SP B id_list Z E Semi
    ;

block:
      declaration_list B Inc Begin stmts SP NL Dec End Z E
    ;

named_block:
      declaration_list B Inc Begin stmts SP NL Dec End SP Ident E
    ;

interface_declaration_list:
      /* empty */
    | interface_declaration_list interface_declaration VZ
    ;

interface_declaration:
      decl
    | B             Inc procedure_head Z Dec Semi SP E
    | B External SP Inc procedure_head Z Dec Semi SP E
    ;

declaration_list:
      /* empty */
    | declaration_list declaration VZ
    ;

declaration:
      decl
    | B Inc procedure_head SP Equal NL XX B named_block Z Dec Semi E E 
    ;

decl:
      B             Const     V AL3 const_decl_list     E E
    | B             Type      V AL2 type_decl_list      E E 
    | B             Reveal    V AL2 type_decl_list      E E
    | B             Var       V AL3 var_decl_list       E E
    | B External SP Var       V AL3 var_decl_list       E E
    | B             Exception V     exception_decl_list   E
    ;

const_decl_list:
      /* empty */
    | const_decl_list const_decl
    ;

const_decl:
      Inc G  G Ident Colon E  G type SP E  G Equal SP expr Z Dec Semi XSP E E
    | Inc G  G Ident       E  G      SP E  G Equal SP expr Z Dec Semi XSP E E
    ;

type_decl_list:
      /* empty */
    | type_decl_list type_decl
    ;

type_decl:
      Inc G  G type_name E  G SP Equal   SP type Z Dec Semi XSP E  E
    | Inc G  G type_name E  G SP Subtype SP type Z Dec Semi XSP E  E
    ;

type_name:
      Ident
    | Ident Z Dot Z Ident
    ;

var_decl_list:
      /* empty */
    | var_decl_list var_decl
    ;

var_decl:
      Inc G  G id_list Colon                 E
             G SP type Z Dec Semi            E
             G                           XSP E E
    | Inc G  G id_list Colon                 E
             G SP type SP                    E
             G Assign SP expr Z Dec Semi XSP E E 
    | Inc G  G id_list                       E 
             G SP                            E
             G Assign SP expr Z Dec Semi XSP E E
    ;

exception_decl_list:
      /* empty */
    | exception_decl_list exception_decl V
    ;

exception_decl:
      Inc id_list                        Z Dec Semi XSP
    | Inc id_list A Lparen type Z Rparen Z Dec Semi XSP
    ;

procedure_head:
      B           Procedure SP Ident SP signature E
    | B Inline SP Procedure SP Ident SP signature E
    ;

signature:
      B Lparen2 formals Z Rparen return_type AX raises E
    ;

return_type:
      /* empty */
    | Z Colon SP type
    ;

raises:
      /* empty */
    | Raises SP Lbrace opt_qid_list Z Rbrace
    ;

formals:
      /* empty */
    | AL3 formal_list        E E
    | AL3 formal_list Z Semi E E
    ;

formal_list:
      G formal
    | formal_list Z Semi SP E G formal
    ;

formal:
      mode id_list type_and_or_val
    ;

mode:
      /* empty */
    | Value     SP
    | Var       SP
    | Readonly  SP
    ;

type_and_or_val:
      Colon E  G SP type    E  G
    | Colon E  G SP type SP E  G Assign SP expr
    |       E  G SP         E  G Assign SP expr
    ;

/*--------------------- statements & pragmas ------------------------*/

pragma_list:
      /* empty */
    | pragma_list pragma E V B
    ;

pragma:
      assert_pragma
    ;

assert_pragma:
      Assert V expr SP EndPragma
    ;

stmts:
      /* empty */
    | stmt_list        E
    | stmt_list Z Semi E
    ;

stmt_list:
      V B stmt
    | stmt_list Z Semi E V B stmt
    ;

stmt:
      pragma_list really_a_stmt
    ;

really_a_stmt:
      assignment_stmt
    | block
    | call_stmt
    | case_stmt
    | exit_stmt
    | eval_stmt
    | for_stmt
    | if_stmt
    | lock_stmt
    | loop_stmt
    | raise_stmt
    | repeat_stmt
    | return_stmt
    | try_finally_stmt
    | try_stmt
    | typecase_stmt
    | while_stmt
    | with_stmt
    ;

assignment_stmt:
      expr SP Assign B A expr E
    ;

call_stmt:
      expr
    ;

case_stmt:
      Case A expr A Of V case case_list else SPNL End
    | Case A expr A Of V      case_list else SPNL End
    ;

case_list:
      /*empty*/
    | case_list V Bar SP case
    ;

case:
      B B labels_list SP Rarrow E stmts E
    ;

labels_list:
      labels
    | labels_list Z Comma A labels
    ;

labels:
      B expr E
    | B expr SP Dotdot V expr E
    ;

exit_stmt:
      Exit
    ;

eval_stmt:
      Eval B A expr E
    ;

for_stmt:      
      B For SP Ident A Assign SP expr A To SP expr A by Do E
           stmts SPNL End
    ;

by:
      /* empty */
    | By SP expr SP
    ;

if_stmt:
      B If SP expr A Then E stmts elsif_list else SPNL End
    ;

else:
      /* empty */
    | VZ Else stmts
    ;

elsif_list:
      /* empty */
    | elsif_list elsif
    ;

elsif:
      VZ B Elsif A expr A Then E stmts
    ;

lock_stmt:
      B Lock A expr A Do E stmts SPNL End
    ;

loop_stmt: 
      Loop stmts SPNL End
    ;

raise_stmt:
      Raise A expr 
    ;

repeat_stmt:
      Repeat stmts VZ B Until A expr E
    ;

return_stmt:
      Return
    | Return A expr 
    ;

try_finally_stmt: 
      Try stmts VZ Finally stmts SPNL End 
    ;

try_stmt:
      Try stmts VZ Except VZ SP SP handler handler_list else SPNL End
    | Try stmts VZ Except                  handler_list else SPNL End
    ;

handler_list:
      /* empty */
    | handler_list VZ Bar SP handler
    ;

handler:
      B qid_list A Lparen Ident Z Rparen SP Rarrow E stmts
    | B qid_list                         SP Rarrow E stmts
    ;

typecase_stmt:
      B Typecase A expr A Of E VZ SP SP tcase tcase_list else SPNL End
    | B Typecase A expr A Of E                tcase_list else SPNL End
    ;

tcase_list:
      /* empty */
    | tcase_list VZ Bar SP tcase
    ;

tcase:
      B type_list SP Rarrow E stmts
    ;

while_stmt:
      B While A expr A Do E stmts SPNL End 
    ;

with_stmt:
      B With V binding_list A Do E stmts SPNL End 
    ;

binding_list:
      binding
    | binding_list V binding
    ;

binding:
      B Ident SP Equal A expr E
    ;

opt_qid_list:
      /* empty */
    | qid_list
    ;

qid_list:
      qid
    | qid_list Z Comma A qid
    ;

qid:
      Ident
    | Ident Dot Ident
    ;

/*--------------------- types ------------------------*/

type_list:
      A type
    | type_list Z Comma A type
    ;

type:
      B type_name                            E
    | B type_name SP simple_object_type_list E
    | B type_constructor                     E
    | B Lparen type Z Rparen                 E
    ;

type_constructor:
      Array type_list SP Of V type
    | Array           SP Of V type
    | Bits A expr A For V type
    | Procedure A signature
    | Record opt_fields SPNL End
    | Set SP Of V type
    | Untraced SP simple_object_type_list
    |             simple_object_type_list
    | Untraced SP brand Ref V type
    |             brand Ref V type
    | Lbrace opt_id_list Z Rbrace
    | Lbracket expr SP Dotdot V expr Z Rbracket
    ;

simple_object_type_list:
      simple_object_type
    | simple_object_type_list V simple_object_type
    ;

simple_object_type:
      brand Object opt_fields SPNL End 
    | brand Object opt_fields VZ Methods methods SPNL End
    ;

brand:
      /* empty */
    | Branded A
    | Branded SP Str_const A
    ;

opt_fields:
      /* empty */
    | V AL3 field_list        E E E
    | V AL3 field_list Z Semi E E E
    ;

field_list:
      field
    | field_list Z Semi SP E E field
    ;

field:
      G G id_list type_and_or_val
    ;

methods:
      /* empty */
    | V AL3 method_list        E E E
    | V AL3 method_list Z Semi E E E
    ;

method_list:
      method
    | method_list Z Semi SP E E method
    ;

method:
      G  G Ident E  G SP signature    E  G
    | G  G Ident E  G SP signature SP E  G Assign SP qid
    | G  G Ident E  G SP              E  G Assign SP qid
    ;

/*--------------------- expressions ------------------------*/

expr:   B zexpr E ;
zexpr:  e1 | zexpr A Or SP e1  ;

e1:     B ze1 E ;
ze1:    e2 | ze1 A And SP e2 ;

e2:     Not SP e2 | e3 ;

e3:     B ze3 E ;
ze3:    e4 | ze3 A relop SP e4 ;
relop:  Equal | Notequal | Less | Lsequal | Greater | Grequal | In ;

e4:     B ze4 E ;
ze4:    e5 | ze4 A addop SP e5 ;
addop:  Plus | Minus | Ampersand ;

e5:     B ze5 E ;
ze5:    e6 | ze5 A mulop SP e6 ;
mulop:  Asterisk | Slash | Div | Mod ;

e6:     e7 | Plus Z e6 | Minus Z e6 ;

e7:     e8 Z selector_list ;

e8:     Ident | Card_const | Real_const | Char_const | Str_const
        | Lparen expr Z Rparen | Lparen type_constructor Z Rparen ;

selector_list:
      /* empty */
    | selector_list Z selector
    ;

selector:
      Dot Ident
    | Uparrow
    | SP Lbracket B0 expr_list           E Z Rbracket
    | SP Lparen   B0 actual_list         E Z Rparen
    | SP Lparen                            Z Rparen
    | SP Lbrace   B0 elem_list elem_tail E Z Rbrace
    | SP Lbrace                            Z Rbrace
    ;

expr_list:
      Z expr
    | expr_list Z Comma A expr
    ;

actual_list:
      Z actual
    | actual_list Z Comma A actual
    ;

actual:
      G expr              E
    | G type_constructor  E
    | G B B B B B Ident SP Assign A expr E E E E E E
    ;    /* the extra B's & E's match the expression hierarchy. yech! */

elem_list:
      Z elem
    | elem_list Z Comma A elem
    ;

elem:
      expr
    | expr Z Dotdot A expr
    | expr SP Assign A expr
    ;

elem_tail:
      /* empty */
    | Z Comma A Dotdot
    ;

opt_id_list:
      /* empty */
    | id_list
    ;

id_list:
      B0 Z zid_list E
    ;

zid_list:
      Ident
    | zid_list Z Comma A Ident
    ;


/*---------------------  terminals ----------------------------*/

Ampersand:     AMPERSAND { PR ("&");} NPS ;
Assign:        ASSIGN { PR (":=");} NPS ;
Asterisk:      ASTERISK { PR ("*");} NPS ;
Bar:           BAR { PR ("|");} NPS ;
Colon:         COLON { PR (":");} NPS ;
Comma:         COMMA { PR (",");} NPS ;
Dot:           DOT { PR (".");} NPS ;
Dotdot:        DOTDOT { PR ("..");} NPS ;
EndPragma:     ENDPRAGMA { PR ("*>");} NPS ;
Equal:         EQUAL { PR ("=");} NPS ;
Greater:       GREATER { PR (">");} NPS ;
Grequal:       GREQUAL { PR (">=");} NPS ;
Less:          LESS { PR ("<");} NPS ;
Lsequal:       LSEQUAL { PR ("<=");} NPS ;
Minus:         MINUS { PR ("-");} NPS ;
Notequal:      SHARP { PR ("\043");} NPS ;
Plus:          PLUS { PR ("+");} NPS ;
Rarrow:        RARROW { PR ("=>");} NPS ;
Rbrace:        RBRACE { PR ("}");} NPS ;
Rbracket:      RBRACKET { PR ("]");} NPS ;
Rparen:        RPAREN { PR (")");} NPS ;
Semi:          SEMICOLON { PR (";");} NPS ;
Slash:         SLASH { PR ("/");} NPS ;
Subtype:       SUBTYPE { PR ("<:");} NPS ;
Uparrow:       UPARROW { PR ("^");} NPS ;

Lparen:        LPAREN { PR ("("); blanklinep=0;} CommentAfterOpen ;
Lparen2:       LPAREN { PR ("("); blanklinep=0;} CommentAfterOpen2 ;
Lbracket:      LBRACKET { PR ("["); blanklinep=0;} CommentAfterOpen ;
Lbrace:        LBRACE { PR ("{"); blanklinep=0;} CommentAfterOpen ;

CommentAfterOpen:   /* empty */ | SP InitialNPS A ;
CommentAfterOpen2:  /* empty */ |    InitialNPS ;

Ident:         IDENT { PR (&lexbuf[$1]);} NPS ;
Card_const:    CARD_CONST { PR (&lexbuf[$1]);} NPS ;
Real_const:    REAL_CONST { PR (&lexbuf[$1]);} NPS ;
Char_const:    CHAR_CONST { PR (&lexbuf[$1]);} NPS ;
Str_const:     STR_CONST { PR (&lexbuf[$1]);} NPS ;

And:           AND { PR ("AND");} NPS ;
Array:         ARRAY { PR ("ARRAY");} NPS ;
Assert:        ASSERT { PR ("<*ASSERT");} NPS ;
Begin:         BGN { PR ("BEGIN");} NPS ;
Bits:          BITS { PR ("BITS");} NPS ;
Branded:       BRANDED { PR ("BRANDED");} NPS ;
By:            BY { PR ("BY");} NPS ;
Case:          CASE { PR ("CASE");} NPS ;
Const:         CONST { PR ("CONST");} NPS ;
Div:           DIV { PR ("DIV");} NPS ;
Do:            DO { PR ("DO");} NPS ;
Else:          ELSE { PR ("ELSE");} NPS ;
Elsif:         ELSIF { PR ("ELSIF");} NPS ;
End:           END { PR ("END");} NPS ;
Eval:          EVAL { PR ("EVAL");} NPS ;
Except:        EXCEPT { PR ("EXCEPT");} NPS ;
Exception:     EXCEPTION { PR ("EXCEPTION");} NPS ;
Exit:          EXIT { PR ("EXIT");} NPS ;
Exports:       EXPORTS { PR ("EXPORTS");} NPS ;
External:      EXTERNAL { PR ("<*EXTERNAL*>");} NPS ;
Finally:       FINALLY { PR ("FINALLY");} NPS ;
For:           FOR { PR ("FOR");} NPS ;
From:          FROM { PR ("FROM");} NPS ;
If:            IF { PR ("IF");} NPS ;
Import:        IMPORT { PR ("IMPORT");} NPS ;
In:            IN { PR ("IN");} NPS ;
Inline:        INLINE { PR ("<*INLINE*>");} NPS ;
Interface:     INTERFACE { PR ("INTERFACE");} NPS ;
Lock:          LOCK { PR ("LOCK");} NPS ;
Loop:          LOOP { PR ("LOOP");} NPS ;
Methods:       METHODS { PR ("METHODS");} NPS ;
Mod:           MOD { PR ("MOD");} NPS ;
Module:        MODULE { PR ("MODULE");} NPS ;
Not:           NOT { PR ("NOT");} NPS ;
Object:        OBJECT { PR ("OBJECT");} NPS ;
Of:            OF { PR ("OF");} NPS ;
Or:            OR { PR ("OR");} NPS ;
Procedure:     PROCEDURE { PR ("PROCEDURE");} NPS ;
Raise:         RAISE { PR ("RAISE");} NPS ;
Raises:        RAISES { PR (" RAISES");} NPS ;
Readonly:      READONLY { PR ("READONLY");} NPS ;
Record:        RECORD { PR ("RECORD");} NPS ;
Ref:           REF { PR ("REF");} NPS ;
Repeat:        REPEAT { PR ("REPEAT");} NPS ;
Return:        RETURN { PR ("RETURN");} NPS ;
Reveal:        REVEAL { PR ("REVEAL");} NPS ;
Set:           SET { PR ("SET");} NPS ;
Then:          THEN { PR ("THEN");} NPS ;
To:            TO { PR ("TO");} NPS ;
Try:           TRY { PR ("TRY");} NPS ;
Type:          TYPE { PR ("TYPE");} NPS ;
Typecase:      TYPECASE { PR ("TYPECASE");} NPS ;
Unsafe:        UNSAFE { PR ("UNSAFE");} NPS ;
Until:         UNTIL { PR ("UNTIL");} NPS ;
Untraced:      UNTRACED { PR ("UNTRACED");} NPS ;
Value:         VALUE { PR ("VALUE");} NPS ;
Var:           VAR { PR ("VAR");} NPS ;
While:         WHILE { PR ("WHILE");} NPS ;
With:          WITH { PR ("WITH");} NPS ;

BgnComment:    BGNCOMMENT { PR ("(*");} ;
NLBgnComment:  NLBGNCOMMENT { PR ("(*");} ;
EndComment:    ENDCOMMENT { PR ("*)");} ;
Word:          WORD { PR (&lexbuf[$1]);} ;
NlSlc:         NLSLC { PR (&lexbuf[$1]);} ;
NlSlcNl:       NLSLCNL { PR (&lexbuf[$1]);} ;
Slc:           SLC { PR (&lexbuf[$1]);} ;
Tabline:       TABLINE { PR (&lexbuf[$1]);} ;
Blankline:     BLANKLINE;

/*--------------------- comments ------------------------*/

NPS:
      { blanklinep=0; } NPSTail
    ;

NPSTail:
      /* empty */
    | BL Blankline { if (depth==0) BE(-9999); blanklinep=1; }
                                     NPSTail { if (depth==0) EN(); }
    | BL NlSlcNl   { blanklinep=1; } NPSTail
    | Comment      { blanklinep=0; } NPSTail
    ;

InitialNPS:
      BL Blankline   { blanklinep=1; } NPSTail
    | BL NlSlcNl     { blanklinep=1; } NPSTail
    | InitialComment { blanklinep=0; } NPSTail
    ;

InitialComment:
      BL Comment1
    | Comment2 
    | BL NlSlc
    | Slc
    ;

Comment:
      BL Comment1
    | A  Comment2
    | BL NlSlc
    | A  Slc
    ;

Comment1:
      Bc NLBgnComment CB E
    ;

Comment2:
      Bc BgnComment CB E
    ;

CB:
      CB2 AZc EndComment
    | CB2 DLine_list BL EndComment
    ;

CB2:
      /* empty */
    | CB2 AN Word
    | CB2 Comment
    | CB2 DLine_list BL Word
    | CB2 DLine_list BL Comment1
    | CB2 DLine_list BL Comment2
    ;

DLine_list:
      DLine
    | DLine_list DLine
    ;

DLine:
      BL Blankline
    | Tabline
    ;

/*----------------- formatting semantic routines -----------------------*/

G:     { GR (); }       /* begin group */
B0:    { BE (0); }      /* begin object - no indentation */
B:     { BE (offset); } /* begin indented group */
Bc:    { BE (3); }      /* begin a comment group */
E:     { EN (); }       /* end group/object */

A:     { DoBreak (1, 2, 0); };     /* optimal, ununited break point */
AN:    { DoBreak (1, 3, 0); };     /* non-optimal, ununited break point */
AX:    { DoBreak (0, 2, 0); };     /* no space, std indent */
/* AZ:    { DoBreak (1, 2, -offset); }; */    /* space, outdent */
AZc:   { DoBreak (1, 2, -3); };     /* space, outdent a comment */

V:     { DoBreak (1, 1, 0); };     /* united break point */
/* VX:    { DoBreak (0, 1, 0); };    */       /* no space, std indent */
VZ:    { DoBreak (1, 1, -offset); };     /* space, outdent */

Z:     { DoBreak (0, 0, 0); };     /* no space, no break unless blank line */
SP:    { DoBreak (1, 0, 0); };     /* space */
XSP:   { PR (" "); };              /* simple space */

BL:    { BL (); };                 /* forced break point */

AL2:   { DoAlign (2, 0); };        /* begin aligned object */
AL3:   { DoAlign (3, 0); };
/* ALZ3:  { DoAlign (3, 1); }; */

SPNL:  { DoSPNL (); };             /* Space/Newline depending on the style */
NL:    { NL (); };

XX:    { {int zz; for (zz = depth*offset; zz > 0; zz--) P(' ');}; }
/* indent a procedure body */

Inc:   { depth++; };
Dec:   { depth--; };

%%

/*-------- additional C code to implement the semantic routines -----------*/

PR (s)
char *s;
{
  while (*s != 0) {
    P (*s);
    s++; }
};

BE (n)  int n;  { _Formatter__Begin (formatter, n, 0x7fffffff); };
EN ()           { _Formatter__End (formatter); };
GR ()           { _Formatter__Group (formatter); };
BL ()           { _Formatter__NewLine (formatter, 0, 0); };
NL ()           { _Formatter__NewLine (formatter, -offset, 0); };
P  (n)  int n;  { _Formatter__PutChar (formatter, n); };
Flush ()        { _Formatter__Flush (formatter); };
Reset ()        { };

DoSPNL ()
{
   if (style == EM_STYLE) {
     DoBreak (1, 0, 0);
   } else {
     DoBreak (1, 1, -offset);
   };
};

DoAlign (cols, oneline)
int cols, oneline;
{
   _Formatter__Align (formatter, cols, oneline || (depth > 0), 0, 0, 0);
};

DoBreak (blank, breakpt, offs)
int blank, breakpt, offs;
{
  if (blanklinep==1) { blank=0; breakpt=1; blanklinep=0; };
  if (blank==1)   _Formatter__PutChar (formatter, ' ');
  if (breakpt==1) _Formatter__UnitedBreak (formatter, offs, 0);
  if (breakpt==2) _Formatter__Break (formatter, offs, 1, 1);
  if (breakpt==3) _Formatter__Break (formatter, offs, 0, 1);
};

#include <stdio.h>
#include "hash.h"
#include "lex.yy.c"

initParser (infile, outfile, emacs, caps, offs, sty)
char *infile;
int outfile, emacs, caps, offs;
STYLE sty;
{
  yyin = stdin;
  if ((!emacs) && (infile != 0)) {
    yyin = fopen (infile, "r");
    if (yyin == NULL) {
      fprintf (stderr, "m3pp: unable to open \"%s\".\n", infile);
      exit (1);
    };
  };
  formatter = outfile;
  calledFromEmacs = emacs;
  capSwitch = caps;
  offset = offs;
  style = sty;
  insertKeywords ();
} /* initParser */

yyerror(s) char *s; {
  char temp; char temp2;
  Reset();
  Flush();
  if (calledFromEmacs == 0) {
        fprintf (stderr,
            "%s while pretty-printing; original position %d\n",
             s, lexposition);
        fprintf(stderr, "Error flagged in output\n");
  }
  PR ("(* SYNTAX ERROR *) ");
  if (!calledFromEmacs && (yychar == 0)) return;  /* end-of-file */
  if ((lexbuf[lexptr] == '\001') && calledFromEmacs) return;
    /* i.e., return if formatting unit from Emacs was incomplete. */
  PR (&lexbuf[lexptr]);
  /* Now print the rest of the input, but if
     the input is terminated by end-of-file (rather than the Emacs
     sentinel '001'), and if the last thing before the end-of-file
     is a newline, then don't print that final newline.  This is
     because Flush() will be called by main when yyerror returns. */
  temp2 = input();   /* input comes from the lex library. */
  if ((calledFromEmacs && (temp2 == '\001')) || (temp2 == 0)) return;
  temp = input();
  while ((temp != 0) && (!calledFromEmacs || (temp != '\001')))
    {P (temp2); temp2 = temp; temp = input();}
  if ((temp2 != '\n') || (temp != 0)) P(temp2);
}