(********************************************************************)
(*                                                                  *)
(*  type.s7i      Type functions, variables and constants for s7c.  *)
(*  Copyright (C) 1990 - 1994, 2004 - 2014  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.                       *)
(*                                                                  *)
(********************************************************************)


# Category values only used in the Compiler:
const category: BOOLOBJECT        is category conv 256;
const category: ENUMOBJECT        is category conv 257;
const category: VOIDOBJECT        is category conv 258;

const type: typeReferenceHash is hash [type] reference;
const type: typeCategoryHash is hash [type] category;
const type: type_hash is hash [type] type;
const type: boolean_type_hash is hash [type] boolean;
const type: integer_type_hash is hash [type] integer;
const type: string_type_hash is hash [type] string;
const type: element_type_array is array type;
const type: struct_element_type_hash is hash [type] element_type_array;
const type: implements_hash is hash [type] array type;
const type: interface_hash is hash [type] array type;

const type: element_number_hash is hash [reference] integer;
const type: enum_literal_hash is hash [type] element_number_hash;
const type: number_element_hash is hash [integer] array reference;
const type: struct_element_array is array reference;
const type: struct_element_hash is hash [type] struct_element_array;
const type: element_idx_hash is hash [reference] integer;
const type: struct_element_idx_hash is hash [type] element_idx_hash;
const type: boolean_obj_hash is hash [reference] boolean;

const type: typeDataStruct is new struct
  var typeCategoryHash: typeCategory is typeCategoryHash.EMPTY_HASH;

  var type_hash: array_element is type_hash.EMPTY_HASH;
  var type_hash: array_type is type_hash.EMPTY_HASH;
  var integer_type_hash: array_minIdx is integer_type_hash.value;
  var integer_type_hash: array_maxIdx is integer_type_hash.value;

  var integer_type_hash: struct_size is integer_type_hash.value;
  var struct_element_hash: struct_element is struct_element_hash.EMPTY_HASH;
  var struct_element_idx_hash: struct_element_idx is struct_element_idx_hash.EMPTY_HASH;
  var struct_element_type_hash: struct_element_type is struct_element_type_hash.EMPTY_HASH;

  var boolean_type_hash: flist_declared is boolean_type_hash.EMPTY_HASH;

  var typeReferenceHash: createFunction is typeReferenceHash.EMPTY_HASH;
  var boolean_type_hash: create_declared is boolean_type_hash.EMPTY_HASH;
  var boolean_type_hash: create_prototype_declared is boolean_type_hash.EMPTY_HASH;
  var string_type_hash: parametersOfHshCreate is string_type_hash.EMPTY_HASH;

  var typeReferenceHash: destrFunction is typeReferenceHash.EMPTY_HASH;
  var boolean_type_hash: destr_declared is boolean_type_hash.EMPTY_HASH;
  var boolean_type_hash: destr_prototype_declared is boolean_type_hash.EMPTY_HASH;
  var string_type_hash: parametersOfHshDestr is string_type_hash.EMPTY_HASH;

  var typeReferenceHash: copyFunction is typeReferenceHash.EMPTY_HASH;
  var boolean_type_hash: cpy_declared is boolean_type_hash.EMPTY_HASH;
  var string_type_hash: parametersOfHshCpy is string_type_hash.EMPTY_HASH;

  var boolean_type_hash: times_prototype_declared is boolean_type_hash.EMPTY_HASH;

  var boolean_type_hash: generic_hashCode_declared is boolean_type_hash.EMPTY_HASH;
  var boolean_type_hash: generic_cpy_declared is boolean_type_hash.EMPTY_HASH;
  var boolean_type_hash: generic_create_declared is boolean_type_hash.EMPTY_HASH;
  var boolean_type_hash: generic_destr_declared is boolean_type_hash.EMPTY_HASH;
  var boolean_type_hash: generic_cmp_declared is boolean_type_hash.EMPTY_HASH;

  var enum_literal_hash: enum_literal is enum_literal_hash.EMPTY_HASH;
  var boolean_type_hash: literal_function_of_enum_used is boolean_type_hash.EMPTY_HASH;

  var implements_hash: implementsInterface is implements_hash.EMPTY_HASH;
  var interface_hash: interfaceOfType is interface_hash.EMPTY_HASH;

  # Type variables which hold types from the program being compiled
  var type: proctype is void;
  var type: voidtype is void;
  var type: fileInterfaceType is void;
