(********************************************************************)
(*                                                                  *)
(*  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;

var bigint_table_hash: bigint_const_table is bigint_table_hash.EMPTY_HASH;
var bigint_bstri_hash: bigint_bstri_table is bigint_bstri_hash.EMPTY_HASH;

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

var stri_table_hash: stri_const_table is stri_table_hash.EMPTY_HASH;

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

var bstri_table_hash: bstri_const_table is bstri_table_hash.EMPTY_HASH;

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

var nan_table_hash: nan_const_table is nan_table_hash.EMPTY_HASH;

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

var set_table_hash: set_const_table is set_table_hash.EMPTY_HASH;

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

var type_table_hash: type_const_table is type_table_hash.EMPTY_HASH;

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;

var win_table_hash: win_const_table is win_table_hash.EMPTY_HASH;
var win_bstri_hash: win_bstri_table is win_bstri_hash.EMPTY_HASH;

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;

var plist_table_hash: plist_const_table is plist_table_hash.EMPTY_HASH;
var plist_bstri_hash: plist_bstri_table is plist_bstri_hash.EMPTY_HASH;

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

var const_table_hash: const_table is const_table_hash.EMPTY_HASH;


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 stri_const_table then
      stri_const_table @:= [stri] length(stri_const_table);
    end if;
    if ccConf.ALLOW_STRITYPE_SLICES then
      expr := "&";
    end if;
    expr &:= "str[";
    expr &:= str(stri_const_table[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 bstri_const_table then
      bstri_const_table @:= [bstri] length(bstri_const_table);
    end if;
    if ccConf.ALLOW_BSTRITYPE_SLICES then
      expr := "&";
    end if;
    expr &:= "bst[";
    expr &:= str(bstri_const_table[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 bigint_const_table then
      bigint_const_table @:= [number] length(bigint_const_table);
    end if;
    expr := "big[";
    expr &:= str(bigint_const_table[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 set_const_table then
      set_const_table @:= [aBitset] length(set_const_table);
    end if;
    expr := "set[";
    expr &:= str(set_const_table[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 nan_const_table then
        nan_const_table @:= [bits] length(nan_const_table);
      end if;
      expr := "nanValue[";
      expr &:= str(nan_const_table[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 type_const_table then
      type_const_table @:= [aType] length(type_const_table);
    end if;
    expr := "typ[";
    expr &:= str(type_const_table[aType]);
    expr &:= "] /* ";
    expr &:= type_name2(aType);
    expr &:= " */";
  end func;


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

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


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

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