home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d512 / m2pascal.lha / M2Pascal / src / StandardIO.mod < prev   
Text File  |  1991-07-20  |  10KB  |  331 lines
  1. IMPLEMENTATION MODULE StandardIO ;
  2.  (* 
  3.    These routines provide support for modula-2 procecedures intended
  4.    for Standard I/O. ( For example the procedure "WriteString" from
  5.    the module InOut ).
  6.  
  7.    Note: All modula-2 procedures with 'read' in them ( ReadString etc..)
  8.    are not included here. These are translated automaticaly by simple
  9.    substitution.
  10.  *)
  11.  
  12.  
  13. FROM InOut       IMPORT  WriteString;
  14.  
  15. FROM OutModule   IMPORT  output,            AddBlanks,          identical;
  16.  
  17. FROM Strings     IMPORT  ConcatString,      ExtractSubString,   InsertSubString;
  18.  
  19. FROM scan        IMPORT  STRING,            IndentArray,
  20.                          ReadSymbol,        ReadAheadSymbol,    SymbolType,
  21.                          HitABrickWall;
  22. FROM errors      IMPORT  ErrorType,         ErrorMessage;
  23.  
  24.  
  25. CONST 
  26.         DEBUG           =   FALSE;
  27.     SLASH           =   134C;
  28.  
  29. VAR
  30.         indent          :   IndentArray;
  31.         ObjectString    :   STRING;
  32.         StringIndex     :   CARDINAL;
  33.         InFileSymbol    :   STRING;
  34.         SymbolClass     :   SymbolType;
  35.         i               :   CARDINAL;
  36.         ch              :   CHAR;
  37.  
  38.  
  39.  (* Symbol read in from file starts with the chars "Write"
  40.  *)
  41. PROCEDURE StartsWithWRITE ( symbol : STRING ) : BOOLEAN;
  42.  VAR FirstFiveChars : STRING;
  43. BEGIN
  44.     ObjectString     := "\0";
  45.     ExtractSubString ( FirstFiveChars ,  symbol , 0 , 5 );
  46.     RETURN identical ( "Write" , FirstFiveChars );
  47. END StartsWithWRITE;
  48.  
  49.  
  50.   (* Example:
  51.            WriteInt ( a , 1 );
  52.                      ^^^^
  53.                         Read this.
  54.  
  55.     Sucks in the comma and ignores it.
  56.   *)
  57. PROCEDURE ReadUntilComma ();
  58. BEGIN
  59.     ReadSymbol   ( InFileSymbol,SymbolClass );
  60.  
  61.     WHILE ( NOT identical ( InFileSymbol,  "," ) ) DO
  62.          ConcatString ( ObjectString, InFileSymbol );             
  63.          ReadSymbol   ( InFileSymbol, SymbolClass );
  64.     END;
  65. END ReadUntilComma;
  66.  
  67.  
  68.  
  69.  (* Process supported statement beginning with "write" such as "WriteInt".
  70.     This procedure should NOT be used with "WriteString".
  71.     The following statements are supported:
  72.           WriteInt,
  73.           WriteOct,
  74.           WriteWrd,
  75.           WriteCard,
  76.           WriteHex.
  77.     Translation in this version is simple and mimics the following example:
  78.            WriteInt ( number , 1 )   ==>    writeln ( number )
  79.            
  80.            ( The number after the comma is always ignored )
  81.  *)
  82. PROCEDURE ProcessGenericWrite ( symbol : STRING );
  83. BEGIN
  84.         ConcatString ( ObjectString, "writeln" );
  85.         AddBlanks    ( ObjectString );
  86.         ReadSymbol   ( InFileSymbol, SymbolClass );
  87.         IF ( identical ( InFileSymbol , "("  )  )THEN
  88.               ConcatString ( ObjectString , InFileSymbol );
  89.               ReadUntilComma ();
  90.  
  91.                   (* ignore everything after the comma and send it to the
  92.                      big black hole in the ram
  93.                   *)
  94.                  WHILE  ( NOT ( HitABrickWall () ) AND
  95.                         ( NOT   identical     ( InFileSymbol, ")" ) )   )   DO
  96.                        ReadSymbol ( InFileSymbol , SymbolClass );
  97.                  END;
  98.                  IF ( identical ( InFileSymbol , ")" )  ) THEN
  99.                      ConcatString ( ObjectString, InFileSymbol );
  100.                      output ( indent, ObjectString );
  101.                      IF DEBUG THEN 
  102.                           WriteString ("ProcessWRITE exited: ");
  103.                           WriteString ( ObjectString ); WriteString("\n") ;
  104.                      END;
  105.                  ELSE
  106.                     ErrorMessage ( WriteStatement );    
  107.                 END;
  108.         ELSE
  109.                     ErrorMessage ( WriteStatement );                  
  110.         END;
  111.  
  112. END ProcessGenericWrite;
  113.  
  114.  
  115.  
  116.  
  117. PROCEDURE quote () : BOOLEAN;
  118. BEGIN
  119.     RETURN (  ch = '"' ) OR
  120.            (  ch = "'" ) ;
  121. END quote;
  122.  
  123.  
  124.  
  125.  
  126. PROCEDURE NextCh ();
  127. BEGIN
  128.         INC ( i , 1 );
  129.         ch  :=  InFileSymbol [ i ];
  130. END NextCh;
  131.  
  132.  
  133.  
  134.  
  135. PROCEDURE AddCh ( OneLetter : CHAR );
  136.  VAR symbol : STRING;
  137. BEGIN
  138.        symbol [ 0 ] := OneLetter;
  139.        symbol [ 1 ] := "\0";
  140.        ConcatString ( ObjectString , symbol );        
  141. END AddCh;
  142.  
  143.  
  144.  
  145.  
  146. PROCEDURE InsertWriteln ();
  147. BEGIN
  148.      InsertSubString ( ObjectString , "writeln" , 0 );
  149. END InsertWriteln;
  150.  
  151.  
  152.  
  153.  
  154. PROCEDURE InsertWrite ();
  155. BEGIN
  156.      InsertSubString ( ObjectString , "write" , 0 );
  157. END InsertWrite;
  158.  
  159.  
  160.  
  161.  
  162.  (* Do the actual translation of "\n" instances.
  163.     Symbol is in string "InFileSymbol".
  164.  *)
  165. PROCEDURE ProcessWriteStringToEnd ();
  166.  VAR   SingleNewLine, DataEnd : BOOLEAN ;
  167. BEGIN
  168.     i             := 1;
  169.     DataEnd       := FALSE;  (* Checks indirectly for an empty string ""   *)
  170.     SingleNewLine := TRUE;  (* Flags that output should be 'writeln'      *)
  171.     AddCh ( "'" );    (* change ' to "  *)
  172.  
  173.  
  174.     ch := InFileSymbol [ 1 ];
  175.  
  176.     WHILE  ( NOT ( quote ()  )  ) DO
  177.         IF ( ch = SLASH  ) THEN
  178.            NextCh ();
  179.            IF ( ch =  SLASH  )  THEN    (* 2 slashes in a row *)
  180.                 SingleNewLine   :=  FALSE;
  181.                 AddCh ( ch );
  182.            ELSIF ( ch = 'n' ) THEN
  183.                 IF ( NOT SingleNewLine ) THEN
  184.                     (* Close off statmnt *)
  185.                    ConcatString ( ObjectString , "'); " ); 
  186.                 ELSE
  187.                    ObjectString := "\0";
  188.                    AddCh ( ";" );
  189.                 END;
  190.                  
  191.                 SingleNewLine := TRUE;
  192.                 InsertWriteln ();
  193.                 output ( indent , ObjectString );
  194.                 ObjectString := "\0" ;                  (* Setup new string *)
  195.                 ConcatString ( ObjectString , "('" );
  196.  
  197.                 NextCh ();  DEC ( i , 1 );  (* look ahead *)
  198.                 IF ( ( ch =   '"'  ) OR 
  199.                      ( ch =   "'"  ) )   THEN
  200.                            DataEnd  := TRUE;
  201.                 END;
  202.            END;
  203.         ELSE
  204.            (* ch <> slash *)
  205.            AddCh ( ch );
  206.            SingleNewLine  := FALSE;       
  207.         END;
  208.  
  209.         NextCh ();
  210.     END;
  211.  
  212.     IF ( NOT DataEnd ) THEN
  213.          AddCh ( "'" );     (* second quote *)
  214.          AddBlanks    (  ObjectString );
  215.          ReadSymbol   ( InFileSymbol , SymbolClass );
  216.          IF ( identical (  InFileSymbol, ")" )  )THEN
  217.                      AddCh ( ")" );
  218.          ELSE
  219.                      ErrorMessage ( WriteStatement );
  220.          END;     
  221.     
  222.          InsertWrite ();
  223.          output ( indent , ObjectString );
  224.     ELSE
  225.          (* The statement has an empty string-> DON'T output it *)
  226.          AddBlanks ( ObjectString );
  227.          ReadSymbol   ( InFileSymbol , SymbolClass );
  228.          IF ( identical ( InFileSymbol, ")" ) ) THEN 
  229.                      AddBlanks ( ObjectString );
  230.                      ReadSymbol   ( InFileSymbol , SymbolClass );
  231.                      IF ( NOT identical ( InFileSymbol , ";" )  ) THEN
  232.                          ErrorMessage ( WriteStatement );           
  233.                      END;
  234.          ELSE
  235.                      ErrorMessage ( WriteStatement );
  236.          END;
  237.     END;
  238.  
  239. END ProcessWriteStringToEnd;
  240.  
  241.  
  242.  
  243.  (* This is used to process a WriteString that has an identifier-type string
  244.     contained between the paranthesis. ( vs a quoted phrase ) This option
  245.     is not part of standard ISO pascal and the compiler will barf it up
  246.     if it's a bare-bones system.
  247.  *)
  248. PROCEDURE ProcessWriteStringIdentifier ();
  249. BEGIN
  250.      InsertWrite ();
  251.      ConcatString ( ObjectString , InFileSymbol );          (* identifier *)
  252.      AddBlanks (  ObjectString );
  253.      ReadSymbol (  InFileSymbol, SymbolClass );
  254.      IF ( identical ( InFileSymbol , ")" )  ) THEN
  255.               ConcatString ( ObjectString , ")" );
  256.               AddBlanks  ( ObjectString );
  257.               ReadSymbol ( InFileSymbol, SymbolClass );
  258.               IF ( identical ( InFileSymbol, ";" ) ) THEN
  259.                   ConcatString ( ObjectString , ";" );
  260.                   output ( indent, ObjectString  );
  261.               ELSE
  262.                   ErrorMessage ( WriteStatement );
  263.               END;
  264.      ELSE
  265.                   ErrorMessage ( WriteStatement );
  266.      END;
  267. END  ProcessWriteStringIdentifier ;
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  (* Process the statement "WriteString". Convert all instances of "\n" 
  275.     to writeln statements. ( Otherwise they are "write" statements ).
  276.     All data after the actual WriteString statement is read into the
  277.     ObjectString first. Then if a '\n' is detected the string "writeln"
  278.     is inserted in front of the ObjectString data. If no '\n' is detected
  279.     then the string "write" is inserted in front.
  280.  *)
  281. PROCEDURE ProcessWriteString ();
  282. BEGIN
  283.       AddBlanks  ( ObjectString );
  284.       ReadSymbol ( InFileSymbol , SymbolClass );
  285.       IF (  identical ( InFileSymbol ,  "("  )  ) THEN
  286.           AddCh ( "(" );
  287.           AddBlanks ( ObjectString );
  288.           ReadSymbol ( InFileSymbol, SymbolClass );
  289.  
  290.           IF    ( SymbolClass = literal ) THEN
  291.                   ProcessWriteStringToEnd ();
  292.           ELSIF ( SymbolClass = identifier ) THEN
  293.                   ProcessWriteStringIdentifier ();
  294.           ELSE
  295.                   ErrorMessage ( WriteStatement );
  296.           END;
  297.       ELSE
  298.               ErrorMessage ( WriteStatement );
  299.       END;
  300. END ProcessWriteString;
  301.  
  302.  
  303.  
  304.  
  305.  
  306.  (* Symbol started with the characters "write"
  307.  *)
  308. PROCEDURE ProcessWRITE ( Indent  : IndentArray;
  309.                           symbol : STRING );
  310. BEGIN
  311.     IF DEBUG THEN 
  312.              WriteString("ProcessWRITE entered. Symbol is : ");
  313.              WriteString( symbol ); WriteString("\n");
  314.     END;
  315.  
  316.     indent := Indent;    (* global *)
  317.     ObjectString := "\0";
  318.  
  319.     IF identical ( "WriteString" , symbol ) THEN
  320.         ProcessWriteString ();
  321.     ELSE
  322.         ProcessGenericWrite ( symbol );
  323.     END;
  324.  
  325. END ProcessWRITE;
  326.  
  327.  
  328. BEGIN
  329.     StringIndex    :=  0;
  330. END StandardIO.
  331.