end struct;

var typeDataStruct: typeData is typeDataStruct.value;

var program: prog is program.EMPTY;


const func string: raw_type_name (in type: object_type) is func

  result
    var string: typeName is "";
  begin
    if object_type in typeData.typeCategory then
      case typeData.typeCategory[object_type] of
        when {VOIDOBJECT}:       typeName := "void";
        when {BOOLOBJECT}:       typeName := "boolType";
        when {ENUMOBJECT}:       typeName := "enumType";
        when {INTOBJECT}:        typeName := "intType";
        when {BIGINTOBJECT}:     typeName := "bigIntType";
        when {FLOATOBJECT}:      typeName := "floatType";
        when {CHAROBJECT}:       typeName := "charType";
        when {STRIOBJECT}:       typeName := "striType";
        when {BSTRIOBJECT}:      typeName := "bstriType";
        when {FILEOBJECT}:       typeName := "fileType";
        when {SOCKETOBJECT}:     typeName := "socketType";
        when {POLLOBJECT}:       typeName := "pollType";
        when {SETOBJECT}:        typeName := "setType";
        when {WINOBJECT}:        typeName := "winType";
        when {POINTLISTOBJECT}:  typeName := "bstriType";
        when {PROCESSOBJECT}:    typeName := "processType";
        when {PROGOBJECT}:       typeName := "progType";
        when {DATABASEOBJECT}:   typeName := "databaseType";
        when {SQLSTMTOBJECT}:    typeName := "sqlStmtType";
        when {ARRAYOBJECT}:      typeName := "arrayType";
        when {HASHOBJECT}:       typeName := "hashType";
        when {STRUCTOBJECT}:     typeName := "structType";
        when {STRUCTELEMOBJECT}: typeName := "objRefType";
        when {INTERFACEOBJECT}:  typeName := "interfaceType";
        when {REFOBJECT}:        typeName := "objRefType";
        when {REFLISTOBJECT}:    typeName := "listType";
        when {TYPEOBJECT}:       typeName := "typeType";
        when {ACTOBJECT}:        typeName := "actType";
        otherwise:
          typeName := "t_";
          typeName &:= str(typeNumber(object_type));
      end case;
    else
      typeName := "t_";
      typeName &:= str(typeNumber(object_type));
    end if;
  end func;


const func string: type_name (in type: object_type) is func

  result
    var string: typeName is "";
  begin
    typeName := raw_type_name(object_type);
    typeName &:= "/*t_";
    typeName &:= str(typeNumber(object_type));
    typeName &:= "_";
    typeName &:= str(object_type);
    typeName &:= "*/";
  end func;


const func string: type_name2 (in type: object_type) is func

  result
    var string: typeName is "";
  begin
    typeName := raw_type_name(object_type);
    typeName &:= "/t_";
    typeName &:= str(typeNumber(object_type));
    typeName &:= "_";
    typeName &:= str(object_type);
  end func;


const func type: base_type (in type: array_type) is func

  result
    var type: baseType is void;
  local
    var ref_list: param_list is ref_list.EMPTY;
    var reference: matched_object is NIL;
  begin
    param_list := make_list(typeObject(array_type));
    param_list &:= make_list(syobject(prog, "base_type"));
    matched_object := match(prog, param_list);
    if matched_object <> NIL and category(matched_object) = TYPEOBJECT then
      baseType := getValue(matched_object, type);
    end if;
  end func;


const func type: getExprResultType (in reference: aReference) is func

  result
    var type: resultType is void;
  begin
    # write("getExprResultType: ");
    # TRACE_OBJ(aReference);
    # writeln;
    resultType := getType(aReference);
    if category(aReference) = CALLOBJECT then
      while isFunc(resultType) or isVarfunc(resultType) do
        # writeln("isFunc(" <& str(resultType) <& "): " <& str(category(aReference)));
        resultType := resultType(resultType);
      end while;
    end if;
    # writeln("getExprResultType --> " <& str(resultType));
  end func;


