Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/549a.lha/M2P_v1.0/mods.lzh/Parser.mod

Text File | 1991-08-10 | 16KB | 721 lines

(*======================================================================*)
(*                      Modula-2 Preprocessor Parser                    *)
(*======================================================================*)
(*  Version:  1.00              Author:   Dennis Brueni                 *)
(*  Date:     07-10-91          Changes:  Original                      *)
(*======================================================================*)

IMPLEMENTATION MODULE Parser;

IMPORT
    FIO,Strings,Env;
IMPORT
    SymTab,SymLists,MacLists;
IMPORT
    Err,FSM,LexAn;





















































(*----------------------------------------------------------------------*)


PROCEDURE SkipSpace;
BEGIN
    WITH FSM.Token DO
        WHILE (Class = FSM.M2ch) AND (String[0] = ' ') DO
            LexAn.GetToken;
        END;
    END;
END SkipSpace;

PROCEDURE GetTokenThenSkipSpace;
BEGIN
    LexAn.GetToken;
    SkipSpace;
END GetTokenThenSkipSpace;

(*----------------------------------------------------------------------*)







(*----------------------------------------------------------------------*)
(*      Factor  -->     ( Expr ) | NOT ID | ID                          *)
(*----------------------------------------------------------------------*)


PROCEDURE Factor():BOOLEAN;
VAR
    temp: BOOLEAN;
    symb: SymTab.SymRecPtr;
BEGIN

    WITH FSM.Token DO
        CASE Class OF
        FSM.M2LParen:
            GetTokenThenSkipSpace;
            temp:=Expr();
            IF Class # FSM.M2RParen THEN
                Err.Message(Err.UnBalParens);
            ELSE
                GetTokenThenSkipSpace;
            END;
        |FSM.M2NOT:
            GetTokenThenSkipSpace;
            temp:=NOT Factor();
        |FSM.M2ID:
            symb:=SymTab.LookUp(String);
            temp:=symb#NIL;
            GetTokenThenSkipSpace;
        ELSE
            Err.Message(Err.IllFactor);
            temp:=TRUE;
        END;
    END;

    RETURN temp;
END Factor;

(*----------------------------------------------------------------------*)
(*      Term2   -->     & <Factor> <Term2> | e                          *)
(*----------------------------------------------------------------------*)

PROCEDURE Term2():BOOLEAN;
VAR
    temp: BOOLEAN;
BEGIN

    WITH FSM.Token DO
        IF Class=FSM.M2AND THEN
            GetTokenThenSkipSpace;
            temp:= Factor();
            temp:= Term2() AND temp;
        ELSE
            temp:= TRUE;
        END;
    END;

    RETURN temp;
END Term2;

(*----------------------------------------------------------------------*)
(*      Term    -->     <Factor> <Term2>                                *)
(*----------------------------------------------------------------------*)

PROCEDURE Term():BOOLEAN;
VAR
    temp: BOOLEAN;
BEGIN

    temp:= Factor();
    temp:= Term2() AND temp;

    RETURN temp;
END Term;

(*----------------------------------------------------------------------*)
(*      Expr2   -->     | <Term> <Expr2> | e                            *)
(*----------------------------------------------------------------------*)

PROCEDURE Expr2():BOOLEAN;
VAR
    temp: BOOLEAN;
BEGIN

    WITH FSM.Token DO
        IF Class=FSM.M2OR THEN
            GetTokenThenSkipSpace;
            temp:= Term();  (* avoid short circuit *)
            temp:= Expr2() OR temp;
        ELSE
            temp:= FALSE;
        END;
    END;

    RETURN temp;
END Expr2;

(*----------------------------------------------------------------------*)
(*      Expr    -->     <Term> <Expr2>                                  *)
(*----------------------------------------------------------------------*)

PROCEDURE Expr():BOOLEAN;
VAR
    temp: BOOLEAN;
BEGIN

    temp:=Term();
    temp:=Expr2() OR temp;

    RETURN temp;
END Expr;

(*----------------------------------------------------------------------*)
(*      PPStmt  -->     IF <Expr> @THEN <S> { @ELSIF <S> }              *)
(*                      [@ELSE <S>] @END                                *)
(*----------------------------------------------------------------------*)


