Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TPF.ZIP/TPFSTM.PAS

Pascal/Delphi Source File | 1985-05-27 | 12.8 KB | 556 lines

{[B+]}

{*-----------------------------*
 | Parser forward declarations |
 *-----------------------------*}


procedure Statement;
    forward;


procedure Expression;
    forward;


procedure Expr_List(BreakAt: Integer);
    forward;


procedure Scan_Type;
    forward;


procedure Do_Block;
    forward;


procedure Ident_List;
{
! Scan a list of identifiers separated by commas. Formatting is allowed
! to continue if a comma is missing
}
    begin

    while Sym = Identifier do
        begin
        Next_Sym;

        if Sym = Comma then
            begin
            Next_Sym;
            Set_Symbol_Break(0);
            end;
        end;

    end; {Ident_List}


procedure Constant; {scan a constant}
    begin
    if Sym in [Plus, Minus] then Next_Sym;
    check(Constants - [Plus, Minus]);
    Next_Sym;
    end; {Constant}


procedure Variable; {scan off a variable, doesn't check much}
    begin

    while Sym in [Identifier, Period, Pointer, Open_Brack] do
        begin
        if Sym = Open_Brack then
            begin
            Next_Sym;
            Expr_List(0);
            Check_Sym(Close_Brack);
            end
        else Next_Sym;
        end;

    end; {Variable}


procedure Const_List; {scan a list of constants, as for case labels}
    begin

    while Sym in Constants do
        begin
        Constant;

        if Sym = Subrange then
            begin
            Next_Sym;
            Constant;
            end;

        if Sym = Comma then
            begin
            Next_Sym;
            Set_Symbol_Break(0);
            end;
        end;

    end; {Const_List}


procedure Factor;
    begin {scan a factor in an expression, ignores precedence}
    if Sym = Open_Paren then
        begin
        Next_Sym;
        Expr_List(0); {hack to allow structured constants}
        Check_Sym(Close_Paren);
        if Sym = Comma then Set_Symbol_Break(3);
        end
    else if Sym = Open_Brack then
        begin {set expression}
        Next_Sym;

        while Sym in Expr_Beg_Sys do
            begin
            Expr_List(1);
            if Sym = Subrange then Next_Sym;
            end;
        Check_Sym(Close_Brack);

        end
    else if Sym = Identifier then
        begin
        Variable;

        if Sym = Open_Paren then
            begin
            Put_Sym;
            if Write_Col <= Three_Fourth_Line then
                Indent_Plus(Write_Col - Indent)
            else Indent_Plus(0);
            Next_Sym;
            Expr_List(3);
            Check_Sym(Close_Paren);
            Undent;
            end
        end
    else Constant;
    end; {Factor}


procedure Expression; {scan an expression}
    begin

    while Sym in Expr_Beg_Sys do
        begin
        if Sym in [Plus, Minus, Not_Sym, Pointer] then Next_Sym;
        Factor;

        if Sym in [And_Sym, Or_Sym, Shl_Sym, Shr_Sym, Xor_Sym] then
            begin
            Next_Sym;
            Set_Symbol_Break(3);
            end
        else if Sym in Rel_Ops then
            begin
            Next_Sym;
            Set_Symbol_Break(2);
            end
        else if Sym in Arith_Ops then
            begin
            Next_Sym;
            Set_Symbol_Break(1);
            end;
        end; {while}
    end; {Expression}


procedure Expr_List {(BreakAt: Integer)} ;
    begin

    while Sym in Expr_Beg_Sys + [Comma] do
        begin
        if Sym in Expr_Beg_Sys then Expression;

        if (Sym = Comma) or (Sym = Colon) then
            begin
            Next_Sym;
            Set_Symbol_Break(BreakAt);
            end;
        end;

    end; {Expr_List}


procedure Stat_List; {process a list of statements}

    var
        Stat_Terms: Set_Of_Syms;
        Stat_Start: Col_Log;
        First_Stat: Boolean;

    begin
    Stat_Terms := Stat_Set + [Semicolon];
    First_Stat := true;

    repeat
        Log_Symbol_Start(Stat_Start);
        Statement;

        {note: may or may not have semicolon}
        Terminal_Semicolon;
        if (Stats_Per_Line > 1) and not First_Stat then
            Bunch_Statement(Stat_Start);

        {split like this so following comments don't screw up}
        if Sym = Semicolon then Get_Sym;
        First_Stat := false;
    until not (Sym in Stat_Terms);

    end; {State_List}


procedure Do_Begin(Proc_Block: Boolean);
{
! Handle a begin - end block, indenting if requested by setting proc_block
! true
}
    var
    Trim: Integer;            {amount to indent}

    begin
    Reset_Char_Count;
    if Proc_Block then Trim := Tab_Spaces else Trim := 0;
    Next_On_New_Line(0, Trim);
    Stat_List;
    Undent;
    Format_Line(Indent);
    Check_Sym(End_Sym);
    end; {Do_Begin}


procedure Do_Assign_Call; {either assignment or call}
    begin
    Format_Line(Indent);
    Indent_Plus(Continue_Spaces);
    Next_Sym;

    if Sym = Colon then
        begin
        Next_Sym;
        Statement;
        end
    else
        begin
        Variable;

        if Sym = Becomes then
            begin
            Next_Sym;

            if Write_Col < Three_Fourth_Line then
                Indent_Plus(Write_Col - Indent + 1)
            else
                begin
                Indent_Plus(0);
                Set_Symbol_Break(0);
                end;
            Expression;

            Terminal_Semicolon;
            Undent;
            end
        else if Sym = Open_Paren then
            begin
            Next_Sym;

            if Write_Col <= Three_Fourth_Line then
                Indent_Plus(Write_Col - Indent)
            else Indent_Plus(0);
            Expr_List(3);

            Check_Sym(Close_Paren);
            Terminal_Semicolon;
            Undent;
            end
        else Terminal_Semicolon;

        Undent;
        end;
    end; {Do_Assign_Call}


procedure Do_Goto; {goto statement}
    begin
    Format_Line(Indent);
    Next_Sym;
    if Sym in [Number, Identifier] then Next_Sym
    else Abort(Syntax);
    Terminal_Semicolon;
    end; {Do_Goto}


procedure Do_Inline;
    begin
    Format_Line(Indent);
    Indent_Plus(Continue_Spaces);
    Next_Sym;
    if Sym <> Open_Paren then Abort(Syntax);

    repeat
        Next_Sym;

        if Sym = Mult then
            begin
            Next_Sym;
            if Sym in Constants then Constant;
            end
        else Constant;
    until Sym <> Divide;

    Check_Sym(Close_Paren);
    Terminal_Semicolon;
    Undent;
    end; {Do_Inline}


procedure Do_While; {while statement}

    var
        While_Start: Col_Log;           {start of statement}
        Start_Line, End_Line: Integer;  {statement lines}
        Successful: Boolean;            {bunching went}

    begin
    Reset_Char_Count;
    Format_Line(Indent);
    Next_Sym;

    if Write_Col < Three_Fourth_Line then Indent_Plus(Write_Col - Indent + 1)
    else Indent_Plus(Continue_Spaces);

    Start_Line := Current_Line;
    Expression;
    Check_Sym(Do_Sym);
    Undent;
    Indent_Plus(Tab_Spaces);
    End_Line := Current_Line;
    Log_Symbol_Start(While_Start);
    Stat_Indent := Indent;
    Statement;
    if Bunching and (Start_Line = End_Line) then
        Bunch(While_Start, Successful);
    Undent;
    end; {Do_While}


procedure Do_With; {with statement}

    var
        Start_Line, End_Line: Integer;  {starting and ending lines of heading}
        With_Start: Col_Log;            {start of statement}
        Successful: Boolean;            {bunching went}

    begin
    Reset_Char_Count;
    Format_Line(Indent);
    Next_Sym;

    if Write_Col < Three_Fourth_Line then Indent_Plus(Write_Col - Indent + 1)
    else Indent_Plus(Continue_Spaces);

    Start_Line := Current_Line;
    Expr_List(3);
    Check_Sym(Do_Sym);
    Undent;
    Indent_Plus(Tab_Spaces);
    Stat_Indent := Indent;
    End_Line := Current_Line;
    Log_Symbol_Start(With_Start);
    Statement;
    if Bunching and (Start_Line = End_Line) then
        Bunch(With_Start, Successful);
    Undent;
    Make_White;
    end; {Do_With}


procedure Do_If(Prev_Else: Boolean {set if previous sym was else} );

    var
        If_Start: Col_Log;              {start of if statement}
        Start_Line, End_Line: Integer;  {statement lines}
        Successful: Boolean;            {bunching went}

    begin {if statement}
    Reset_Char_Count;
    if not Prev_Else then Format_Line(Indent);
    Next_Sym;

    if Write_Col < Three_Fourth_Line then Indent_Plus(Write_Col - Indent + 1)
    else Indent_Plus(Continue_Spaces);

    Start_Line := Current_Line;
    Expression;
    Check_Sym(Then_Sym);
    Undent;
    Indent_Plus(Tab_Spaces);
    End_Line := Current_Line;
    Log_Symbol_Start(If_Start);
    Statement;
    if Bunching and (Start_Line = End_Line) then Bunch(If_Start, Successful);
    Undent;
    Stat_Indent := Indent;

    if Sym = Else_Sym then
        begin
        Format_Line(Indent);
        Next_Sym;

        if Sym = If_Sym then Do_If(true)
        else
            begin
            Indent_Plus(Tab_Spaces);
            Log_Symbol_Start(If_Start);
            Statement;
            if Bunching then Bunch(If_Start, Successful);
            Undent;
            end;
        end;
    end; {Do_If}


procedure Do_Case;

    var
        Case_Start: Col_Log;            {start of case}
        Successful: Boolean;            {bunching successful}
        Lab_Start, LabEnd: Integer;     {label list lines}

    begin {case_statement}
    Reset_Char_Count;
    Format_Line(Indent);
    Next_Sym;

    if Write_Col < Three_Fourth_Line then Indent_Plus(Write_Col - Indent + 1)
    else Indent_Plus(Continue_Spaces);

    Expression;
    Check_Sym(Of_Sym);
    Undent;
    Indent_Plus(Tab_Spaces);
    Stat_Indent := Indent;

    while not (Sym in [End_Sym, Else_Sym]) do
        begin
        if Sym in Constants then
            begin
            Format_Line(Indent);
            Lab_Start := Current_Line;
            Const_List;
            Check_Sym(Colon);
            LabEnd := Current_Line;
            Indent_Plus(Tab_Spaces);
            Log_Symbol_Start(Case_Start);
            Statement;
            if Bunching and (Lab_Start = LabEnd) then
                Bunch(Case_Start, Successful);
            Undent;
            Stat_Indent := Indent;
            end; {if sym in constants}

        if Sym = Semicolon then Next_Sym;
        check(Constants + [End_Sym, Semicolon, Else_Sym]);
        end; {while}

    if Sym = Else_Sym then
        begin
        Next_On_New_Line(0, Tab_Spaces);
        Log_Symbol_Start(Case_Start);
        Stat_List;
        if Bunching then Bunch(Case_Start, Successful);
        Undent;
        end;

    Format_Line(Indent);
    Check_Sym(End_Sym);
    Undent;
    end; {Do_Case}


procedure Do_Repeat;
    begin {repeat statement}
    Reset_Char_Count;
    Next_On_New_Line(0, Tab_Spaces);
    Stat_List;
    Undent;
    Stat_Indent := Indent;
    Format_Line(Indent);
    Check_Sym(Until_Sym);

    if Write_Col < Three_Fourth_Line then Indent_Plus(Write_Col - Indent + 1)
    else Indent_Plus(Continue_Spaces);

    Expression;
    Terminal_Semicolon;
    Undent;
    end; {Do_Repeat}


procedure Do_For;

    var
        Start_Line, End_Line: Integer;  {starting and ending lines of header}
        For_Start: Col_Log;             {start of controlled statement}
        Successful: Boolean;            {bunching went}

    begin {for statement}
    Reset_Char_Count;
    Next_On_New_Line(0, Continue_Spaces);
    Start_Line := Current_Line;
    Check_Sym(Identifier);
    Check_Sym(Becomes);
    Expression;
    check([To_Sym, Downto_sym]);
    Next_Sym;
    Expression;
    Check_Sym(Do_Sym);
    Undent;
    Indent_Plus(Tab_Spaces);
    End_Line := Current_Line;
    Log_Symbol_Start(For_Start);
    Statement;
    if Bunching and (Start_Line = End_Line) then
        Bunch(For_Start, Successful);
    Undent;
    end; {Do_For}


procedure Statement; {handle a (possibly empty) statement}

    begin
    Stat_Indent := Indent;

    if Sym = Number then
        begin
        Indent_Plus( - Tab_Spaces);
        Format_Line(Indent);
        Next_Sym;
        Check_Sym(Colon);
        Undent;
        end;

    if Sym in (Stat_Set - [Number]) then
        case Sym of
            Begin_Sym: Do_Begin(false);
            Case_Sym: Do_Case;
            For_Sym: Do_For;
            Goto_Sym: Do_Goto;
            Identifier: Do_Assign_Call;
            If_Sym: Do_If(false);
            Inline_Sym: Do_Inline;
            Repeat_Sym: Do_Repeat;
            While_Sym: Do_While;
            With_Sym: Do_With;
            end; {case}

    Stat_Indent := Indent;
    end; {Statement}