IMPLEMENTATION MODULE Streams;

FROM Conversions IMPORT IntConversions, RealConversions;
FROM Directories IMPORT Operations;
IMPORT SYSTEM;
IMPORT String;

INLINE
  %#include <stdio.h>
  %#include <assert.h>
  %#include <stdlib.h>
  %#include <string.h>
  %
  %#define MAXFILES 200
  %#define BUFFER_SIZE 4096
  %/* The following constants are not present in every system !*/
  %#ifndef SEEK_SET
  %#define SEEK_SET 0
  %#define SEEK_CUR 1
  %#define SEEK_END 2
  %#endif
  %
  %#ifdef YAFL_MICROSOFT
  %#define fileno _fileno
  %#endif
  END;

    CLASS Stream;
      VAR
        ErrCode: INTEGER;
              TheF: INTEGER;

      REDEFINE METHOD CREATE;
        BEGIN
        END CREATE;

      METHOD File: INTEGER;
        BEGIN
        RESULT := TheF;
        END File;

      METHOD SetFile (Nr: INTEGER);
        BEGIN
        TheF := Nr;
        END SetFile;

      METHOD ErrorCode: INTEGER;
        BEGIN
        RESULT := ErrCode;
        END ErrorCode;

      METHOD SetErrorCode (Code: INTEGER);
        BEGIN
        ErrCode := Code;
        END SetErrorCode;

      METHOD Open (FName: ARRAY OF CHAR;
                   Access: INTEGER);
        BEGIN
        ASSERT TheF = 0;
        CASE Access OF
          ReadAccess:
            INLINE
              % THIS->Y_TheF = (yint) fopen(Y_FName, "r");
              END;
            END;
          ReadWriteAccess:
            INLINE
              % THIS->Y_TheF = (yint) fopen(Y_FName, "w");
              END;
            END;
          AppendAccess:
            INLINE
              % THIS->Y_TheF = (yint) fopen(Y_FName, "a+");
              END;
            END;
         ELSE
          ASSERT FALSE;
          END;
        IF TheF <> 0 THEN
          SetFile (TheF);
          ErrCode := NoError;
         ELSE
          ErrCode := FileNotFoundError;
          END;
        END Open;

      METHOD Create(FName: ARRAY OF CHAR;
                    Access: INTEGER);
        BEGIN
        ASSERT TheF = 0;
	ASSERT FName <> VOID;
        CASE Access OF
          ReadWriteAccess, WriteAccess:
            INLINE
              % THIS->Y_TheF = (yint) fopen(Y_FName, "w");
              END;
            END;
          AppendAccess:
            INLINE
              % THIS->Y_TheF = (yint) fopen(Y_FName, "a+");
              END;
            END;
         ELSE
          ASSERT FALSE;
          END;
        IF TheF <> 0 THEN
          SetFile (TheF);
          ErrCode := NoError;
         ELSE
          ErrCode := FileNotFoundError;
          END;
        END Create;
        
      METHOD GetFileHandle : INTEGER;
      BEGIN
      INLINE        
        %#ifndef OS2
        %#ifndef MVS
        %Y_RESULT = fileno ((FILE *) (THIS->Y_TheF));
        %#endif
        %#endif
        END;
      END GetFileHandle;
        
      METHOD SetFileHandle (Handle : INTEGER;
                            Access : INTEGER);
      BEGIN
      IF TheF = 0 THEN
        CASE Access OF
          ReadAccess:
            INLINE
              % #ifdef UNIX
              % THIS->Y_TheF = (yint) fdopen(Y_Handle, "r");
              % #else
              % assert (0);
              % #endif
              END;
            END;
          ReadWriteAccess, WriteAccess:
            INLINE
              % #ifdef UNIX
              % THIS->Y_TheF = (yint) fdopen(Y_Handle, "w");
              % #else
              % assert (0);
              % #endif
              END;
            END;
          AppendAccess:
            INLINE
              % #ifdef UNIX
              % THIS->Y_TheF = (yint) fdopen(Y_Handle, "a+");
              % #else
              % assert (0);
              % #endif
              END;
            END;
          END;
        IF TheF <> 0 THEN
          SetFile (TheF);
          ErrCode := NoError;
         ELSE
          ErrCode := FileNotFoundError;
          END;
       ELSE
        ErrCode := AlreadyOpenFileError;
        END;
      END SetFileHandle;
      
      METHOD Close;
        BEGIN
        ASSERT (TheF <> 0);
        INLINE
          %fclose ((FILE*)(THIS->Y_TheF));
          END;
        SetFile(0);
        END Close;
        
      REDEFINE METHOD KILL;
        BEGIN
        IF TheF <> 0 THEN
          Close;
          ASSERT TheF = 0;
          END;
        END KILL;

      METHOD Length: INTEGER;
        BEGIN
        ASSERT (TheF <> 0);
        INLINE
          %{
          % long l;
          % FILE *p;
          %
          % p = (FILE*) THIS->Y_TheF;
          % l = ftell(p);
          % fseek(p, 0L, SEEK_END);
          % Y_RESULT = ftell(p);
          % fseek(p, l, SEEK_SET);
          %}
          END;
        END Length;

      METHOD Where: INTEGER;
        BEGIN
        ASSERT (TheF <> 0);
        INLINE
          %Y_RESULT = ftell((FILE*) THIS->Y_TheF);
          END;
        END Where;

      METHOD Goto(Position: INTEGER);   
        VAR
          Pos: INTEGER;
        BEGIN          
        ASSERT (TheF <> 0);
        Pos := Position;
        INLINE
          % fseek((FILE*) THIS->Y_TheF, Y_Pos, SEEK_SET);
          END;
        END Goto;

      METHOD WriteBuffer(Data: ARRAY OF CHAR);
        BEGIN
        WriteSlice (Data, 0, Data.SIZE);
        END WriteBuffer;

      METHOD WriteSlice (Data: ARRAY OF CHAR;
                         From, Len: INTEGER);
        BEGIN
        ASSERT TheF <> 0;
        ASSERT Data <> VOID;
        ASSERT From >= 0;
        ASSERT Len >= 0;
        ASSERT From + Len <= Data.SIZE;
        INLINE
          % {
          %   char *p, *q;
          %   int  i;
          %
          %   p = (char *) Y_Data + Y_From;
          %   /* Checking whether the buffer contains a Zero 
          %   q=p;
          %   for (i=0; i<Y_Len; i++)
          %     {
          %     assert(*q);
          %     q++;
          %     }   */
          %   fwrite(p, 1, Y_Len, (FILE *) THIS->Y_TheF);
          % }
          END;
        END WriteSlice;

      METHOD ReadBuffer(Buffer: ARRAY OF CHAR;
                        Count: INTEGER): INTEGER;
        BEGIN
        ASSERT TheF <> 0;
        ASSERT Buffer <> VOID;
        ASSERT Count <= Buffer.SIZE;
        INLINE
          % Y_RESULT = fread(Y_Buffer, (size_t)1, (size_t)Y_Count,
          %                  (FILE*) THIS->Y_TheF);
          END;
        END ReadBuffer;
        
      METHOD Flush;
        BEGIN
        ASSERT TheF <> 0;
        INLINE
          % fflush((FILE*) THIS->Y_TheF);
          END;
        END Flush;

    END Stream;