PROCEDURE IfStmt(Echo: BOOLEAN);

VAR
    TrueFalse: BOOLEAN;
BEGIN

    TrueFalse:=Expr();
    WITH FSM.Token DO
        IF Class = FSM.M2AtSign THEN
            GetTokenThenSkipSpace;
        END;
        IF Class = FSM.M2THEN THEN
            LexAn.GetToken;
        ELSE
            Err.Message(Err.MissThen);
        END;
        LOOP
            Stmt(Echo AND TrueFalse);
                    (* THEN clause          *)
            IF Class # FSM.M2AtSign THEN
                Err.Message(Err.MissAtElse);
                EXIT;
            END;
            GetTokenThenSkipSpace;

            IF (Class=FSM.M2ELSIF) THEN
                    (* ELSIF clause, just   *)
                GetTokenThenSkipSpace;
                    (* like a real IF, sort *)
                IfStmt(Echo AND NOT TrueFalse);
                    (* of, so have some     *)
                EXIT;
       (* Tail recursion fun   *)
            END;

            IF Class=FSM.M2ELSE THEN
                    (* ELSE clause, ends    *)
                LexAn.GetToken;
                    (* entire IF statement  *)
                LOOP
                    Stmt(NOT TrueFalse AND Echo);
                    IF Class # FSM.M2AtSign THEN
                        Err.Message(Err.MissAtEnd);

                        RETURN;
                    END;
                    GetTokenThenSkipSpace;
                    IF Class=FSM.M2END THEN

                        RETURN;
                    END;
                    PPStmt(NOT TrueFalse AND Echo);
                END;
            END;

            IF Class=FSM.M2END THEN
                EXIT;
            END;            (* Found the @END?      *)
            PPStmt(Echo AND TrueFalse);
                    (* NO, preprocessor job *)
        END;
    END;

END IfStmt;

(*----------------------------------------------------------------------*)
(*      PPStmt  -->     DEFINE ID                                       *)
(*----------------------------------------------------------------------*)


PROCEDURE DefStmt;

VAR
    temp: SymTab.SymRecPtr;
    list: SymLists.SymList;
BEGIN

    WITH FSM.Token DO
        IF Class = FSM.M2ID THEN
            temp:=SymTab.LookUp(String);
            IF temp # NIL THEN
                Err.Message(Err.FlagReDefined);
            END;
            SymLists.Create(list);
            SymTab.Insert(String,FALSE,list,list);
        ELSE
            Err.Message(Err.DefXPctdID);
        END;
    END;

END DefStmt;

(*----------------------------------------------------------------------*)
(*      PPStmt  -->     UNDEF  ID                                       *)
(*----------------------------------------------------------------------*)

PROCEDURE UnDefStmt;

VAR
    temp: SymTab.SymRecPtr;

BEGIN

    WITH FSM.Token DO
        IF Class = FSM.M2ID THEN
            temp:=SymTab.LookUp(String);
            IF temp = NIL THEN
                Err.Message(Err.FlagUnDefined);
            ELSE
                SymTab.Delete(String);
            END;
        ELSE
            Err.Message(Err.UnDefXPctdID);
        END;
    END;

END UnDefStmt;

(*----------------------------------------------------------------------*)
(*      PPStmt  -->     MACRO ID[(ID {,ID} ) ] <S> @END                 *)
(*----------------------------------------------------------------------*)

PROCEDURE MacroStmt;

VAR
    temp: SymTab.SymRecPtr;
    args: SymLists.SymList;
    list: SymLists.SymList;
    name: Strings.BigString;
    MacNest: CARDINAL;
    atsign: ARRAY [0..1] OF CHAR;
    OldStrip: BOOLEAN;