const func string: raw_type_value (in type: object_type) is func

  result
    var string: valueName is "";
  begin
    if object_type in typeData.typeCategory then
      case typeData.typeCategory[object_type] of
        when {BOOLOBJECT}:       valueName := "boolValue";
        when {ENUMOBJECT}:       valueName := "enumValue";
        when {INTOBJECT}:        valueName := "intValue";
        when {BIGINTOBJECT}:     valueName := "bigIntValue";
        when {FLOATOBJECT}:      valueName := "floatValue";
        when {CHAROBJECT}:       valueName := "charValue";
        when {STRIOBJECT}:       valueName := "striValue";
        when {BSTRIOBJECT}:      valueName := "bstriValue";
        when {FILEOBJECT}:       valueName := "fileValue";
        when {SOCKETOBJECT}:     valueName := "socketValue";
        when {POLLOBJECT}:       valueName := "pollValue";
        when {SETOBJECT}:        valueName := "setValue";
        when {WINOBJECT}:        valueName := "winValue";
        when {POINTLISTOBJECT}:  valueName := "bstriValue";
        when {PROCESSOBJECT}:    valueName := "processValue";
        when {PROGOBJECT}:       valueName := "progValue";
        when {DATABASEOBJECT}:   valueName := "databaseValue";
        when {SQLSTMTOBJECT}:    valueName := "sqlStmtValue";
        when {ARRAYOBJECT}:      valueName := "arrayValue";
        when {HASHOBJECT}:       valueName := "hashValue";
        when {STRUCTOBJECT}:     valueName := "structValue";
        when {STRUCTELEMOBJECT}: valueName := "objRefValue";
        when {INTERFACEOBJECT}:  valueName := "interfaceValue";
        when {REFOBJECT}:        valueName := "objRefValue";
        when {REFLISTOBJECT}:    valueName := "listValue";
        when {TYPEOBJECT}:       valueName := "typeValue";
        when {ACTOBJECT}:        valueName := "actValue";
        otherwise:               valueName := "genericValue";
       end case;
    else
      valueName := "genericValue";
    end if;
  end func;


const func string: select_value_from_rtlObjectStruct (in type: typeWanted) is
  return ".value." & raw_type_value(typeWanted);


const func string: select_value_from_rtlObjectptr (in type: typeWanted) is
  return "->value." & raw_type_value(typeWanted);


const func boolean: valueIsAtHeap (in type: aType) is func

  result
    var boolean: isAtHeap is FALSE;
  local
    const set of category: heapCategories is {
        BIGINTOBJECT, STRIOBJECT, BSTRIOBJECT, FILEOBJECT, WINOBJECT,
        POINTLISTOBJECT, PROCESSOBJECT, PROGOBJECT, DATABASEOBJECT,
        SQLSTMTOBJECT, SETOBJECT, ARRAYOBJECT, STRUCTOBJECT, HASHOBJECT,
        INTERFACEOBJECT, REFLISTOBJECT};
  begin
    if aType in typeData.typeCategory and
        typeData.typeCategory[aType] in heapCategories then
      isAtHeap := TRUE;
    end if;
  end func;


const func boolean: valueIsAtHeap (in reference: a_param) is
  return valueIsAtHeap(getType(a_param));


const func boolean: useConstPrefix (in type: aType) is func

  result
    var boolean: useConstPrefix is FALSE;
  local
    const set of category: constPrefixCategories is {
        BIGINTOBJECT, STRIOBJECT, PROGOBJECT,
        ARRAYOBJECT, SETOBJECT, HASHOBJECT};
  begin
    if aType in typeData.typeCategory and
        typeData.typeCategory[aType] in constPrefixCategories then
      useConstPrefix := TRUE;
    end if;
  end func;


const func boolean: useConstPrefix (in reference: a_param) is
  return useConstPrefix(getType(a_param));