-----------------------------------------------------------------
    CLASS InputStream;
       INHERITS Stream;
         VAR
           TheF: INTEGER;
           
         REDEFINE METHOD Create (FName: ARRAY OF CHAR;
                                 Access: INTEGER);
           BEGIN
           ASSERT FALSE;
           END Create;
                                            
         REDEFINE METHOD WriteSlice (Data: ARRAY OF CHAR;
                                     From, Len: INTEGER);
           BEGIN          
           ASSERT FALSE;
           END WriteSlice;                                            
           
         REDEFINE METHOD SetFile(Nr: INTEGER);
           BEGIN
           BASE(Nr);
           TheF := Nr;
           END SetFile;
           
         METHOD ReadChar: CHAR;
           BEGIN
           ASSERT TheF <> 0;
           INLINE
             % Y_RESULT = fgetc((FILE*) THIS->Y_TheF);
             END;
           END ReadChar;

         METHOD ReadLine: ARRAY OF CHAR;
           BEGIN
           ASSERT TheF <> 0;
           INLINE
             % {
             %   char buffer[1024];
             %   char *p;
             %       
             %   buffer[0] = 0;
             %   if (fgets(buffer, 1022, (FILE*) THIS->Y_TheF))
             %     {
             %       buffer[1021] = 0;
             %       p = buffer;
             %       p += strlen(p) - 1;
             %       if (*p == '\n')
             %         *p = 0;
             %       Y_RESULT = new_string(buffer);
             %     }
             % }
             END;
           END ReadLine;

         METHOD Eof: BOOLEAN;
           BEGIN
           ASSERT (TheF <> 0);
           INLINE
             % {
             %   int c;
             %   FILE *p;
             %           
             %   p = (FILE*) THIS->Y_TheF;
             %   c = fgetc(p);
             %   if (c == EOF)
             %     Y_RESULT = 1;
             %    else
             %     {
             %       ungetc(c, p);
             %       Y_RESULT = 0;
             %     }
             % }
             END;
           END Eof;

    END InputStream;