BEGIN

    OldStrip:=FSM.StripFlag;
    FSM.StripFlag:=TRUE;
    atsign[0]:='@';
    atsign[1]:=0C;
    MacNest:=0;
    WITH FSM.Token DO
        IF Class = FSM.M2ID THEN
            Strings.Assign(String,name);
            temp:=SymTab.LookUp(String);
            IF temp # NIL THEN
                Err.Message(Err.FlagReDefined);
            END;
            SymLists.Create(list);
            SymLists.Create(args);
            LexAn.GetToken;
            IF Class = FSM.M2LParen THEN
                    (* argument list *)
                GetTokenThenSkipSpace;
                IF Class = FSM.M2ID THEN
                    MacLists.Insert(args,String,Class);
                    GetTokenThenSkipSpace;
                END;
                WHILE Class = FSM.M2Comma DO
                    GetTokenThenSkipSpace;
                    IF Class = FSM.M2ID THEN
                        MacLists.Insert(args,String,Class);
                        GetTokenThenSkipSpace;
                    ELSE
                        Err.Message(Err.MissMacArg);
                    END;
                END;
                IF Class = FSM.M2RParen THEN
                    GetTokenThenSkipSpace;
                ELSE
                    Err.Message(Err.MissMacRP);
                END;
            END;
            LOOP
                WHILE NOT (Class IN FSM.LexSet{FSM.M2AtSign,FSM.M2EOF}) DO
                    MacLists.Insert(list,String,Class);
                    LexAn.GetToken;
                END;
                IF Class=FSM.M2EOF THEN
                    Err.Message(Err.MacNotEnded);
                    EXIT;
                END;
                GetTokenThenSkipSpace;
                CASE Class OF
                FSM.M2ENDM :
                    IF MacNest=0 THEN
                        EXIT;
                    ELSE
                        DEC(MacNest);
                    END;
                |FSM.M2MACRO:
                    INC(MacNest);
                ELSE
                END;
                MacLists.Insert(list,atsign,FSM.M2AtSign);
            END;
            SymLists.Reverse(list);
            SymLists.Reverse(args);
            SymTab.Insert(name,TRUE,list,args);
        ELSE
            Err.Message(Err.MacXPctdID);
        END;
    END;

    FSM.StripFlag:=OldStrip;
END MacroStmt;

(*----------------------------------------------------------------------*)
(*      PPStmt  -->     ID[(<S> {,<S>} ) ]                              *)
(*----------------------------------------------------------------------*)

PROCEDURE MacroExpand;

VAR
    macro : SymTab.SymRecPtr;
    argnam: MacLists.TokRecPtr;
    parens: CARDINAL;               (* for balancing parens *)
    args,newarg,arglst,null: SymLists.SymList;
    exclam, atsign : ARRAY [0..1] OF CHAR;

PROCEDURE AddMacro;
BEGIN
    SymLists.Reverse(newarg);
    IF SymLists.Empty(args) THEN    (* stick it on symtab *)
        Err.Message(Err.TooMany);
    ELSE
        argnam:=SymLists.First(args);
        args:=SymLists.Next(args);
        SymTab.Insert(argnam^.sym^,TRUE,newarg,null);
        SymLists.Insert(arglst,argnam);
        MacLists.Insert(arglst,exclam,FSM.M2KillArg);
    END;
END AddMacro;

BEGIN

    atsign[0]:='@';
    atsign[1]:=0C;
    exclam[0]:='!';
    exclam[1]:=0C;
    WITH FSM.Token DO
        macro:=SymTab.LookUp(String);
        IF macro = NIL THEN
            Err.Message(Err.FlagUnDefined);
        ELSE
            WITH macro^ DO
                IF NOT mac THEN
                    Err.Message(Err.IDNotMacro);
                ELSE
                    LexAn.GetToken;
                    SymLists.Create(arglst);
                    IF Class # FSM.M2LParen THEN
                    (* argument list *)
                        MacLists.Insert(arglst,String,Class);
                    ELSE
                        args:=mca;
                        SymLists.Create(null);
                    (* empty param list for args *)
                        LOOP
                            LexAn.GetToken;
                            SymLists.Create(newarg);
                    (* get an argument *)
                            parens:=0;
                            WHILE Class # FSM.M2Comma DO
                                CASE Class OF
                                FSM.M2AtSign:
                                    GetTokenThenSkipSpace;
                                    IF NOT (Class IN FSM.LexSet{FSM.M2Comma, FSM.M2RParen,
                                    FSM.M2LParen}) THEN
                                        MacLists.Insert(newarg,atsign,FSM.M2AtSign);
                                    END;
                                |FSM.M2LParen:
                                    INC(parens);
                                |FSM.M2RParen:
                                    IF parens > 0 THEN
                                        DEC(parens);
                                    ELSE
                                        EXIT;
                                    END;
                                |FSM.M2EOF:
                                    Err.Message(Err.ArgNotEnded);
                                    EXIT;
                                ELSE
                                END;
                                MacLists.Insert(newarg,String,Class);
                                LexAn.GetToken;
                            END;
                            AddMacro;
                        END;
                        AddMacro;
                    END;
      (* loop *)
                    LexAn.FeedMacro(arglst);
                    (* reminder TO remove bindings *)
                    LexAn.FeedMacro(mcl);
                END;
      (* IF *)
            END;
      (* WITH macro^ *)
        END;
      (* IF *)
    END;
      (* WITH FSM.Token *)

