
(********************************************************************)
(*                                                                  *)
(*  gzip.s7i      Gzip uncompression function                       *)
(*  Copyright (C) 2008  Thomas Mertes                               *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


include "binary.s7i";


const func integer: getBitLe (in string: stri, inout integer: bytePos,
    inout integer: bitPos) is func
  result
    var integer: resultBit is 0;
  begin
    resultBit := (ord(stri[bytePos]) >> bitPos) mod 2;
    if bitPos = 7 then
      bitPos := 0;
      incr(bytePos);
    else
      incr(bitPos);
    end if;
  end func;


const func integer: getBitsLe (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in var integer: bitsNeeded) is func
  result
    var integer: resultBits is 0;
  local
    var integer: bitsInByte is 0;
    var integer: bitsInResult is 0;
  begin
    bitsInByte := 8 - bitPos;
    if bitsInByte > bitsNeeded then
      resultBits := (ord(stri[bytePos]) >> bitPos) rem (1 << bitsNeeded);
      bitPos +:= bitsNeeded;
    else
      resultBits := ord(stri[bytePos]) mod 256 >> bitPos;
      bitPos := 0;
      incr(bytePos);
      if bitsInByte <> bitsNeeded then
        bitsNeeded -:= bitsInByte;
        bitsInResult := bitsInByte;
        while bitsNeeded >= 8 do
          resultBits +:= ord(stri[bytePos]) << bitsInResult;
          incr(bytePos);
          bitsNeeded -:= 8;
          bitsInResult +:= 8;
        end while;
        if bitsNeeded <> 0 then
          resultBits +:= ord(stri[bytePos]) rem (1 << bitsNeeded) << bitsInResult;
          bitPos := bitsNeeded;
        end if;
      end if;
    end if;
  end func;


const proc: getNonCompressedBlock (in string: stri, inout integer: bytePos,
    inout string: result) is func
  local
    var integer: length is 0;
    var integer: nlength is 0;
  begin
    length := ord(stri[bytePos]) + (ord(stri[succ(bytePos)]) << 8);
    nlength := ord(stri[bytePos + 2]) + (ord(stri[bytePos + 3]) << 8);
    # writeln("len=" <& length);
    # writeln("nlen=" <& nlength);
    result &:= stri[bytePos + 4 len length];
    bytePos +:= 4 + length;
  end func;


const func integer: decodeLiteralOrLengthValue (in string: stri,
    inout integer: bytePos, inout integer: bitPos) is func
  result
    var integer: resultValue is 0;
  begin
    resultValue := getBitsLe(stri, bytePos, bitPos, 7);
    if resultValue <= 2#0010111 then
      resultValue +:= 256;
    else
      resultValue <<:= 1;
      resultValue +:= getBitLe(stri, bytePos, bitPos);
      if resultValue <= 2#10111111 then
        resultValue -:= 2#00110000;
      elsif resultValue <= 2#11000111 then
        resultValue +:= 280 - 2#11000000;
      else
        resultValue <<:= 1;
        resultValue +:= getBitLe(stri, bytePos, bitPos);
        resultValue -:= 2#110010000 - 144;
      end if;
    end if;
  end func;


const func integer: decodeLengthValue (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in integer: code) is func
  result
    var integer: lengthValue is 0;
  begin
    if code <= 264 then
      lengthValue := code - 254;
    elsif code <= 268 then
      lengthValue := 11 + ((code - 265) << 1) + getBitLe(stri, bytePos, bitPos);
    elsif code <= 272 then
      lengthValue := 19 + ((code - 269) << 2) + getBitsLe(stri, bytePos, bitPos, 2);
    elsif code <= 276 then
      lengthValue := 35 + ((code - 273) << 3) + getBitsLe(stri, bytePos, bitPos, 3);
    elsif code <= 280 then
      lengthValue := 67 + ((code - 277) << 4) + getBitsLe(stri, bytePos, bitPos, 4);
    elsif code <= 284 then
      lengthValue := 131 + ((code - 281) << 5) + getBitsLe(stri, bytePos, bitPos, 5);
    elsif code = 285 then
      lengthValue := 258;
    else
      raise RANGE_ERROR;
    end if;
  end func;


const func integer: decodeDistanceValue (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in integer: code) is func
  result
    var integer: distanceValue is 0;
  begin
    case code of
      when {0, 1, 2, 3}:
        distanceValue := succ(code);
      when {4, 5}:
        distanceValue := 5 + ((code - 4) << 1) + getBitLe(stri, bytePos, bitPos);
      when {6, 7}:
        distanceValue := 9 + ((code - 6) << 2) + getBitsLe(stri, bytePos, bitPos, 2);
      when {8, 9}:
        distanceValue := 17 + ((code - 8) << 3) + getBitsLe(stri, bytePos, bitPos, 3);
      when {10, 11}:
        distanceValue := 33 + ((code - 10) << 4) + getBitsLe(stri, bytePos, bitPos, 4);
      when {12, 13}:
        distanceValue := 65 + ((code - 12) << 5) + getBitsLe(stri, bytePos, bitPos, 5);
      when {14, 15}:
        distanceValue := 129 + ((code - 14) << 6) + getBitsLe(stri, bytePos, bitPos, 6);
      when {16, 17}:
        distanceValue := 257 + ((code - 16) << 7) + getBitsLe(stri, bytePos, bitPos, 7);
      when {18, 19}:
        distanceValue := 513 + ((code - 18) << 8) + getBitsLe(stri, bytePos, bitPos, 8);
      when {20, 21}:
        distanceValue := 1025 + ((code - 20) << 9) + getBitsLe(stri, bytePos, bitPos, 9);
      when {22, 23}:
        distanceValue := 2049 + ((code - 22) << 10) + getBitsLe(stri, bytePos, bitPos, 10);
      when {24, 25}:
        distanceValue := 4097 + ((code - 24) << 11) + getBitsLe(stri, bytePos, bitPos, 11);
      when {26, 27}:
        distanceValue := 8193 + ((code - 26) << 12) + getBitsLe(stri, bytePos, bitPos, 12);
      when {28, 29}:
        distanceValue := 16385 + ((code - 28) << 13) + getBitsLe(stri, bytePos, bitPos, 13);
      otherwise:
        raise RANGE_ERROR;
    end case;
  end func;


const proc: decodeFixedHuffmanCodes (in string: stri, inout integer: bytePos,
    inout integer: bitPos, inout string: result) is func
  local
    var integer: literalOrLength is 0;
    var integer: length is 0;
    var integer: distance is 0;
    var integer: number is 0;
    var integer: nextPos is 0;
  begin
    literalOrLength := decodeLiteralOrLengthValue(stri, bytePos, bitPos);
    while literalOrLength <> 256 do
      if literalOrLength < 256 then
        result &:= chr(literalOrLength);
      else
        length := decodeLengthValue(stri, bytePos, bitPos, literalOrLength);
        distance := getBitsLe(stri, bytePos, bitPos, 5);
        distance := decodeDistanceValue(stri, bytePos, bitPos, distance);
        if length > distance then
          nextPos := succ(length(result));
          # write("(*" <& nextPos <& "*)");
          result &:= "\0\" mult length;
          for number range nextPos to nextPos + length - 1 do
            # write(" number=" <& number <& ", distance=" <& distance <& " ");
            # write(result[number - distance]);
            result @:= [number] result[number - distance];
          end for;
        else # hopefully length(result) >= distance holds
          # write(result[succ(length(result)) - distance len length]);
          result &:= result[succ(length(result)) - distance len length];
        end if;
      end if;
      literalOrLength := decodeLiteralOrLengthValue(stri, bytePos, bitPos);
    end while;
  end func;


const type: conversionEntry is new struct
    var integer: limit is 0;
    var array integer: table is 0 times 0;
  end struct;

const type: conversionTableType is array conversionEntry;


const func integer: getHuffmanValue (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in conversionTableType: conversionTable) is func
  result
    var integer: huffmanValue is 0;
  local
    var integer: bitLength is 1;
    var integer: code is 0;
  begin
    # writeln("--- " <& bytePos <& " " <& bitPos);
    repeat
      code <<:= 1;
      code +:= getBitLe(stri, bytePos, bitPos);
      incr(bitLength);
    until code < conversionTable[bitLength].limit;
    # writeln("--- " <& bytePos <& " " <& bitPos <& " " <&
    #         bitLength <& " " <& str(code, 2) lpad0 pred(bitLength));
    huffmanValue := conversionTable[pred(bitLength)].table[code];
    # writeln("huffmanValue=" <& huffmanValue);
  end func;


const func conversionTableType: computeConversionTable (in array integer: codeLengths) is func
  result
    var conversionTableType: conversionTable is conversionTableType.value;
  local
    var integer: maxBits is 0;
    var integer: bits is 0;
    var integer: number is 0;
    var integer: code is 0;
    var array integer: bl_count is 0 times 0;
    var integer: length is 0;
    var array integer: nextCode is 0 times 0;
    var array integer: codeValues is 0 times 0;
  begin
(*
    writeln("minIdx(codeLengths)=" <& minIdx(codeLengths));
    writeln("maxIdx(codeLengths)=" <& maxIdx(codeLengths));
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      write(" " <& codeLengths[number]);
    end for;
    writeln;
*)
    maxBits := 0;
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      if codeLengths[number] > maxBits then
        maxBits := codeLengths[number];
      end if;
    end for;
    # writeln("maxBits=" <& maxBits);
    bl_count := [0 .. maxBits] times 0;
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      incr(bl_count[codeLengths[number]]);
    end for;
(*
    for bits range 1 to maxBits do
      write(" " <& bl_count[bits]);
    end for;
    writeln;
    writeln;
*)
    code := 0;
    bl_count[0] := 0;
    nextCode := maxBits times 0;
    conversionTable := succ(maxBits) times conversionEntry.value;
    for bits range 1 to maxBits do
      code := (code + bl_count[pred(bits)]) << 1;
      conversionTable[bits].limit := code >> 1;
      conversionTable[bits].table := [code .. pred(code)] times 0;
      nextCode[bits] := code;
      # writeln(bits lpad 4 <& " " <& code);
    end for;
    # writeln;
    conversionTable[succ(maxBits)].limit := 1 << maxBits;
(*
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      if codeLengths[number] <> 0 and
          conversionTable[codeLengths[number]].base = -1 then
        conversionTable[codeLengths[number]].base := number;
      end if;
    end for;
    for bits range 1 to maxBits do
      write(" " <& conversionTable[bits].base);
    end for;
    writeln;
*)
    # writeln("num  bits  code  dec  code  limit");
    codeValues := [minIdx(codeLengths) .. maxIdx(codeLengths)] times 0;
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      length := codeLengths[number];
      if length <> 0 then
        codeValues[number] := nextCode[length];
        incr(nextCode[length]);
        conversionTable[length].table &:= number;
      end if;
(*
      write(number lpad 4 <& "  " <& codeLengths[number] lpad 3 <& "  " <&
          str(codeValues[number], 2) lpad0 codeLengths[number] lpad maxBits);
      write("  " <& codeValues[number] lpad 5 <& "  " <&
          literal(str(codeValues[number], 2) lpad0 codeLengths[number]) rpad maxBits + 2);
      if codeLengths[number] <> 0 then
        write("  " <& conversionTable[codeLengths[number]].limit lpad 4);
      end if;
      writeln;
*)
    end for;
    # writeln;
(*
    writeln(" num  bits   " <& "code" lpad maxBits <& "   dec   " <& "code" rpad maxBits + 2 <& " limit");
    for bits range 1 to maxBits do
      for number range minIdx(conversionTable[bits].table) to maxIdx(conversionTable[bits].table) do
        write(conversionTable[bits].table[number] lpad 4 <& "  " <& bits lpad 4 <& "   " <&
            str(number, 2) lpad0 bits lpad maxBits);
        writeln(" " <& number lpad 5 <& "  " <&
            literal(str(number, 2) lpad0 bits) rpad maxBits + 2 <&
            "  " <& conversionTable[bits].limit lpad 4);
      end for;
    end for;
    write(" " lpad 6 <& succ(maxBits) lpad 4 <& " " <&
        str(1 << succ(maxBits), 2) lpad0 bits lpad maxBits);
    writeln(" " <& 1 << succ(maxBits) lpad 5 <& "  " <&
        literal(str(1 << succ(maxBits), 2) lpad0 succ(maxBits)) rpad maxBits + 2 <&
        conversionTable[succ(maxBits)].limit lpad 4);
    writeln;
*)
  end func;


const proc: decodeDynamicHuffmanCodes (in string: stri, inout integer: bytePos,
    inout integer: bitPos, inout string: result) is func
  local
    const array integer: codeLengthAlphabet is []
        (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);
    var integer: hlit is 0;
    var integer: hdist is 0;
    var integer: hclen is 0;
    var array integer: lengthCodeLengths is [0 .. -1] times 0;
    var array integer: combinedCodeLengths is [0 .. -1] times 0;
    var array integer: literalOrLengthCodeLengths is [0 .. -1] times 0;
    var array integer: distanceCodeLengths is [0 .. -1] times 0;
    var integer: number is 0;
    var integer: codeLength is 0;
    var integer: factor is 0;
    var conversionTableType: lengthConversionTable is conversionTableType.value;
    var conversionTableType: literalOrLengthConversionTable is conversionTableType.value;
    var conversionTableType: distanceConversionTable is conversionTableType.value;
    var integer: literalOrLength is 0;
    var integer: length is 0;
    var integer: distance is 0;
    var integer: nextPos is 0;
  begin
    hlit := getBitsLe(stri, bytePos, bitPos, 5);
    hdist := getBitsLe(stri, bytePos, bitPos, 5);
    hclen := getBitsLe(stri, bytePos, bitPos, 4);
    # writeln("hlit=" <& hlit);
    # writeln("hdist=" <& hdist);
    # writeln("hclen=" <& hclen);
    lengthCodeLengths := [0 .. 18] times 0;
    for number range 1 to hclen + 4 do
      lengthCodeLengths[codeLengthAlphabet[number]] := getBitsLe(stri, bytePos, bitPos, 3);
      # write(" " <& lengthCodeLengths[codeLengthAlphabet[number]]);
    end for;
    # writeln;
    lengthConversionTable := computeConversionTable(lengthCodeLengths);
    number := 1;
    # writeln("number  codeLength");
    while number <= hlit + 257 + hdist + 1 do
      codeLength := getHuffmanValue(stri, bytePos, bitPos, lengthConversionTable);
      # writeln(number lpad 6 <& "  " <& codeLength);
      if codeLength <= 15 then
        combinedCodeLengths &:= codeLength;
        incr(number);
      elsif codeLength = 16 then
        factor := getBitsLe(stri, bytePos, bitPos, 2) + 3;
        combinedCodeLengths &:= factor times
            combinedCodeLengths[maxIdx(combinedCodeLengths)];
        number +:= factor;
      elsif codeLength = 17 then
        factor := getBitsLe(stri, bytePos, bitPos, 3) + 3;
        combinedCodeLengths &:= factor times 0;
        number +:= factor;
      else # codeLength = 18
        factor := getBitsLe(stri, bytePos, bitPos, 7) + 11;
        combinedCodeLengths &:= factor times 0;
        number +:= factor;
      end if;
    end while;
    # writeln;
    literalOrLengthCodeLengths := combinedCodeLengths[.. hlit + 256];
    distanceCodeLengths := combinedCodeLengths[hlit + 257 .. ];
    literalOrLengthConversionTable := computeConversionTable(literalOrLengthCodeLengths);
    distanceConversionTable := computeConversionTable(distanceCodeLengths);
    # writeln("************");
    literalOrLength := getHuffmanValue(stri, bytePos, bitPos, literalOrLengthConversionTable);
    while literalOrLength <> 256 do
      if literalOrLength < 256 then
        # write(chr(literalOrLength));
        result &:= chr(literalOrLength);
      else
        # write("<" <& literalOrLength <& ">");
        length := decodeLengthValue(stri, bytePos, bitPos, literalOrLength);
        # write("[" <& length <& "]");
        distance := getHuffmanValue(stri, bytePos, bitPos, distanceConversionTable);
        # write("(" <& distance <& ")");
        distance := decodeDistanceValue(stri, bytePos, bitPos, distance);
        # write("{" <& distance <& "}");
        if length > distance then
          nextPos := succ(length(result));
          # write("(*" <& nextPos <& "*)");
          result &:= "\0\" mult length;
          for number range nextPos to nextPos + length - 1 do
            # write(" number=" <& number <& ", distance=" <& distance <& " ");
            # write(result[number - distance]);
            result @:= [number] result[number - distance];
          end for;
        else # hopefully length(result) >= distance holds
          # write(result[succ(length(result)) - distance len length]);
          result &:= result[succ(length(result)) - distance len length];
        end if;
      end if;
      literalOrLength := getHuffmanValue(stri, bytePos, bitPos, literalOrLengthConversionTable);
    end while;
    # writeln("************");
  end func;


const proc: processCompressedBlock (in string: stri, inout integer: bytePos,
    inout integer: bitPos, inout string: result, inout boolean: bfinal) is func
  local
    var integer: btype is 0;
  begin
    # writeln("bytePos=" <& bytePos <& ", bitPos=" <& bitPos);
    bfinal := odd(getBitLe(stri, bytePos, bitPos));
    btype := getBitsLe(stri, bytePos, bitPos, 2);
    # writeln("bfinal=" <& bfinal <& " btype=" <& btype);
    case btype of
      when {0}:
        if bitPos <> 0 then
          incr(bytePos);
          bitPos := 0;
        end if;
        getNonCompressedBlock(stri, bytePos, result);
      when {1}:
        decodeFixedHuffmanCodes(stri, bytePos, bitPos, result);
      when {2}:
        decodeDynamicHuffmanCodes(stri, bytePos, bitPos, result);
      otherwise:
        raise RANGE_ERROR;
    end case;
  end func;


(**
 *  Decompress a string that was compressed with DEFLATE.
 *  DEFLATE is a compression algorithm that uses a combination of
 *  the LZ77 algorithm and Huffman coding.
 *  @return the decompressed string.
 *  @exception RANGE_ERROR When compressedStri is not in DEFLATE format.
 *)
const func string: inflate (in string: compressedStri) is func
  result
    var string: decompressedStri is "";
  local
    var integer: bytePos is 1;
    var integer: bitPos is 0;
    var boolean: bfinal is FALSE;
  begin
    repeat
      processCompressedBlock(compressedStri, bytePos, bitPos, decompressedStri, bfinal);
    until bfinal;
  end func;


const proc: readGzipHeader (in string: stri, inout integer: bytePos) is func
  local
    var integer: compressionMethod is 0;
    var integer: flags is 0;
    var boolean: flagFtext is FALSE;
    var boolean: flagFhcrc is FALSE;
    var boolean: flagFextra is FALSE;
    var boolean: flagFname is FALSE;
    var boolean: flagFcomment is FALSE;
    var integer: mtime is 0;
    var integer: extraFlags is 0;
    var integer: operatingSystem is 0;
    var integer: extraLength is 0;
    var string: originalFileName is "";
    var string: fileComment is "";
    var integer: crc16 is 0;
  begin
    compressionMethod := ord(stri[3]);
    # writeln("CM=" <& compressionMethod);
    flags := ord(stri[4]);
    flagFtext    := odd(flags);
    flagFhcrc    := odd(flags >> 1);
    flagFextra   := odd(flags >> 2);
    flagFname    := odd(flags >> 3);
    flagFcomment := odd(flags >> 4);
    # writeln(flagFtext <& " " <& flagFhcrc <& " " <& flagFextra <& " " <&
    #     flagFname <& " " <& flagFcomment);
    mtime := ord(stri[5]) + (ord(stri[6]) << 8) + (ord(stri[7]) << 16) + (ord(stri[8]) << 24);
    # writeln(mtime);
    extraFlags := ord(stri[9]);
    operatingSystem := ord(stri[10]);
    # writeln(extraFlags <& " " <& operatingSystem);
    bytePos := 11;
    if flagFextra then
      extraLength := ord(stri[11]) + (ord(stri[12]) << 8);
      bytePos +:= 2 + extraLength;
    end if;
    if flagFname then
      originalFileName := get_asciiz(stri, bytePos);
    end if;
    if flagFcomment then
      fileComment := get_asciiz(stri, bytePos);
    end if;
    if flagFhcrc then
      crc16 := ord(stri[11]) + (ord(stri[12]) << 8);
    end if;
  end func;


(**
 *  Decompress a string that was compressed with gzip.
 *  Gzip uses the DEFLATE compression algorithm. DEFLATE uses
 *  a combination of the LZ77 algorithm and Huffman coding.
 *  Additionally to DEFLATE gzip uses a magic number and a header.
 *  @return the decompressed string.
 *  @exception RANGE_ERROR When compressedStri is not in gzip format.
 *)
const func string: gunzip (in string: compressedStri) is func
  result
    var string: decompressedStri is "";
  local
    var integer: bytePos is 0;
    var integer: bitPos is 0;
    var boolean: bfinal is FALSE;
  begin
    if compressedStri[1 len 2] = "\31\\139\" then
      readGzipHeader(compressedStri, bytePos);
      repeat
        processCompressedBlock(compressedStri, bytePos, bitPos, decompressedStri, bfinal);
      until bfinal;
    end if;
  end func;


const type: gunzipFile is sub null_file struct
    var string: compressed is "";
    var integer: bytePos is 0;
    var integer: bitPos is 0;
    var boolean: bfinal is FALSE;
    var string: uncompressed is "";
    var integer: position is 1;
  end struct;

type_implements_interface(gunzipFile, file);


const func gunzipFile: malloc (in gunzipFile: aFile) is func
  result
    var gunzipFile: result is gunzipFile.value;
  begin
    result := aFile;
  end func;


(**
 *  Open a 'gunzipFile' to decompress a compressed string.
 *  @return the file opened.
 *)
const func file: openGunzipFile (in string: compressedStri) is func
  result
    var file: result is STD_NULL;
  local
    var gunzipFile: new_gunzipFile is gunzipFile.value;
  begin
    if compressedStri[1 len 2] = "\31\\139\" then
      new_gunzipFile.compressed := compressedStri;
      readGzipHeader(new_gunzipFile.compressed, new_gunzipFile.bytePos);
      result := malloc(new_gunzipFile);
    end if;
  end func;


(**
 *  Close a 'gunzipFile'.
 *)
const proc: close (in gunzipFile: aFile) is noop;


(**
 *  Read a character from a 'gunzipFile'.
 *  @return the character read.
 *)
const func char: getc (inout gunzipFile: aFile) is func
  result
    var char: charRead is ' ';
  begin
    while aFile.position > length(aFile.uncompressed) and
        not aFile.bfinal do
      processCompressedBlock(aFile.compressed, aFile.bytePos, aFile.bitPos,
          aFile.uncompressed, aFile.bfinal);
    end while;
    if aFile.position <= length(aFile.uncompressed) then
      charRead := aFile.uncompressed[aFile.position];
      incr(aFile.position);
    else
      charRead := EOF;
    end if;
  end func;


(**
 *  Read a string with maximum length from a 'gunzipFile'.
 *  @return the string read.
 *)
const func string: gets (inout gunzipFile: aFile, in var integer: leng) is func
  result
    var string: striRead is "";
  begin
    while pred(aFile.position + leng) > length(aFile.uncompressed) and
        not aFile.bfinal do
      processCompressedBlock(aFile.compressed, aFile.bytePos, aFile.bitPos,
          aFile.uncompressed, aFile.bfinal);
    end while;
    if pred(aFile.position + leng) <= length(aFile.uncompressed) then
      striRead := aFile.uncompressed[aFile.position len leng];
      aFile.position +:= leng;
    else
      striRead := aFile.uncompressed[aFile.position ..];
      aFile.position := succ(length(aFile.uncompressed));
    end if;
  end func;


(**
 *  Determine the end-of-file indicator.
 *  The end-of-file indicator is set when at least one request to read
 *  from the file failed.
 *  @return TRUE if the end-of-file indicator is set, FALSE otherwise.
 *)
const func boolean: eof (in gunzipFile: aFile) is
  return aFile.position > length(aFile.uncompressed) and aFile.bfinal;


(**
 *  Determine if at least one character can be read successfully.
 *  This function allows a file to be handled like an iterator.
 *  @return FALSE if 'getc' would return EOF, TRUE otherwise.
 *)
const func boolean: hasNext (inout gunzipFile: aFile) is func
  result
    var boolean: result is FALSE;
  begin
    while aFile.position > length(aFile.uncompressed) and
        not aFile.bfinal do
      processCompressedBlock(aFile.compressed, aFile.bytePos, aFile.bitPos,
          aFile.uncompressed, aFile.bfinal);
    end while;
    result := aFile.position <= length(aFile.uncompressed);
  end func;


(**
 *  Obtain the length of a file.
 *  The file length is measured in bytes.
 *  @return the length of a file, or 0 if it cannot be obtained.
 *)
const func integer: length (inout gunzipFile: aFile) is func
  result
    var integer: result is 0;
  begin
    while not aFile.bfinal do
      processCompressedBlock(aFile.compressed, aFile.bytePos, aFile.bitPos,
          aFile.uncompressed, aFile.bfinal);
    end while;
    result := length(aFile.uncompressed);
  end func;


(**
 *  Set the current file position.
 *  The file position is measured in bytes from the start of the file.
 *  The first byte in the file has the position 1.
 *)
const proc: seek (inout gunzipFile: aFile, in integer: pos) is func
  begin
    aFile.position := pos;
  end func;


(**
 *  Obtain the current file position.
 *  The file position is measured in bytes from the start of the file.
 *  The first byte in the file has the position 1.
 *  @return the current file position.
 *)
const func integer: tell (in gunzipFile: aFile) is
  return aFile.position;


(**
 *  Open a 'gunzipFile' to decompress a compressed file.
 *  The file is read into a string and 'openGunzipFile' is used to
 *  open a 'gunzipFile'.
 *  @return the file opened.
 *)
const func file: gunzip (inout file: aFile) is func
  result
    var file: result is STD_NULL;
  local
    var string: stri is "";
  begin
    stri := gets(aFile, length(aFile) - tell(aFile) + 1);
    if stri <> "" then
      result := openGunzipFile(stri);
    end if;
  end func;
