
(********************************************************************)
(*                                                                  *)
(*  expr.s7i      Support to represent C cxpressions.               *)
(*  Copyright (C) 1990 - 1994, 2004 - 2015  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.                       *)
(*                                                                  *)
(********************************************************************)


(**
 *  Some of the process() functions can produce c_expr.expr and
 *  c_expr.result_expr expressions. The value c_expr.demand can
 *  be used to regulate which kind of expression should be preferred.
 *  PREFER_EXPR is the default.
 *  ASSIGN_RESULT is used, if the expression will be assigned.
 *  REQUIRE_RESULT is used, if the expression will be returned by a function.
 *  Independent of the value of c_expr.demand the process() functions
 *  can produce both c_expr.expr and c_expr.result_expr expressions.
 *)
const type: exprDemand is new enum
    PREFER_EXPR, ASSIGN_RESULT, REQUIRE_RESULT
  end enum;

const type: expr_type is new struct
    var string: currentFile is "";
    var integer: currentLine is 0;
    var integer: temp_num is 0;
    var string: temp_decls is "";
    var string: temp_assigns is "";
    var string: expr is "";
    var string: temp_frees is "";
    var string: temp_to_null is "";
    var exprDemand: demand is PREFER_EXPR;
    var string: result_name is "";
    var string: result_decl is "";
    var string: result_free is "";
    var string: result_to_null is "";
    var string: result_intro is "";
    var string: result_expr is "";
    var string: result_finish is "";
  end struct;

var expr_type: global_c_expr is expr_type.value;
var ref_list: declared_types is ref_list.EMPTY;
var boolean: write_object_declaration is TRUE;
var boolean_obj_hash: prototype_declared is boolean_obj_hash.EMPTY_HASH;


const proc: defineVarFuncType (in type: functionType, inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "typedef struct {\n";
    c_expr.expr &:= type_name(resultType(functionType));
    c_expr.expr &:= " (*func) (void *);\n";
    c_expr.expr &:= "struct {\n";
    c_expr.expr &:= "int dummy;\n";
    c_expr.expr &:= "} data;\n";
    c_expr.expr &:= "} struct_";
    c_expr.expr &:= type_name(functionType);
    c_expr.expr &:= ", *";
    c_expr.expr &:= type_name(functionType);
    c_expr.expr &:= ";\n\n";
  end func;


const proc: declare_type_if_necessary (in type: aType, inout expr_type: c_expr) is func

  local
    var reference: type_obj is NIL;
    var type: metaType is void;
    var type: baseType is void;
  begin
    type_obj := typeObject(aType);
    if not type_obj in declared_types then
      if aType not in typeCategory then
        if isDerived(aType) then
          metaType := meta(aType);
          if metaType in typeCategory then
            typeCategory @:= [aType] typeCategory[metaType];
          else
            c_expr.expr &:= "typedef genericType ";
            c_expr.expr &:= type_name(aType);
            c_expr.expr &:= ";\n\n";
          end if;
          if metaType in array_element then
            baseType := base_type(metaType);
            if baseType <> void then
              if aType not in array_element then
                array_element @:= [aType] baseType;
              end if;
              if baseType not in array_type then
                array_type @:= [baseType] aType;
              end if;
            end if;
          end if;
        elsif isFunc(aType) or isVarfunc(aType) then
          declare_type_if_necessary(resultType(aType), c_expr);
          defineVarFuncType(aType, c_expr);
          typeCategory @:= [aType] BLOCKOBJECT;
        else
          c_expr.expr &:= "typedef genericType ";
          c_expr.expr &:= type_name(aType);
          c_expr.expr &:= ";\n\n";
        end if;
        incl(declared_types, type_obj);
      elsif typeCategory[aType] = BLOCKOBJECT and
          (isFunc(aType) or isVarfunc(aType)) then
        declare_type_if_necessary(resultType(aType), c_expr);
        defineVarFuncType(aType, c_expr);
        incl(declared_types, type_obj);
      # else
      #   writeln(type_name2(aType) & " in typeCategory " & str(typeCategory[aType]));
      #   c_expr.expr &:= "/* " & type_name2(aType) & " in typeCategory " & str(typeCategory[aType]) & " */\n";
      end if;
    # else
    #   c_expr.expr &:= "/* " & type_name2(aType) & " in declared_types */\n";
    end if;
  end func;