END MacroExpand;

(*----------------------------------------------------------------------*)
(*      PPStmt  -->     INCLUDE String | INCLUDE Str                    *)
(*----------------------------------------------------------------------*)


PROCEDURE IncStmt;

VAR
    oldsrc: FIO.FILE;
    list: SymLists.SymList;
    LPtr: MacLists.TokRecPtr;
    FPath: Strings.BigString;

BEGIN

    oldsrc:=FSM.SourceFile;
    INC(FSM.IncludeLevel);
    list:=IncludeList;
    WITH FSM.Token DO
        IF Class IN FSM.LexSet{FSM.M2Str,FSM.M2String} THEN
            LOOP
                IF SymLists.Empty(list) THEN
                    FIO.WriteString(FIO.OUTPUT,'Could not find include file:  ');
                    FIO.WriteString(FIO.OUTPUT,String);
                    FIO.WriteLn(FIO.OUTPUT);
                    EXIT;
                END;
                LPtr:=SymLists.First(list);
                Strings.Assign(LPtr^.sym^,FPath);
                Strings.Append(String,FPath);
                IF LexAn.SetSourceFile(FPath) THEN
                    Parse;
                    FIO.Close(FSM.SourceFile);
                    EXIT;
                END;
                list:=SymLists.Next(list);
            END;
        ELSE
            Err.Message(Err.MissStr);
        END;
    END;
    DEC(FSM.IncludeLevel);
    FSM.SourceFile:=oldsrc;

END IncStmt;

(*----------------------------------------------------------------------*)
(*      PPStmt  -->     IF <Expr> @THEN <S> { @ELSIF <S> }              *)
(*                      [@ELSE <S>] @END                                *)
(*      PPStmt  -->     DEFINE ID | UNDEF  ID                           *)
(*      PPStmt  -->     INCLUDE String | INCLUDE Str                    *)
(*      PPStmt  -->     MACRO ID[(ID {,ID} ) ] <S> @END                 *)
(*      PPStmt  -->     ID[(<S> {,<S>} ) ]                              *)
(*      PPStmt  -->     LINE | SPACE | STRIP | NOSTRIP                  *)
(*      PPStmt  -->     ',' | '@' | '(' | ')'                           *)
(*----------------------------------------------------------------------*)


