(********************************************************************)
(*                                                                  *)
(*  literal.s7i   Support to write literals.                        *)
(*  Copyright (C) 1990 - 1994, 2004 - 2014, 2022  Thomas Mertes     *)
(*                                                                  *)
(*  This file is part of the Seed7 compiler.                        *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program 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 General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU 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.                       *)
(*                                                                  *)
(********************************************************************)


const integer: MAX_SHOWN_BIGINT_LITERAL_BITLENGTH is 256;
const integer: MAX_SHOWN_STRI_LITERAL_LENGTH is 256;

const bigInteger: MAX_BIGDIGIT is 2_ ** 31 - 1_;


const type: bigint_table_hash is hash [bigInteger] integer;
const type: bigint_index_hash is hash [integer] array bigInteger;
const type: bigint_bstri_hash is hash [integer] integer;

const type: stri_table_hash is hash [string] integer;
const type: stri_index_hash is hash [integer] array string;

const type: bstri_table_hash is hash [bstring] integer;
const type: bstri_index_hash is hash [integer] array bstring;

const type: nan_table_hash is hash [bin64] integer;
const type: nan_index_hash is hash [integer] array bin64;

const type: set_table_hash is hash [bitset] integer;
const type: set_index_hash is hash [integer] array bitset;

const type: type_table_hash is hash [type] integer;
const type: type_index_hash is hash [integer] array type;

const type: ref_table_hash is hash [reference] integer;
const type: ref_index_hash is hash [integer] array reference;

const type: win_table_hash is hash [PRIMITIVE_WINDOW] integer;
const type: win_index_hash is hash [integer] array PRIMITIVE_WINDOW;
const type: win_bstri_hash is hash [integer] integer;

const type: plist_table_hash is hash [pointList] integer;
const type: plist_index_hash is hash [integer] array pointList;
const type: plist_bstri_hash is hash [integer] integer;

const type: const_table_hash is hash [reference] integer;
const type: const_index_hash is hash [integer] array reference;

const type: programConstants is new struct
    var bigint_table_hash: bigint_const is bigint_table_hash.EMPTY_HASH;
    var bigint_bstri_hash: bigint_bstri is bigint_bstri_hash.EMPTY_HASH;

    var stri_table_hash: stri_const is stri_table_hash.EMPTY_HASH;

    var bstri_table_hash: bstri_const is bstri_table_hash.EMPTY_HASH;

    var nan_table_hash: nan_const is nan_table_hash.EMPTY_HASH;

    var set_table_hash: set_const is set_table_hash.EMPTY_HASH;

    var type_table_hash: type_const is type_table_hash.EMPTY_HASH;

    var ref_table_hash: ref_const is ref_table_hash.EMPTY_HASH;

    var win_table_hash: win_const is win_table_hash.EMPTY_HASH;
    var win_bstri_hash: win_bstri is win_bstri_hash.EMPTY_HASH;

    var plist_table_hash: plist_const is plist_table_hash.EMPTY_HASH;
    var plist_bstri_hash: plist_bstri is plist_bstri_hash.EMPTY_HASH;

    var const_table_hash: other_const is const_table_hash.EMPTY_HASH;
  end struct;

var programConstants: constTable is programConstants.value;


const func string: stringInComment (in string: stri) is func

  result
    var string: expr is "";
  begin
    if length(stri) <= MAX_SHOWN_STRI_LITERAL_LENGTH then
      expr &:= " /* ";
      expr &:= replace(literal(stri), "*/", "*\\/");
      expr &:= " */";
    end if;
  end func;


const func string: stringLiteral (in string: stri) is func

  result
    var string: expr is "";
  begin
    if stri not in constTable.stri_const then
      constTable.stri_const @:= [stri] length(constTable.stri_const);
    end if;
    if ccConf.ALLOW_STRITYPE_SLICES then
      expr := "&";
    end if;
    expr &:= "str[";
    expr &:= str(constTable.stri_const[stri]);
    expr &:= "]";
    expr &:= stringInComment(stri);
  end func;


const func string: bstriLiteral (in bstring: bstri) is func

  result
    var string: expr is "";
  begin
    if bstri not in constTable.bstri_const then
      constTable.bstri_const @:= [bstri] length(constTable.bstri_const);
    end if;
    if ccConf.ALLOW_BSTRITYPE_SLICES then
      expr := "&";
    end if;
    expr &:= "bst[";
    expr &:= str(constTable.bstri_const[bstri]);
    expr &:= "]";
  end func;


const func string: charLiteral (in char: ch) is
  return "(charType) " & c_literal(ch);


const func string: integerLiteral (in integer: number) is func

  result
    var string: expr is "";
  begin
    if ccConf.INTTYPE_SIZE = 64 and ccConf.INTTYPE_LITERAL_SUFFIX = "" then
      if number < 0 then
        if number = integer.first then
          expr := "(intType) (";
          expr &:= str(succ(integer.first));
          expr &:= "-1)";
        else
          expr := "(-(intType) ";
          expr &:= str(-number);
          expr &:= ")";
        end if;
      else
        expr := "(intType) ";
        expr &:= str(number);
      end if;
    elsif number = integer.first then
      expr := "(";
      expr &:= str(succ(integer.first));
      expr &:= ccConf.INTTYPE_LITERAL_SUFFIX;
      expr &:= "-1";
      expr &:= ccConf.INTTYPE_LITERAL_SUFFIX;
      expr &:= ")";
    else
      expr := str(number);
      expr &:= ccConf.INTTYPE_LITERAL_SUFFIX;
    end if;
  end func;


