home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d512 / m2pascal.lha / M2Pascal / src / process.mod < prev    next >
Text File  |  1991-07-20  |  14KB  |  485 lines
  1. IMPLEMENTATION MODULE process;
  2.  
  3. FROM scan               IMPORT STRING,          write,
  4.                                ReadSymbol,      SPACE,           TAB,
  5.                                EolnAhead,       SymbolType,      IndentArray,
  6.                                ReadAheadSymbol, ReadAheadLine,   ReadLine,
  7.                                TooFar;
  8. FROM InOut              IMPORT WriteString,     WriteInt;
  9.  
  10. FROM errors             IMPORT CleanUp,         ErrorMessage,    ErrorType,
  11.                                internal,        FatalError;
  12. FROM IdLookup           IMPORT SearchHash,      IdInfoType,      ProcessType;
  13.  
  14. FROM OutModule          IMPORT output,          identical,       PutBEGIN,
  15.                                AddBlanks,       WriteIndent,     FirstOption,
  16.                                SecondOption;
  17. FROM Strings            IMPORT ConcatString;
  18.  
  19. FROM StandardIO         IMPORT StartsWithWRITE, ProcessWRITE;
  20.  
  21. FROM FunctionProcessing IMPORT IsAFunction,     PopFunctionName, FunctionName;
  22.  
  23. CONST
  24.         DEBUG             =   FALSE;
  25.         CommentCharOff    =   " }" ;
  26.         CommentCharOn     =   "{ " ;
  27. VAR
  28.     InFileSymbol      : STRING;
  29.         SymbolClass       : SymbolType;
  30.         indent            : IndentArray;
  31.         CommentMode       : BOOLEAN;
  32.         CommentBeginCount : CARDINAL;   (*  how many nested commnts  *)
  33.         ModuleUsed        : BOOLEAN;
  34.  
  35.  
  36.  
  37. PROCEDURE out ( symbol : STRING );        
  38. BEGIN
  39.   output ( indent , symbol );
  40. END out;
  41.  
  42.  
  43.  
  44. (* Does this misc. character have anything to do with the start/stop of
  45.     comments?
  46.  *)
  47. PROCEDURE CommentCharacter ( symbol : STRING ) : BOOLEAN;
  48. BEGIN
  49.   RETURN
  50.        identical ( symbol , "(" ) OR
  51.        identical ( symbol , "*" )
  52. END CommentCharacter;
  53.  
  54.  
  55.  
  56. PROCEDURE CheckCommentMode ( symbol : STRING );
  57.  VAR NextSymbol : STRING;  SymbolClass : SymbolType; dummy : BOOLEAN;
  58. BEGIN
  59.     ReadAheadSymbol ( NextSymbol, SymbolClass );
  60.  
  61.     IF ( ( identical( symbol     , "*"  ) ) AND 
  62.          ( identical( NextSymbol , ")"  ) ) ) THEN
  63.                
  64.                 DEC ( CommentBeginCount , 1 );
  65.                 IF ( CommentBeginCount <= 0 ) THEN    (* not nested *)
  66.                         IF ( CommentBeginCount < 0 ) THEN 
  67.                           CommentBeginCount  := 0;
  68.                         END;
  69.             CommentMode := FALSE;
  70.                         IF DEBUG THEN
  71.                           WriteString("CheckCommentMode.CommentMode is OFF\n");
  72.                         END;
  73.                 END;
  74.                 ReadSymbol ( NextSymbol, SymbolClass );
  75.                 out ( CommentCharOff );
  76.  
  77.     ELSIF ( ( identical( symbol     , "("  ) ) AND 
  78.             ( identical( NextSymbol , "*"  ) ) ) THEN
  79.  
  80.                 IF DEBUG THEN 
  81.                        WriteString("CheckCommentMode.CommentMode is ON\n");
  82.                 END;
  83.                 CommentMode := TRUE;
  84.                 INC ( CommentBeginCount , 1 );
  85.                 ReadSymbol ( NextSymbol, SymbolClass );
  86.                 out ( CommentCharOn );
  87.    ELSE
  88.                 out ( symbol );
  89.    END;
  90.  
  91. END CheckCommentMode;
  92.  
  93.  
  94.  
  95. PROCEDURE processable ( symbol       : STRING;
  96.                         SymbolClass  : SymbolType ) : BOOLEAN;
  97. BEGIN
  98.         RETURN    (  ( SymbolClass = identifier )        OR
  99.                    ( ( SymbolClass = other  ) AND 
  100.                      ( NOT identical ( symbol , "(" ) ) )) AND 
  101.                      ( NOT CommentMode            ) ;
  102. END processable;
  103.  
  104.  
  105.  
  106. PROCEDURE ProcessPROCEDURE();
  107. BEGIN
  108.         IF DEBUG THEN
  109.               WriteString ("PROCEDURE encountered\n");
  110.         END;
  111.  
  112.     IF ( NOT IsAFunction () ) THEN
  113.                out ( "procedure" );
  114.         ELSE
  115.                out ( "function" );
  116.         END;
  117. END ProcessPROCEDURE;
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124. PROCEDURE ProcessRETURN;
  125.  VAR name : STRING;
  126. BEGIN
  127.         IF DEBUG THEN
  128.               WriteString ("RETURN encountered\n");
  129.         END;
  130.  
  131.         FunctionName ( name );
  132.         out ( name );   out ( " := " );
  133. END ProcessRETURN;
  134.  
  135.  
  136.  
  137.  
  138. PROCEDURE ProcessMODULE ();
  139.  VAR    symbol : STRING;     SymbolClass : SymbolType;
  140. BEGIN
  141.       IF NOT ModuleUsed THEN
  142.            ModuleUsed := TRUE;
  143.            out ( "program" );
  144.            ReadSymbol ( symbol, SymbolClass );
  145.            IF ( SymbolClass = blanks ) THEN
  146.                   out ( symbol );
  147.                   ReadSymbol ( symbol, SymbolClass );
  148.            END;
  149.  
  150.            IF ( SymbolClass = identifier ) THEN
  151.                   out ( symbol );
  152.                   out ( " ( input, output )" );
  153.            ELSE
  154.                   ErrorMessage ( NoProgramName );
  155.            END;
  156.       ELSE
  157.            ErrorMessage ( MultipleModule );
  158.            out ( "MODULE" );
  159.       END;
  160. END ProcessMODULE;
  161.  
  162.  
  163.  
  164.  (* "THEN" is changed automatically to "then begin"
  165.     where the position of "begin" is determined by PutBEGIN.     
  166.  *)
  167. PROCEDURE ProcessTHEN () ;
  168. BEGIN
  169.      IF DEBUG THEN
  170.           WriteString ("THEN encountered\n");
  171.      END;
  172.  
  173.      out ( "then" );
  174.      PutBEGIN ( indent );
  175. END ProcessTHEN;
  176.  
  177.  
  178.  
  179.  (* DO => do begin
  180.     This is used for WITH, FOR, WHILE.
  181.   *)
  182. PROCEDURE ProcessDO ();
  183. BEGIN
  184.    out      ( "do" );
  185.    PutBEGIN ( indent );
  186. END ProcessDO;
  187.  
  188.  
  189.  
  190.  (* An END statement has been found, is it followed by an identifier?
  191.     Is the identifier followed by an "." or ";" ?    This procedure
  192.     deals with the above situations.
  193.  *)
  194. PROCEDURE ProcessEND ();
  195. BEGIN
  196.       IF DEBUG THEN
  197.          WriteString ("An END has been encountered\n");
  198.       END;
  199.  
  200.       out ( "end" );
  201.  
  202.       ReadSymbol ( InFileSymbol, SymbolClass );    
  203.       IF ( SymbolClass = blanks ) THEN
  204.           ReadSymbol   ( InFileSymbol, SymbolClass );    
  205.       END;
  206.  
  207.        (* identifier after END if it's there *)
  208.       IF ( SymbolClass = identifier ) THEN
  209.           PopFunctionName ( InFileSymbol );   (* potential end of function *)
  210.           ReadSymbol      ( InFileSymbol, SymbolClass );         
  211.       END;      
  212.  
  213.       IF ( SymbolClass = blanks ) THEN
  214.           out        ( InFileSymbol );
  215.           ReadSymbol ( InFileSymbol, SymbolClass );    
  216.       END;
  217.  
  218.        (*   ";' or "."  *)
  219.       out ( InFileSymbol );
  220.             
  221. END ProcessEND;
  222.  
  223.  
  224.  
  225.  (* "ELSE" => "end\n else begin"                  ( the latter is true for a 
  226.                                                     case statement )
  227.  *)
  228. PROCEDURE ProcessELSE ();
  229. BEGIN
  230.      out ( "end\n");
  231.      WriteIndent ( indent );
  232.      out ( "else" );
  233.      PutBEGIN ( indent );
  234. END ProcessELSE;
  235.  
  236.  
  237.  
  238.  (* Case statement not translated correctly ( at all ) in this version
  239.  *)
  240. PROCEDURE ProcessCASE ();
  241. BEGIN
  242.       WriteString (" Keyword CASE encountered. Warning: This version\n");
  243.       WriteString ("    requires manual conversion of CASE statements\n");
  244.       out ("\n     {*****************************************************\n");
  245.       out ("      * DELETE THESE 6 LINES AFTER CONVERTING CASE        *\n");
  246.       out ("      * STATEMENT BELOW MANUALY.                          *\n");
  247.       out ("      *      - Erase end before final else ( if present ). *\n");
  248.       out ("      *      - Place a 'begin' after each colon.           *\n");
  249.       out ("      *****************************************************}\n");
  250.  
  251.       WriteIndent ( indent );
  252.       out ( "case" );
  253. END ProcessCASE;
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  (* handles ALLOCATE/DEALLOCATE and converts to new/dispose
  260.  *)
  261. PROCEDURE ProcessAllocation ( symbol : STRING );
  262.  VAR s : STRING;
  263. BEGIN
  264.    IF ( identical ( symbol , "ALLOCATE" ) ) THEN
  265.         out ( "new" );
  266.    ELSE
  267.         out ( "dispose" );
  268.    END;
  269.  
  270.     (* clone everything until we are after the left parenth *)
  271.    ReadSymbol ( InFileSymbol, SymbolClass );    
  272.    WHILE ( NOT identical ( InFileSymbol , "(" ) ) DO
  273.         out        ( InFileSymbol );
  274.         ReadSymbol ( InFileSymbol, SymbolClass );    
  275.    END;
  276.    out ( InFileSymbol );
  277.  
  278.    FirstOption  ( s );
  279.    out          (  s  );
  280.    out          ( ")" );
  281.    SecondOption ( s );
  282. END ProcessAllocation;
  283.  
  284.  
  285.  (* handles INC/DEC.    Ex:   INC ( i , 1 )  =>  i := i + 1
  286.  *)
  287. PROCEDURE ProcessAutoInc ( symbol : STRING );
  288.  VAR s1 , s2 : STRING;
  289. BEGIN
  290.    (* blanks between comnd and par? *)
  291.   AddBlanks    ( InFileSymbol );  (* toss away *)
  292.  
  293.    (* left par *)
  294.   ReadSymbol ( InFileSymbol, SymbolClass );    
  295.  
  296.    (* first option *)   
  297.   FirstOption ( s1 );
  298.   out ( s1 );
  299.   out ( " := " );
  300.   out ( s1 );
  301.  
  302.   IF ( identical ( symbol , "INC" ) ) THEN
  303.        out ( " + " );      
  304.   ELSE (* DEC *)
  305.        out ( " - " );
  306.   END;
  307.  
  308.   SecondOption ( s2 );  
  309.  
  310.   IF ( identical ( s2 , "" ) ) THEN
  311.        out ( "1" );
  312.   ELSE
  313.        out ( s2 );
  314.   END;
  315.  
  316. END ProcessAutoInc;
  317.  
  318.  
  319. PROCEDURE ProcessPOINTER ();
  320. BEGIN
  321.       IF DEBUG THEN
  322.          WriteString ("The keyword POINTER has been encountered\n");
  323.       END;
  324.       AddBlanks    ( InFileSymbol );  (* toss away *)
  325.       ReadSymbol   ( InFileSymbol, SymbolClass );    
  326.       AddBlanks    ( InFileSymbol );  (* toss away *)
  327.       out ( "^" );
  328. END ProcessPOINTER;
  329.  
  330.  
  331.  
  332.  (* Check for end of "FROM blah IMPORT blah, blah" block of lines
  333.  *)
  334. PROCEDURE StopSkipping () : BOOLEAN;
  335. BEGIN
  336.    RETURN ( identical ( InFileSymbol , "CONST" )       OR
  337.             identical ( InFileSymbol , "VAR" )         OR
  338.             identical ( InFileSymbol , "BEGIN"  )      OR
  339.             identical ( InFileSymbol , "PROCEDURE"  )  OR 
  340.             identical ( InFileSymbol , "TYPE"  )   
  341.           );
  342. END StopSkipping;
  343.  
  344.  
  345.  
  346. PROCEDURE SkipImportData ();
  347.  VAR good : BOOLEAN;
  348. BEGIN
  349.       IF DEBUG THEN
  350.          WriteString ("The keyword FROM has been encountered\n");
  351.       END;
  352.  
  353.       good            := ReadAheadLine   ( indent );
  354.       ReadAheadSymbol ( InFileSymbol, SymbolClass );
  355.  
  356.       WHILE ( NOT StopSkipping() ) DO
  357.          IF EolnAhead () THEN
  358.              good   := ReadLine        ( indent );
  359.              good   := ReadAheadLine   ( indent );
  360.          END;
  361.          ReadAheadSymbol ( InFileSymbol, SymbolClass );         
  362.       END;
  363. END SkipImportData;
  364.  
  365.  
  366.  
  367.  (* The symbol has been identified as being "special" meaning that it needs
  368.     special processing ( verses a simple "exchange" ).
  369.  *)
  370. PROCEDURE ProcessCodeIsSpecial ( symbol : STRING      );
  371. BEGIN
  372.  
  373.     IF  identical ( symbol , "THEN" )  THEN
  374.           ProcessTHEN ();
  375.     ELSIF identical ( symbol , "END" )   THEN
  376.          ProcessEND ();
  377.     ELSIF identical ( symbol , "ELSE" ) THEN
  378.          ProcessELSE ();
  379.     ELSIF StartsWithWRITE ( symbol ) THEN
  380.          ProcessWRITE ( indent, symbol );
  381.     ELSIF identical ( symbol , "DO" )  THEN
  382.          ProcessDO ();
  383.     ELSIF identical ( symbol , "FROM" )  THEN
  384.          SkipImportData ();
  385.     ELSIF identical  ( symbol , "MODULE" )  THEN
  386.          ProcessMODULE ();
  387.     ELSIF identical ( symbol , "PROCEDURE" ) THEN
  388.          ProcessPROCEDURE ();
  389.     ELSIF identical ( symbol , "RETURN" ) THEN
  390.          ProcessRETURN ();
  391.     ELSIF identical ( symbol , "POINTER" ) THEN  
  392.          ProcessPOINTER ();
  393.     ELSIF identical ( symbol , "CASE" ) THEN
  394.          ProcessCASE ();
  395.     ELSIF identical ( symbol , "ALLOCATE" ) THEN
  396.          ProcessAllocation ( symbol );
  397.     ELSIF identical ( symbol , "DEALLOCATE" ) THEN
  398.          ProcessAllocation ( symbol );
  399.     ELSIF identical ( symbol , "INC" ) THEN
  400.          ProcessAutoInc ( symbol );
  401.     ELSIF identical ( symbol , "DEC" ) THEN
  402.          ProcessAutoInc ( symbol );
  403.     ELSIF identical ( symbol , "" ) THEN        (*    future ....   *)
  404.     ELSIF identical ( symbol , "" ) THEN
  405.     ELSIF identical ( symbol , "" ) THEN
  406.     ELSE
  407.           internal ( "process.Keyword listed as SPECIAL not found");
  408.     END;
  409.  
  410. END ProcessCodeIsSpecial;
  411.  
  412.  
  413.  
  414.  
  415. PROCEDURE ProcessCodeIsNoSupport ( symbol : STRING );
  416. BEGIN
  417.    ErrorMessage ( NoSupportGeneric );
  418.    IF      identical ( symbol , "DEFINITION" )     THEN
  419.                      FatalError ( NoSupportDEFINITION );
  420.    ELSIF   identical ( symbol , "IMPLEMENTATION" ) THEN
  421.                      FatalError ( NoSupportIMPLEMENTATION );
  422.    ELSIF   identical ( symbol , "LOOP" )           THEN
  423.                      WriteString ("LOOP keyword is unsupported\n");
  424.    ELSE
  425.            internal ( "process.mod:ProcessCodeIsNoSupport has unknown code" );
  426.    END;
  427. END ProcessCodeIsNoSupport;
  428.  
  429.  
  430.  
  431.  
  432. (*
  433.    Here's the meat of the whole program. This procedure will take one symbol
  434.    and related information as input and then output one or more symbols. Sounds
  435.    pretty simple, huh? If a simple substitute is not possible further
  436.    processing will take place. If the algorithm does not recognize the string
  437.    given to it then it just writes it to output, unchanged.
  438. *)
  439. PROCEDURE ProcessSymbol(    Indent      : IndentArray;
  440.                             symbol      : STRING;
  441.                             SymbolClass : SymbolType   );
  442.  
  443.  
  444.  VAR    IdInfo  : IdInfoType;   
  445. BEGIN
  446.    indent := Indent;   (* global *)
  447.  
  448.     (* symbol is an identifier/other and we are not in comment mode *)
  449.    IF processable ( symbol , SymbolClass ) THEN
  450.        IF SearchHash ( IdInfo, symbol ) THEN
  451.            IF ( IdInfo.ProcessCode = exchange ) THEN
  452.                 out ( IdInfo.ExchangeString );
  453.            ELSIF ( IdInfo.ProcessCode = special ) THEN
  454.                 ProcessCodeIsSpecial ( symbol );              
  455.            ELSIF ( IdInfo.ProcessCode = NoSupport ) THEN
  456.                 ProcessCodeIsNoSupport ( symbol );
  457.            ELSE
  458.                 internal ( "Unknown process code sent from IdLookup");
  459.            END;
  460.        ELSE
  461.            out ( symbol );
  462.        END;
  463.  
  464.     (* word wasn't an identifier or we're in comment mode   *)
  465.    ELSE
  466.            IF NOT CommentCharacter ( symbol ) THEN
  467.                 out ( symbol );
  468.            ELSE
  469.                  (* Change into or out of comment mode if the need be *)
  470.                 CheckCommentMode ( symbol );
  471.            END;
  472.  
  473.    END;
  474. END ProcessSymbol;
  475.  
  476.  
  477.  
  478.  
  479.  
  480. BEGIN (* main *)
  481.    CommentMode       :=   FALSE;
  482.    CommentBeginCount :=   0;     (* nested comments *)
  483.    ModuleUsed        :=   FALSE;
  484. END process.
  485.