----------------------------------------------------------
    CLASS OutputStream;
       INHERITS Stream;
         
         VAR
           TheF: INTEGER;
           
         REDEFINE METHOD Goto(Position: INTEGER);
           BEGIN
           ASSERT FALSE;
           END Goto;
           
         REDEFINE METHOD ReadBuffer(Buffer: ARRAY OF CHAR;
                                    Count: INTEGER): INTEGER;
           BEGIN
           ASSERT FALSE;
           END ReadBuffer;
           
         REDEFINE METHOD SetFile(Nr: INTEGER);
           BEGIN
           BASE(Nr);
           TheF := Nr;
           END SetFile;

         METHOD WriteChar(Ch: CHAR);
           VAR
             Buff: ONCE ARRAY OF CHAR;
           BEGIN                      
           ASSERT TheF <> 0;
           IF Buff = VOID THEN
             Buff.CREATE (1);
             END;
           Buff [0] := Ch;
           WriteSlice (Buff, 0, 1);
           END WriteChar;

         METHOD WriteString(a: ARRAY OF CHAR);
           BEGIN
           DEBUG
             FOR i := 0 TO a.SIZE - 1 DO
               ASSERT a[i] <> SYSTEM.CHR(0);
               END;
             END;
           WriteSlice (a, 0, a.SIZE);
           END WriteString;

         METHOD WriteLn;
           BEGIN
           ASSERT TheF <> 0;
           INLINE
             % fputc('\n', (FILE*) THIS->Y_TheF);
             END;
           END WriteLn;

         METHOD WriteLine (a: ARRAY OF CHAR);
           BEGIN
           WriteString (a);
           WriteLn;
           END WriteLine;

         METHOD WriteInt (i, Width: INTEGER);
           BEGIN
           WriteString (IntConversions.IntToString (i, Width));
           END WriteInt;

         METHOD WriteReal(r: REAL;
                          Width, Decimals: INTEGER);
           BEGIN
           WriteString (RealConversions.RealToString(r,Width,Decimals));
           END WriteReal;

         METHOD WriteBool(b: BOOLEAN);
           BEGIN
           IF b THEN
             WriteString("TRUE");
            ELSE
             WriteString("FALSE");
             END; -- IF
           END WriteBool;

    END OutputStream;
--------------------------------------------------
  CLASS VersionedOutputStream;
    INHERITS OutputStream;
    
    VAR
      VersionedFile: BOOLEAN;
      TempFileName, RealFileName: ARRAY OF CHAR;
    
    METHOD AttemptCreate (FName,
                          TempFName: ARRAY OF CHAR);
      BEGIN
      ASSERT NOT VersionedFile;
      VersionedFile := TRUE;
      RealFileName := FName;
      TempFileName := TempFName;
      Create (TempFileName, Stream.WriteAccess);
      END AttemptCreate;
      
    METHOD Compare (FName1, FName2: ARRAY OF CHAR): BOOLEAN;
      VAR
        File1, File2: InputStream;
        Buffer1: ONCE ARRAY OF CHAR;
        Buffer2: ONCE ARRAY OF CHAR;
        Read1, Read2, i: INTEGER;
        Continue: BOOLEAN;
      CONST
        BufferSize = 1024;
      BEGIN
      IF Buffer1 = VOID THEN
        ASSERT Buffer2 = VOID;
        Buffer1.CREATE (BufferSize);
        Buffer2.CREATE (BufferSize);
        END;
      File1.CREATE;
      File2.CREATE;
      File1.Open (FName1, Stream.ReadAccess);
      IF File1.ErrorCode = Stream.NoError THEN
        File2.Open (FName2, Stream.ReadAccess);
        IF File2.ErrorCode = Stream.NoError THEN
          Continue := TRUE;
          -------------------------------
          -- Skip the first line, so that the comment
          -- which merely indicates the compiler's version
          -- is not taken into account.
          -------------------------------
          VOID := File1.ReadLine;
          VOID := File2.ReadLine;
          WHILE Continue DO
            Read1 := File1.ReadBuffer (Buffer1, BufferSize);
            Read2 := File2.ReadBuffer (Buffer2, BufferSize);
            IF Read1 = Read2 THEN
              i := String.LimitedCompare (Buffer1, Buffer2, Read1);
              IF i = String.Equal THEN
                IF Read1 <> BufferSize THEN
                  RESULT := TRUE;
                  Continue := FALSE;
                  END;
               ELSE
                Continue := FALSE;
                END;
             ELSE
              Continue := FALSE;
              END;
            END;
          File2.Close;
          END;
        File1.Close;
        END;
      END Compare;

    REDEFINE METHOD Close;
      BEGIN
      BASE;
      IF VersionedFile THEN
        IF NOT Compare(TempFileName, RealFileName) THEN
          Operations.Delete (RealFileName);
          VOID := Operations.Rename (TempFileName, RealFileName);
         ELSE
          Operations.Delete (TempFileName);
          END;
        VersionedFile := FALSE;
        END;
      END Close;
    
  END VersionedOutputStream;