PROCEDURE PPStmt(Echo: BOOLEAN);
BEGIN

    WITH FSM.Token DO
        IF Echo THEN
            CASE Class OF
            FSM.M2IF :
                GetTokenThenSkipSpace;
                IfStmt(Echo);
            |FSM.M2DEFINE :
                GetTokenThenSkipSpace;
                DefStmt;
            |FSM.M2UNDEF :
                GetTokenThenSkipSpace;
                UnDefStmt;
            |FSM.M2INCLUDE:
                GetTokenThenSkipSpace;
                IncStmt;
            |FSM.M2MACRO :
                GetTokenThenSkipSpace;
                MacroStmt;
            |FSM.M2ID :
                MacroExpand;
            |FSM.M2STRIP :
                FSM.StripFlag:=TRUE;
            |FSM.M2NOSTRIP:
                FSM.StripFlag:=FALSE;
            |FSM.M2LINE :
                FIO.WriteLn(FSM.DestFile);
            |FSM.M2SPACE :
                FIO.WriteChar(FSM.DestFile,' ');
            |FSM.M2Comma, FSM.M2AtSign, FSM.M2LParen, FSM.M2RParen :
                FIO.WriteChar(FSM.DestFile,String[0]);
            ELSE
                Err.Message(Err.BadPPStmt);
                FIO.WriteString(FSM.DestFile,String);
            END;
        ELSE
            IF Class=FSM.M2IF THEN
                    (* have to parse IF's   *)
                GetTokenThenSkipSpace;
                    (* if if not echoing    *)
                IfStmt(FALSE);
            END;
        END;
    END;
    LexAn.GetToken;

END PPStmt;

(*----------------------------------------------------------------------*)
(*      Stmt    -->     IF | THEN | ELSE ELSIF | END | DEFINE | UNDEF   *)
(*      Stmt    -->     INCLUDE | MACRO | ENDM | AND | OR | NOT | ID    *)
(*      Stmt    -->     STRIP | NOSTRIP | LINE | SPACE                  *)
(*      Stmt    -->     ',' | '(' | ')' | String | ch | Str | Block     *)
(*      Stmt    -->     @ <PPStmt>                                      *)
(*----------------------------------------------------------------------*)

PROCEDURE Stmt(Echo: BOOLEAN);

PROCEDURE StringOut(delim: CHAR);
BEGIN
    FIO.WriteChar(FSM.DestFile,delim);
    FIO.WriteString(FSM.DestFile,FSM.Token.String);
    FIO.WriteChar(FSM.DestFile,delim);
END StringOut;

BEGIN

    WITH FSM.Token DO
        WHILE NOT (Class IN FSM.LexSet{FSM.M2EOF,FSM.M2AtSign}) DO
            IF Echo THEN
                CASE Class OF
                FSM.M2String:
                    StringOut('"');
                |FSM.M2Str:
                    StringOut(47C);
                ELSE
                    FIO.WriteString(FSM.DestFile,String);
                END;
            END;
            LexAn.GetToken;
        END;
      (* POSTCONDITION:  When Stmt exits,     *)
    END;
      (* the current token is either EOF or @ *)

END Stmt;

(*----------------------------------------------------------------------*)
(*      S       -->     { <Stmt> } EOF                                  *)
(*----------------------------------------------------------------------*)

PROCEDURE Parse;

BEGIN

    LexAn.GetToken;
    WITH FSM.Token DO
        WHILE Class # FSM.M2EOF DO
            Stmt(TRUE);
            IF Class = FSM.M2AtSign THEN
                GetTokenThenSkipSpace;
                PPStmt(TRUE);
            END;
        END;
      (* POSTCONDITION:  When Parse exits,    *)
    END;
      (* the current token is EOF             *)

END Parse;

(************************************************************************)


PROCEDURE GetIncludeEnv;

VAR
    IncEnv: ARRAY [0..1023] OF CHAR;
    String: ARRAY [0.. 255] OF CHAR;

BEGIN
    SymLists.Create(IncludeList);
    MacLists.Insert(IncludeList,
(* !!! error, final ' on line expected !!! *)
(* !!! error, "END" expected, NOT "'',FSM.M2ID); (" !!! *)
(* !!! error, "identifier" expected, NOT "'',FSM.M2ID); (" !!! *)
(* !!! error, ";" expected, NOT "'',FSM.M2ID); (" !!! *)
(* !!! error, "END" expected, NOT "'',FSM.M2ID); (" !!! *)
(* !!! error, "identifier" expected, NOT "'',FSM.M2ID); (" !!! *)
(* !!! error, "." expected, NOT "'',FSM.M2ID); (" !!! *)
(* !!! error, END OF file expected, NOT "'',FSM.M2ID); (", FORMATTING STOPS !!! *)
'',FSM.M2ID); (* current directory *)
 Env.GetEnv('M2PInclude',IncEnv);
 WHILE Env.ParseEnv(IncEnv,String) DO
 MacLists.Insert(IncludeList,String,FSM.M2ID);
 END;
 SymLists.Reverse(IncludeList);
END GetIncludeEnv;


BEGIN

 PrintTrace := FALSE;
 GetIncludeEnv;
END Parser.