const func string: bigIntegerLiteral (in bigInteger: number) is func

  result
    var string: expr is "";
  begin
    if number not in constTable.bigint_const then
      constTable.bigint_const @:= [number] length(constTable.bigint_const);
    end if;
    expr := "big[";
    expr &:= str(constTable.bigint_const[number]);
    expr &:= "]";
    if bitLength(number) <= MAX_SHOWN_BIGINT_LITERAL_BITLENGTH then
      expr &:= " /* ";
      expr &:= str(number);
      expr &:= " */";
    end if;
  end func;


const func string: memSizeLiteral (in integer: aSize) is func

  result
    var string: expr is "";
  begin
    if ccConf.POINTER_SIZE = 64 then
      if ccConf.INT64TYPE_LITERAL_SUFFIX = "" then
        expr := "(memSizeType) ";
        expr &:= str(aSize);
        expr &:= "U";
      else
        expr := str(aSize);
        expr &:= "U";
        expr &:= ccConf.INT64TYPE_LITERAL_SUFFIX;
      end if;
    else # ccConf.POINTER_SIZE = 32
      expr := str(aSize);
      expr &:= "U";
      expr &:= ccConf.INT32TYPE_LITERAL_SUFFIX;
    end if;
  end func;


const func string: memSizeLiteral (in bigInteger: aSize) is func

  result
    var string: expr is "";
  begin
    if ccConf.POINTER_SIZE = 64 then
      if ccConf.INT64TYPE_LITERAL_SUFFIX = "" then
        expr := "(memSizeType) ";
        expr &:= str(aSize);
        expr &:= "U";
      else
        expr := str(aSize);
        expr &:= "U";
        expr &:= ccConf.INT64TYPE_LITERAL_SUFFIX;
      end if;
    else # ccConf.POINTER_SIZE = 32
      expr := str(aSize);
      expr &:= "U";
      expr &:= ccConf.INT32TYPE_LITERAL_SUFFIX;
    end if;
  end func;


const func string: bitsetLiteral (in bitset: aBitset) is func

  result
    var string: expr is "";
  begin
    if aBitset not in constTable.set_const then
      constTable.set_const @:= [aBitset] length(constTable.set_const);
    end if;
    expr := "set[";
    expr &:= str(constTable.set_const[aBitset]);
    expr &:= "]";
  end func;


const func string: floatLiteral (in float: aFloat) is func

  result
    var string: expr is "";
  local
    var bin64: bits is bin64(0);
    var integer: exponentPos is 0;
    var integer: pos is 0;
  begin
    if isNaN(aFloat) then
      bits := bin64(aFloat);
      if bits not in constTable.nan_const then
        constTable.nan_const @:= [bits] length(constTable.nan_const);
      end if;
      expr := "nanValue[";
      expr &:= str(constTable.nan_const[bits]);
      expr &:= "].aDouble";
    elsif aFloat = Infinity then
      expr := "POSITIVE_INFINITY";
    elsif aFloat = -Infinity then
      expr := "NEGATIVE_INFINITY";
    elsif isNegativeZero(aFloat) then
      expr := "negativeZero";
    else
      expr := str(aFloat);
      # Make sure that the literal is parsed to the same value.
      if float(expr) <> aFloat or length(expr) >= 100 then
        expr := aFloat sci 100;
        exponentPos := pos(expr, 'e');
        pos := pred(exponentPos);
        while pos >= 1 and expr[pos] = '0' do
          decr(pos);
        end while;
        expr := expr[.. pos] & expr[exponentPos ..];
      end if;
    end if;
  end func;


const func string: typeLiteral (in type: aType) is func

  result
    var string: expr is "";
  begin
    if aType not in constTable.type_const then
      constTable.type_const @:= [aType] length(constTable.type_const);
    end if;
    expr := "typ[";
    expr &:= str(constTable.type_const[aType]);
    expr &:= "] /* ";
    expr &:= type_name2(aType);
    expr &:= " */";
  end func;


const func string: referenceLiteral (in reference: aReference) is func

  result
    var string: expr is "";
  begin
    if aReference = NIL then
      expr &:= "(objRefType) NULL";
    else
      if aReference not in constTable.ref_const then
        constTable.ref_const @:= [aReference] length(constTable.ref_const);
      end if;
      expr := "ref[";
      expr &:= str(constTable.ref_const[aReference]);
      expr &:= "]";
    end if;
  end func;


const func string: windowLiteral (in PRIMITIVE_WINDOW: aWindow) is func

  result
    var string: expr is "";
  begin
    if aWindow not in constTable.win_const then
      constTable.win_const @:= [aWindow] length(constTable.win_const);
    end if;
    expr := "win[";
    expr &:= str(constTable.win_const[aWindow]);
    expr &:= "]";
  end func;


const func string: pointListLiteral (in pointList: aPointList) is func

  result
    var string: expr is "";
  begin
    if aPointList not in constTable.plist_const then
      constTable.plist_const @:= [aPointList] length(constTable.plist_const);
    end if;
    expr &:= "plist[";
    expr &:= str(constTable.plist_const[aPointList]);
    expr &:= "]";
  end func;