--------------------------------------------------
    ONCE CLASS StdIn;
      INHERITS InputStream;

      REDEFINE METHOD Open (FName: ARRAY OF CHAR;
                            Access: INTEGER);
        BEGIN
        ASSERT FALSE;
        END Open;                  
        
      REDEFINE METHOD Length: INTEGER;
        BEGIN      
        ASSERT FALSE;
        END Length;
                          
      REDEFINE METHOD Where: INTEGER;
        BEGIN      
        ASSERT FALSE;
        END Where;
                          
      REDEFINE METHOD Goto(Position: INTEGER);
        BEGIN
        ASSERT FALSE;
        END Goto;

      REDEFINE METHOD CREATE;
        VAR
          i: INTEGER;
        BEGIN
        BASE;
        INLINE
          % Y_i = (yint) stdin;
          END;
        SetFile(i);
        END CREATE;
        
      REDEFINE METHOD ReadLine: ARRAY OF CHAR;
        BEGIN
        INLINE
          %{
          % char buff[1024];
          % get_stdin (buff);
          % buff[1020] = 0;
          % Y_RESULT = new_string(buff);
          %}
          END;
        END ReadLine;

      REDEFINE METHOD Close;
        BEGIN
        END Close;

    END StdIn;
----------------------------------------------------------
    CLASS PredefinedOutputStream;
      INHERITS OutputStream;
    
      REDEFINE METHOD Open (FName: ARRAY OF CHAR;  Access: INTEGER);
        BEGIN                                    
        ASSERT FALSE;
        END Open;

       REDEFINE METHOD Create(FName: ARRAY OF CHAR;
                       Access: INTEGER);
         BEGIN
         ASSERT FALSE;
         END Create;
                                
       REDEFINE METHOD Close;
         BEGIN
         BASE;
         END Close;
         
    END PredefinedOutputStream;
--------------------------------------------------
    ONCE CLASS StdOut;
      INHERITS PredefinedOutputStream;

      REDEFINE METHOD CREATE;
        VAR
          i: INTEGER;
        BEGIN
        BASE;
        INLINE
          % Y_i = (yint) stdout;
          END;
        SetFile (i);
        END CREATE;

      REDEFINE METHOD WriteString (a: ARRAY OF CHAR);
        BEGIN
        INLINE
          % emit_stdout(Y_a);
          END;
        END WriteString;
        
      REDEFINE METHOD WriteLn;
        BEGIN
        INLINE
          % emit_nl();
          END;
        END WriteLn;

    END StdOut;
--------------------------------------------------
    ONCE CLASS StdErr;
       INHERITS PredefinedOutputStream;

       REDEFINE METHOD CREATE;
         VAR
           i: INTEGER;
         BEGIN
         BASE;
         INLINE
           % Y_i = (yint) stderr;
           END;
         SetFile (i);
         END CREATE;

      REDEFINE METHOD WriteString (a: ARRAY OF CHAR);
        BEGIN
        INLINE
          % emit_stderr(Y_a);
          END;
        END WriteString;
        
      REDEFINE METHOD WriteLn;
        BEGIN
        INLINE
          % emit_stderr("\n");
          END;
        END WriteLn;

    END StdErr;

END Streams;
