print_code_smalltalk.c

Go to the documentation of this file.

/*
 
  $Id: print_code_smalltalk.c 23065 2016-03-02 09:05:50Z coelho $
 
  Copyright 1989-2016 MINES ParisTech
 
  This file is part of PIPS.
 
  PIPS 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 3 of the License, or
  any later version.
 
  PIPS 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 PIPS.  If not, see <http://www.gnu.org/licenses/>.
 
*/
#ifdef HAVE_CONFIG_H
    #include "pips_config.h"
#endif
/* 
 *
 * This phase is used for PHRASE project. 
 *
 *
 * NB: The PHRASE project is an attempt to automatically (or semi-automatically)
 * transform high-level language for partial evaluation in reconfigurable logic 
 * (such as FPGAs or DataPaths). 
 *
 * This pass is used in context of PHRASE project for synthetisation of 
 * reconfigurable logic for a portion of initial code. This function can be 
 * viewed as a Smalltalk pretty-printer of a subset of Fortran. 
 *
 * alias print_code_smalltalk 'Smalltalk Pretty-Printer'
 *
 * print_code_smalltalk        > MODULE.smalltalk_code
 *       < PROGRAM.entities 
 *       < MODULE.code
 *
 * The Smalltalk code will be available in SMALLTALK_CODE_FILE 
 *
 * NB: This code is highly inspired from PRINT_C_CODE phase written by nguyen
 *
 */ 
 
#include <stdio.h>
#include <ctype.h>
 
#include "genC.h"
#include "linear.h"
#include "ri.h"
#include "effects.h"
 
#include "resources.h"
 
#include "misc.h"
#include "ri-util.h"
#include "prettyprint.h"
#include "effects-util.h"
#include "pipsdbm.h"
#include "text-util.h"
 
 
#define STPRETTY                ".st"
 
#include "smalltalk-defs.h"
 
#define RESULT_NAME     "result"
 
#define current_module_is_a_function() \
  (entity_function_p(get_current_module_entity()))
 
static string st_statement(statement s);
static string st_sequence(sequence seq);
static string st_call(call c);
static string st_expression(expression);
static string st_reference(reference r);
static string st_test(test t);
static string st_loop(loop l);
static string st_whileloop(whileloop w);
static string st_forloop(forloop f);
 
 
/**
 * Return beautified string representing name for entity var
 */
static string st_entity_local_name(entity var)
{
  const char* name;
 
  pips_debug(6,"st_entity_local_name was : %s\n",entity_local_name(var));
 
  if (current_module_is_a_function() &&
      var != get_current_module_entity() &&
      same_string_p(entity_local_name(var), 
                    entity_local_name(get_current_module_entity()))) {
    name = RESULT_NAME;
  }
  else
    {
      name = entity_local_name(var);
  
      /* Delete all the prefixes */
 
      if (strstr(name,STRUCT_PREFIX) != NULL)
        name = strstr(name,STRUCT_PREFIX) + 1;
      if (strstr(name,UNION_PREFIX) != NULL)
        name = strstr(name,UNION_PREFIX) + 1;
      if (strstr(name,ENUM_PREFIX) != NULL)
        name = strstr(name,ENUM_PREFIX) + 1;      
      if (strstr(name,TYPEDEF_PREFIX) != NULL)
        name = strstr(name,TYPEDEF_PREFIX) + 1;
      if (strstr(name,MEMBER_SEP_STRING) != NULL)
        name = strstr(name,MEMBER_SEP_STRING) + 1;
      if (strstr(name,MAIN_PREFIX) != NULL)
        name = strstr(name,MAIN_PREFIX) + 1;
    }
  pips_debug(6,"st_entity_local_name is now : %s\n",name);
  return strdup(name);
}
 
 
/**
 * Return string representing expression enclosed by parenthesis
 */
static string st_brace_expression_as_string(expression exp)
{
  string result = OPENBRACKET;
  list args = call_arguments(syntax_call(expression_syntax(exp)));
  
  bool first = true;
  MAP(EXPRESSION,e,
  {
    if (brace_expression_p(e))
      result = strdup(concatenate(result,first?"":",",st_brace_expression_as_string(e),NULL));
    else
      result = strdup(concatenate(result,first?"":",",
                                  expression_to_string(e),NULL));
    first = false;
  },args);
  result = strdup(concatenate(result,CLOSEBRACKET,NULL));
  return result;
}
 
/**
 * Return a string representing dimension reference for a 
 * dimension dim and an expression e
 * This function automatically convert bounds in fortran to bounds
 * starting from 0 by doing new_reference = old_reference - lower
 * This function  is valid even in case of non-directly-cumputable expressions
 */
static string st_dimension_reference_as_string (dimension dim, expression old_expression) {
 
  intptr_t low, old;
  string slow = NULL;
  string sold = NULL;
  bool low_given_by_expression = false;
  bool old_given_by_expression = false;
  string result = strdup(EMPTY);
  
  expression elow = dimension_lower(dim);
  expression eold = old_expression;
  
  if (expression_integer_value(elow, &low)) {
    low_given_by_expression = true;
  }
  else {
    low_given_by_expression = false;
    slow = st_expression(elow);
  }
  if (expression_integer_value(eold, &old)) {
    old_given_by_expression = true;
  }
  else {
    old_given_by_expression = false;
    sold = st_expression(eold);
  }
 
  if (low_given_by_expression) {
    if (old_given_by_expression) {
      pips_debug(5,"old=%"PRIdPTR" low=%"PRIdPTR"\n", old, low);
      string istr = int2a(old-low);
      result = strdup(concatenate(result, istr, NULL));
      free(istr);
    }
    else {
      pips_debug(5,"sold=%s low=%"PRIdPTR"\n", sold, low);
      string istr = int2a(low);
      result = strdup(concatenate(result, sold,"-",istr, NULL));
      free(istr);
    }
    }
  else {
    if (old_given_by_expression) {
      pips_debug(5,"old=%"PRIdPTR" slow=%s\n", old, slow);
      string istr = int2a(old);
      result = strdup(concatenate(result, istr,"-",
                                  OPENBRACE,slow,CLOSEBRACE, NULL));
      free(istr);
    }
    else {
      pips_debug(5,"sold=%s slow=%s\n", sold, slow);
      result = strdup(concatenate(result, sold,"-",OPENBRACE,slow,
                                  CLOSEBRACE, NULL));
    }
  }
  
  return result;
}
 
/**
 * Return a string representing dimension bounds of a dimension dim
 * This function automatically convert bounds in fortran to bounds
 * starting from 0 by doing upbound = (upper - lower + 1)
 * This function  is valid even in case of non-directly-cumputable expressions
 */
static string st_dimension_bound_as_string (dimension dim) {
  
  intptr_t low, up;
  string slow = NULL;
  string sup = NULL;
  bool low_given_by_expression = false;
  bool up_given_by_expression = false;
  string result = strdup(EMPTY);
  
  expression elow = dimension_lower(dim);
  expression eup = dimension_upper(dim);
  
  if (expression_integer_value(elow, &low)) {
    low_given_by_expression = true;
  }
  else {
    low_given_by_expression = false;
    slow = st_expression(elow);
  }
  if (expression_integer_value(eup, &up)) {
    up_given_by_expression = true;
  }
  else {
    up_given_by_expression = false;
    sup = st_expression(eup);
  }
 
  if (low_given_by_expression) {
    if (up_given_by_expression) {
      pips_debug(5,"up=%"PRIdPTR" low=%"PRIdPTR"\n", up, low);
      string istr = int2a(up-low+1);
      result = strdup(concatenate(result, istr, NULL));
      free(istr);
    }
    else {
      string istr = int2a(low-1);
      pips_debug(5,"sup=%s low=%"PRIdPTR"\n", sup, low);
      result = strdup(concatenate(result, sup,"-",istr, NULL));
      free(istr);
    }
    }
  else {
    if (up_given_by_expression) {
      pips_debug(5,"up=%"PRIdPTR" slow=%s\n", up, slow);
      string istr = int2a(up+1);
      result = strdup(concatenate(result, istr,"-",
                                  OPENBRACE,slow,CLOSEBRACE, NULL));
      free(istr);
    }
    else {
      pips_debug(5,"sup=%s slow=%s\n", sup, slow);
      result = strdup(concatenate(result, sup,"-",OPENBRACE,slow,
                                  CLOSEBRACE,"+1", NULL));
    }
  }
  
  return result;
}
 
/**
 * Return string representing array initialization 
 * for variable svar in SMALLTALK
 */
static string st_dim_string (string svar, list ldim)
{
  string result = "";
  int dimensions = 0;
 
  dimensions = gen_length(ldim);
 
  pips_debug(5,"Dimension : %d \n", dimensions);
 
  if (dimensions == 0) {
    return strdup(result);
  }
 
  else if (dimensions == 1) {
 
    dimension dim = DIMENSION(gen_nth(0,ldim));
 
    result = strdup(concatenate(svar, SPACE, SETVALUE, SPACE, 
                                ARRAY, SPACE, 
                                ARRAY_NEW, SPACE, 
                                st_dimension_bound_as_string (dim), NULL));
    return result;
  }
 
  else if (dimensions == 2) {
 
    dimension dim = DIMENSION(gen_nth(0,ldim));
    dimension dim2 = DIMENSION(gen_nth(1,ldim));
 
    result = strdup(concatenate(svar, SPACE, SETVALUE, SPACE, 
                                ARRAY2D, SPACE, 
                                ARRAY2D_NEW1, SPACE, st_dimension_bound_as_string (dim), SPACE,
                                ARRAY2D_NEW2, SPACE, st_dimension_bound_as_string (dim2),
                                NULL));
    return result;
  }
 
  else {
    result = strdup("More than 2-dimensionals arrays not handled !");
    return result;
  }
}
 
/**
 * Return a string C-like representation of basic b
 */
static string c_basic_string(basic b)
{
  string result = "UNKNOWN_BASIC" SPACE;
  switch (basic_tag(b))
    {
    case is_basic_int:
      {
        pips_debug(2,"Basic int\n");
        switch (basic_int(b))
          {
          case 1: result = "char" SPACE; 
            break;
          case 2: result = "short" SPACE; 
            break;
          case 4: result = "int" SPACE; 
            break;
          case 6: result = "long" SPACE; 
            break;
          case 8: result = "long long" SPACE; 
            break;
          case 11: result = "unsigned char" SPACE;
            break;
          case 12: result = "unsigned short" SPACE;
            break;
          case 14: result = "unsigned int" SPACE;
            break;
          case 16: result = "unsigned long" SPACE;
            break;
          case 18: result = "unsigned long long" SPACE;
            break;
          case 21: result = "signed char" SPACE;
            break;
          case 22: result = "signed short" SPACE;
            break;
          case 24: result = "signed int" SPACE;
            break;
          case 26: result = "signed long" SPACE;
            break;
          case 28: result = "signed long long" SPACE;
            break;
          }
        break;
      }
    case is_basic_float:
      switch (basic_float(b))
        {
        case 4: result = "float" SPACE;
          break;
        case 8: result = "double" SPACE;
          break;
        }
      break;
    case is_basic_logical:
      result = "int" SPACE;
      break;
    case is_basic_string:
      result = "char" SPACE;
      break;
    case is_basic_bit:
      {
        result = "Basic bit not handled";
        break;
      }
    case is_basic_pointer:
      {
        result = "Basic pointer not handled";
        break;
      }
    case is_basic_derived:
      {
        result = "Basic derived not handled";
        break;
      }
    case is_basic_typedef:
      {
        result = "Basic typedef not handled";
        break;
      }  
    default:
      pips_internal_error("case not handled");
    }
  return strdup(result);
}
 
/**
 * Return a string representing Smalltalk declaration for
 * entity (constant or variable) var
 * NB: old function this_entity_cdeclaration(entity var)
 */
static string st_declaration(entity var)
{
  string result = "Undefined entity";
  const char* name = entity_local_name(var);
  type t = entity_type(var);
  storage s = entity_storage(var);
 
  switch (storage_tag(s)) {
  case is_storage_rom: 
    {
      string svar = st_entity_local_name(var);
      result = strdup(svar);
      free(svar);
    }
  default: 
    break;
  }
  switch (type_tag(t)) {
  case is_type_variable:
    {
      string svar;
      svar = st_entity_local_name(var);
      result = strdup(svar);
      free(svar);
      break;
    }
  case is_type_struct:
    {
      result = strdup(concatenate(name, ": undefined STRUCT in SMALLTALK", NULL));
      break;
    }
  case is_type_union:
    {
      result = strdup(concatenate(name, ": undefined UNION in SMALLTALK", NULL));
      break;
    }
  case is_type_enum:
    {
      result = strdup(concatenate(name, ": undefined ENUM in SMALLTALK", NULL));
      break;
    }
  default:
      break;
  }
 
  return result? result: strdup("");
}
 
/**
 * Return a string representing Smalltalk declaration 
 * initialisation for entity (constant or variable) var
 */
static string st_declaration_init(entity var)
{
  string result = NULL;
  type t = entity_type(var);
  storage s = entity_storage(var);
 
  pips_debug(2,"st_declaration_init for entity : %s\n",entity_name(var));
  
  switch (storage_tag(s)) {
  case is_storage_rom: 
    {
      /* This is a constant, we must initialize it */
 
      value va = entity_initial(var);
      
      if (!value_undefined_p(va))
        {
          constant c = NULL;
          pips_debug(4,"Constant with defined value\n");
          if (value_constant_p(va))
            c = value_constant(va);
          else if (value_symbolic_p(va))
            c = symbolic_constant(value_symbolic(va));
          if (c)
            {
              if (constant_int_p(c))
                {
                  string sval = int2a(constant_int(c));
                  string svar = st_entity_local_name(var);
                  pips_debug(4,"Constant is an integer\n");
                  result = strdup(concatenate(svar, SPACE, SETVALUE
                                              SPACE, sval, NULL));
                  
                  free(svar);
                  free(sval);
                  return result;
                }
              else 
                {
                  string svar = st_entity_local_name(var);
                  pips_debug(4,"Type of constant not handled\n");
                  result = strdup(concatenate(svar, SPACE, SETVALUE
                                              SPACE, "undefined", NULL));
                }
            }
        }
      break;
    }
  default:
    break;
  }
  switch (type_tag(t)) {
  case is_type_variable:
    {
      int dimensions;
      variable v = type_variable(t);
      string svar;
      value val = entity_initial(var);
 
      svar = st_entity_local_name(var);
 
      dimensions = gen_length(variable_dimensions(v));
      pips_debug(4,"Dimensions: %zd\n", gen_length(variable_dimensions(v)));
 
      if (dimensions == 0) {
 
        if (!value_undefined_p(val)) {
          if (value_expression_p(val)) {
            /* This variable must be initialized
             * Anyway, i don't know how to initialize a variable
             * at declaration in Fortran !!! */
            expression exp = value_expression(val);
            if (brace_expression_p(exp))
              result = strdup(concatenate(result,SETVALUE,st_brace_expression_as_string(exp),NULL));
            else
              result = strdup(concatenate(result,SETVALUE,expression_to_string(exp),NULL));
          }
        }
      }
 
      else if (dimensions < 3) {
        pips_debug(2,"Init for arrays \n");
        result = strdup(st_dim_string (svar, variable_dimensions(v)));
      }
 
      else {
        pips_debug(2,"Arrays dimension > 2 not handled\n");
      }
 
      free(svar);
      break;
    }
  case is_type_struct:
    {
      result = "undefined STRUCT in SMALLTALK";
      break;
    }
  case is_type_union:
    {
      result = "undefined UNION in SMALLTALK";
      break;
    }
  case is_type_enum:
    {
      result = "undefined ENUM in SMALLTALK";
      break;
    }
  default:
    break;
  }
 
  return result;
}
 
/**
 * Return a string representing Smalltalk declaration 
 * initialisation for entity (constant or variable) var
 */
static string st_declaration_comment(entity var)
{
  string comment = "Undefined entity";
  string svar = st_entity_local_name(var);
  type t = entity_type(var);
 
  pips_debug(2,"st_declaration_comment for entity : %s\n",entity_name(var));
  
  switch (type_tag(t)) {
  case is_type_variable:
    {
      int dimensions;
      variable v = type_variable(t);
      string st = c_basic_string(variable_basic(v));
 
      dimensions = gen_length(variable_dimensions(v));
      pips_debug(4,"Dimensions: %zd\n", gen_length(variable_dimensions(v)));
 
      if (dimensions == 0) {
        comment = strdup(concatenate(COMMENT, svar, ",", st, COMMENT, NULL));
      }
      
      else if (dimensions < 3) {
        
        if (dimensions == 1) {
          comment = strdup(concatenate(COMMENT, svar, ",", st, ", 1 dimension", COMMENT, NULL));
        }
        else if (dimensions == 2) {
          comment = strdup(concatenate(COMMENT, svar, ",", st, ", 2 dimensions", COMMENT, NULL));
        }
      }
 
      else {
          comment = strdup(concatenate(COMMENT, svar, ",", st, ", Arrays dimension > 2 not handled", COMMENT, NULL));
      }
 
      break;
    }
  case is_type_struct:
    {
      comment = strdup(concatenate(COMMENT, svar, " : undefined STRUCT in SMALLTALK", COMMENT, NULL));
      break;
    }
  case is_type_union:
    {
      comment = strdup(concatenate(COMMENT, svar, " : undefined UNION in SMALLTALK", COMMENT, NULL));
      break;
    }
  case is_type_enum:
    {
      comment = strdup(concatenate(COMMENT, svar, " : undefined ENUM in SMALLTALK", COMMENT, NULL));
      break;
    }
  default:
      comment = strdup(concatenate(COMMENT, svar, " : undefined declaration in SMALLTALK", COMMENT, NULL));
  }
 
  free(svar);
  return comment;
}
 
/**
 * This function return a bool indicating if related entity e
 * represents a constant
 */
static bool constant_p(entity e)
{
  /* Constant variables */
  return storage_rom_p(entity_storage(e)) && 
    value_symbolic_p(entity_initial(e)) &&
    type_functional_p(entity_type(e));
}
 
/**
 * This function return a bool indicating if related entity e
 * represents a variable
 */
static bool variable_p(entity e)
{
  storage s = entity_storage(e);
  return type_variable_p(entity_type(e)) &&
    (storage_ram_p(s) || storage_return_p(s));
}
 
/**
 * This function return a bool indicating if related entity e
 * represents an argument
 */
static bool argument_p(entity e)
{
  /* Formal variables */
  return type_variable_p(entity_type(e)) && 
    storage_formal_p(entity_storage(e));
}
 
/**
 * Return string representing arguments declaration
 * written in SmallTalk style
 */
static string 
st_arguments (entity module,
              bool (*consider_this_entity)(entity),
              string separator,
              bool lastsep)
{
  string result = strdup("");
  code c;
  bool first = true;
 
  /* Assert that entity represent a value code */
  pips_assert("it is a code", value_code_p(entity_initial(module)));
 
  c = value_code(entity_initial(module));
  MAP(ENTITY, var,
  {
    debug(2, "\n Prettyprinter declaration for argument :",st_entity_local_name(var));   
    if (consider_this_entity(var))
      {
        string old = result;
        string svar = strdup(concatenate("with:",st_entity_local_name(var), NULL));
        result = strdup(concatenate(old, !first && !lastsep? separator: "",
                                    svar, lastsep? separator: "", NULL));
        free(old);
        free(svar);
        first = false;
      }
  },code_declarations(c));
  return result;
}
 
/**
 * Return string representing variables or constants declaration
 * written in SmallTalk style
 */
static string 
st_declarations (entity module,
                 bool (*consider_this_entity)(entity),
                 string separator,
                 bool lastsep)
{
  string result = strdup("");
  code c;
  bool first = true;
 
  /* Assert that entity represent a value code */
  pips_assert("it is a code", value_code_p(entity_initial(module)));
 
  c = value_code(entity_initial(module));
  MAP(ENTITY, var,
  {
    debug(2, "\n Prettyprinter declaration for variable :",st_entity_local_name(var));   
    if (consider_this_entity(var))
      {
        string old = result;
        string svar = st_declaration(var);
        result = strdup(concatenate(old, !first && !lastsep? separator: "",
                                    svar, lastsep? separator: "", NULL));
        free(old);
        free(svar);
        first = false;
      }
  },code_declarations(c));
  return result;
}
 
/**
 * Return string representing variables or constants declaration
 * initialisation written in SmallTalk style
 */
static string 
st_declarations_init(entity module,
                     bool (*consider_this_entity)(entity),
                     string separator,
                     bool lastsep)
{
  string result = strdup("");
  code c;
  bool first = true;
 
  /* Assert that entity represent a value code */
  pips_assert("it is a code", value_code_p(entity_initial(module)));
 
  c = value_code(entity_initial(module));
  MAP(ENTITY, var,
  {
    debug(2, "Prettyprinter declaration initialisation for variable :",st_entity_local_name(var));   
    if (consider_this_entity(var))
      {
        string old = result;
        string svar = st_declaration_init(var);
        if (svar != NULL) {
          result = strdup(concatenate(old, !first && !lastsep? separator: "",
                                      svar, lastsep? separator: "", NULL));
        }
        else {
          result = strdup(result);
        }
        free(old);
        free(svar);
        first = false;
      }
  },code_declarations(c));
  return result;
}
 
/**
 * Return string representing variables or constants declaration
 * initialisation written in SmallTalk style
 */
static string 
st_declarations_comment(entity module,
                        bool (*consider_this_entity)(entity),
                        string separator,
                        bool lastsep)
{
  string result = strdup("");
  code c;
  bool first = true;
  
  /* Assert that entity represent a value code */
  pips_assert("it is a code", value_code_p(entity_initial(module)));
  
  c = value_code(entity_initial(module));
  MAP(ENTITY, var,
  {
    debug(2, "Prettyprinter declaration initialisation for variable :",st_entity_local_name(var));   
    if (consider_this_entity(var))
      {
        string old = result;
        string svar = st_declaration_comment(var);
        result = strdup(concatenate(old, !first && !lastsep? separator: "",
                                    svar, lastsep? separator: "", NULL));
        free(old);
        free(svar);
        first = false;
      }
  },code_declarations(c));
  return result;
}
 
/**
 * Generate header for SMALLTALK module
 */
static string st_header(entity module)
{
  string result, svar, args;
  
  pips_assert("it is a function", type_functional_p(entity_type(module)));
  
  svar = st_entity_local_name(module);
  
  /* Generates the arguments declarations */
  args = st_arguments(module, 
                      argument_p, 
                      SPACE, 
                      true);
 
  result = strdup(concatenate(svar, SPACE, args, NL,
                              COMMENT, "Automatically generated with PIPS", COMMENT,
                              NL, NULL));
  
  return result;
}
 
/*********************************************************
 * Generate SMALLTALK code as String from module
 * root statement
 *********************************************************/
 
static string smalltalk_code_string(entity module, statement stat)
{
  string st_head, st_variables, st_constants;
  string st_variables_init, st_constants_init;
  string st_variables_comment;
  string st_body, result;
 
  ifdebug(2) {
    printf("Module statement: \n");
    print_statement(stat);
    printf("and declarations: \n");
    print_entities(statement_declarations(stat));
  }
  
  /* HEAD generates the header */
  st_head = st_header(module);
  ifdebug(3) {
    printf("HEAD: \n");
    printf("%s \n", st_head);
  }
  
  /* Generates the variables declarations */
  /* What about declarations associated to statements ??? */
  st_variables       = st_declarations(module, 
                                       variable_p, 
                                       SPACE, 
                                       true);
  ifdebug(3) {
    printf("VARIABLES: \n");
    printf("%s \n", st_variables);
  }
 
  /* Generates the constant declarations */
  st_constants = st_declarations (module, 
                                  constant_p, 
                                  SPACE, 
                                  true);
  ifdebug(3) {
    printf("CONSTANTS: \n");
    printf("%s \n", st_constants);
  }
 
  /* Generates the variables declarations initialisation */
  st_variables_init = st_declarations_init (module, 
                                            variable_p, 
                                            STSEMICOLON, 
                                            true);
  ifdebug(3) {
    printf("VARIABLES INIT: \n");
    printf("%s \n", st_variables_init);
  }
 
  /* Generates the variables declarations comments */
  st_variables_comment = st_declarations_comment (module, 
                                                  variable_p, 
                                                  NL, 
                                                  true);
  ifdebug(3) {
    printf("VARIABLES COMMENT: \n");
    printf("%s \n", st_variables_comment);
  }
 
  /* Generates the constant declarations initialisation */
  st_constants_init = st_declarations_init (module, 
                                            constant_p, 
                                            STSEMICOLON, 
                                            true);
  ifdebug(3) {
    printf("CONSTANTS INIT: \n");
    printf("%s \n", st_constants_init);
  }
 
  /* Generates the body */
  st_body = st_statement(stat);
  ifdebug(3) {
    printf("BODY: \n");
    printf("%s \n", st_body);
  }
  
  result = strdup(concatenate(st_head, NL, 
                              st_variables_comment, NL
                              BEGINTEMPVAR, st_constants, 
                              st_variables, ENDTEMPVAR, NL, NL,
                              st_constants_init, NL,
                              st_variables_init, NL,
                              st_body, NL, 
                              NULL));
 
  free(st_head);
  free(st_variables);
  free(st_constants);
  free(st_body);
 
  return result;
}
 
/*************************************************************** EXPRESSIONS */
 
typedef string (*prettyprinter)(string, list);
 
struct s_ppt
{
  char * intrinsic;
  char * c;
  prettyprinter ppt;
};
 
static bool expression_needs_parenthesis_p(expression);
 
/**
 * Return string representation for a list of expression le
 * representing an assignement, asserting that le is a list
 * of expressions containing exactly TWO expressions
 */
static string ppt_assignement (string in_smalltalk, list le)
{
  string result, svar;
  expression e1, e2;
  string s1, s2;
  bool p1, p2, pr1, pr2;
  syntax s;
  reference r;
  entity var;
  type t;
  variable v;
  list ldim;
 
  pips_assert("2 arguments to assignment call", gen_length(le)==2);
 
  e1 = EXPRESSION(CAR(le));
  s = expression_syntax(e1);
  pips_assert("assignment call: first expression is reference", 
              syntax_tag(s) == is_syntax_reference);
 
 
  r = syntax_reference(s);
  var = reference_variable(r);
  t = entity_type(var);
  v = type_variable(t);
  ldim = variable_dimensions(v);
 
  svar = st_entity_local_name(var);
 
  e2 = EXPRESSION(CAR(CDR(le)));
  p2 = expression_needs_parenthesis_p(e2);
  s2 = st_expression(e2);
 
 
  if (gen_length(ldim) == 0) {
    /* This is a scalar variable */
 
    p1 = expression_needs_parenthesis_p(e1);
    s1 = st_reference(r);
    result = strdup(concatenate(p1? OPENPAREN: EMPTY, s1, p1? CLOSEPAREN: EMPTY,
                                SPACE, in_smalltalk, SPACE, 
                                p2? OPENPAREN: EMPTY, s2, p2? CLOSEPAREN: EMPTY,
                                NULL));
    free(s1);
  }
  
  else if (gen_length(ldim) == 1) {
 
    dimension dim = DIMENSION(gen_nth(0,ldim));
    expression e = EXPRESSION(gen_nth(0,reference_indices(r)));
    pr1 = expression_needs_parenthesis_p(e);
 
    dim = DIMENSION(gen_nth(0,ldim));
      
    result = strdup(concatenate(svar, SPACE, ARRAY_AT_PUT_1, SPACE,
                                pr1? OPENPAREN: EMPTY,
                                st_dimension_reference_as_string (dim, e), 
                                pr1? CLOSEPAREN: EMPTY, SPACE,
                                ARRAY_AT_PUT_2, SPACE,
                                p2? OPENPAREN: EMPTY, s2, p2? CLOSEPAREN: EMPTY,
                                NULL));
  }
  
  else if (gen_length(ldim) == 2) {
    
    dimension dim1 = DIMENSION(gen_nth(0,ldim));
    expression e1 = EXPRESSION(gen_nth(0,reference_indices(r)));
    dimension dim2 = DIMENSION(gen_nth(1,ldim));
    expression e2 = EXPRESSION(gen_nth(1,reference_indices(r)));
    pr1 = expression_needs_parenthesis_p(e1);
    pr2 = expression_needs_parenthesis_p(e2);
    
    result = strdup(concatenate(svar, SPACE, ARRAY2D_AT_AT_PUT_1, SPACE,
                                pr1? OPENPAREN: EMPTY,
                                st_dimension_reference_as_string (dim1, e1), 
                                pr1? CLOSEPAREN: EMPTY, SPACE,
                                ARRAY2D_AT_AT_PUT_2, SPACE,
                                pr2? OPENPAREN: EMPTY,
                                st_dimension_reference_as_string (dim2, e2), 
                                pr2? CLOSEPAREN: EMPTY, SPACE,
                                ARRAY2D_AT_AT_PUT_3, SPACE,
                                p2? OPENPAREN: EMPTY, s2, p2? CLOSEPAREN: EMPTY,
                                NULL));
  }
 
  else {
    result = strdup("Arrays more than 2D are not handled !");
  }
 
  free(s2);
 
  return result;
}
 
/**
 * Return string representation for a list of expression le
 * representing a BINARY relation, asserting that le is a list
 * of expressions containing exactly TWO expressions
 */
static string ppt_binary(string in_smalltalk, list le)
{
  string result;
  expression e1, e2;
  string s1, s2;
  bool p1, p2;
 
  pips_assert("2 arguments to binary call", gen_length(le)==2);
 
  e1 = EXPRESSION(CAR(le));
  p1 = expression_needs_parenthesis_p(e1);
  s1 = st_expression(e1);
 
  e2 = EXPRESSION(CAR(CDR(le)));
  p2 = expression_needs_parenthesis_p(e2);
  s2 = st_expression(e2);
 
  result = strdup(concatenate(p1? OPENPAREN: EMPTY, s1, p1? CLOSEPAREN: EMPTY,
                              SPACE, in_smalltalk, SPACE, 
                              p2? OPENPAREN: EMPTY, s2, p2? CLOSEPAREN: EMPTY,
                              NULL));
 
  free(s1);
  free(s2);
 
  return result;
}
 
/**
 * Return string representation for a list of expression le
 * representing a UNARY relation, asserting that le is a list
 * of expressions containing exactly ONE expression
 */
static string ppt_unary(string in_smalltalk, list le)
{
  string e, result;
  pips_assert("one arg to unary call", gen_length(le)==1);
  e = st_expression(EXPRESSION(CAR(le)));
  result = strdup(concatenate(in_smalltalk, SPACE, e, NULL));
  free(e);
  return result;
}
 
/**
 * Return string representation for a list of expression le
 * representing a UNARY POST relation, asserting that le is a list
 * of expressions containing exactly ONE expression
 */
static string ppt_unary_post(string in_smalltalk, list le)
{
  string e, result;
  pips_assert("one arg to unary post call", gen_length(le)==1);
  e = st_expression(EXPRESSION(CAR(le)));
  result = strdup(concatenate(e, SPACE, in_smalltalk, NULL));
  free(e);
  return result;
}
 
static string ppt_call(string in_smalltalk, list le)
{
  string scall, old;
  if (le == NIL)
    { 
      scall = strdup(concatenate(in_smalltalk, NULL));
    }
  else 
    {
      bool first = true;
      scall = strdup(concatenate(in_smalltalk, OPENPAREN, NULL));
     
      /* Attention: not like this for io statements*/
      MAP(EXPRESSION, e,
      {
        string arg = st_expression(e);
        old = scall;
        scall = strdup(concatenate(old, first? "": ", ", arg, NULL));
        free(arg);
        free(old);
        first = false;
      },le);
 
      old = scall;
      scall = strdup(concatenate(old, CLOSEPAREN, NULL));
      free(old);
    }
  return scall;
}
 
/**
 * This data structure encodes the differents intrinsic allowing
 * to convert fortran code to smalltalk code
 */
static struct s_ppt intrinsic_to_smalltalk[] = 
{
  { "+", "+", ppt_binary  },
  { "-", "-", ppt_binary },
  { "/", "/", ppt_binary },
  { "*", "*", ppt_binary },
  { "--", "-", ppt_unary },
  { "**", "**", ppt_binary },
  { "=", SETVALUE, ppt_assignement },
  { ".OR.", "||", ppt_binary },
  { ".AND.", "&&", ppt_binary },
  { ".NOT.", "!", ppt_unary },
  { ".LT.", "<", ppt_binary },
  { ".GT.", ">", ppt_binary },
  { ".LE.", "<=", ppt_binary },
  { ".GE.", ">=", ppt_binary },
  { ".EQ.", "==", ppt_binary },
  { ".NE.", "!=", ppt_binary },
  { ".EQV.", "==", ppt_binary },
  { ".NEQV.", "!=", ppt_binary },
  { ".", ".", ppt_binary },
  { "->", "->", ppt_binary},
  { "post++", "++", ppt_unary_post },
  {"post--", "--" , ppt_unary_post },
  {"++pre", "++" , ppt_unary },
  {"--pre", "--" , ppt_unary },
  {"&", "&" , ppt_unary },
  {"*indirection", "*" , ppt_unary },
  {"+unary", "+", ppt_unary },
  {"-unary", "-", ppt_unary },
  {"~", "~", ppt_unary },
  {"!", "!", ppt_unary },  
  {"%", "%" , ppt_binary },  
  {"+C", "+" , ppt_binary },
  {"-C", "-", ppt_binary }, 
  {"<<", "<<", ppt_binary },
  {">>", ">>", ppt_binary }, 
  {"<", "<" , ppt_binary },
  {">", ">" , ppt_binary },
  {"<=", "<=", ppt_binary },
  {">=", ">=", ppt_binary }, 
  {"==", "==", ppt_binary },
  {"!=", "!=", ppt_binary },  
  {"&bitand", "&", ppt_binary}, 
  {"^", "^", ppt_binary },
  {"|", "|", ppt_binary },
  {"&&", "&&", ppt_binary }, 
  {"||", "||", ppt_binary },  
  {"*=", "*=", ppt_binary },
  {"/=", "/=", ppt_binary },
  {"%=", "%=", ppt_binary },
  {"+=", "+=", ppt_binary },
  {"-=", "-=", ppt_binary },
  {"<<=", "<<=" , ppt_binary },
  {">>=", ">>=", ppt_binary },
  {"&=", "&=", ppt_binary },
  {"^=", "^=", ppt_binary },
  {"|=","|=" , ppt_binary },
  { NULL, NULL, ppt_call }
};
 
/**
 * Return the prettyprinter structure for SmallTalk
 */
 
static struct s_ppt * get_ppt(entity f)
{
  const char* called = entity_local_name(f);
  struct s_ppt * table = intrinsic_to_smalltalk;
  while (table->intrinsic && !same_string_p(called, table->intrinsic))
    table++;
  return table;
}
 
/**
 * Return bool indicating if expression e must be enclosed 
 * in parenthesis
 */
static bool expression_needs_parenthesis_p(expression e)
{
  syntax s = expression_syntax(e);
  switch (syntax_tag(s))
    {
    case is_syntax_call:
      {
        struct s_ppt * p = get_ppt(call_function(syntax_call(s)));
        return p->ppt==ppt_binary;
      }
    case is_syntax_reference:
    case is_syntax_range:
    default:
      return false;
    }
}
 
/**
 * This method returns Smalltalk-like string representation (pretty-print)
 * for a statement s
 */
static string st_statement(statement s)
{
  string result;
  instruction i = statement_instruction(s);
  list l = statement_declarations(s);
  ifdebug(3) {
    printf("\nCurrent statement : \n");
    print_statement(s);
  }
  switch (instruction_tag(i))
    {
    case is_instruction_test:
      {
        test t = instruction_test(i);
        pips_debug(2, "Instruction TEST\n");   
        result = st_test(t);
        break;
      }
    case is_instruction_sequence:
      {
        sequence seq = instruction_sequence(i);
        pips_debug(2, "Instruction SEQUENCE\n");   
        result = st_sequence(seq);
        break;
      }
    case is_instruction_loop:
      {
        loop l = instruction_loop(i);
        pips_debug(2, "Instruction LOOP\n");   
        result = st_loop(l);
        break;
      }
    case is_instruction_whileloop:
      {
        whileloop w = instruction_whileloop(i);
        pips_debug(2, "Instruction WHILELOOP\n");   
        result = st_whileloop(w);
        break;
      }
    case is_instruction_forloop:
      {
        forloop f = instruction_forloop(i);
        pips_debug(2, "Instruction FORLOOP\n");   
        result = st_forloop(f);
        break;
      }
    case is_instruction_call:
      {
        string scall = st_call(instruction_call(i));
        pips_debug(2, "Instruction CALL\n");   
        result = strdup(concatenate(scall, STSEMICOLON, NULL));
        break;
      }
    case is_instruction_unstructured:
      {
        /*unstructured u = instruction_unstructured(i);*/
        pips_debug(2, "Instruction UNSTRUTURED\n");   
        result = strdup(concatenate(COMMENT, 
                                    "UNSTRUCTURED: Instruction not implementable in SMALLTALK", 
                                    COMMENT, NL, NULL));
        break;
      }
    case is_instruction_goto:
      {
        /*statement g = instruction_goto(i);*/
        pips_debug(2, "Instruction GOTO\n");   
        result = strdup(concatenate(COMMENT, 
                                    "GOTO: Instruction not implementable in SMALLTALK", 
                                    COMMENT, NL, NULL));
        break;
      }
      /* add switch, forloop break, continue, return instructions here*/
    default:
      pips_user_warning("Instruction NOT IMPLEMENTED\n");   
      result = strdup(concatenate(COMMENT, " Instruction not implemented" NL, NULL));
      break;
    }
 
  if (!ENDP(l))
    {
      string decl = ""; 
      MAP(ENTITY, var,
      {
        string svar;
        debug(2, "\n In block declaration for variable :",st_entity_local_name(var));   
        svar = st_declaration(var);
        decl = strdup(concatenate(decl, svar, STSEMICOLON, NULL));
        free(svar);
      },l);
      result = strdup(concatenate(decl,result,NULL));
    }
 
  return result;
}
 
/**
 * This method returns Smalltalk-like string representation (pretty-print)
 * for a statement s which is a Test Statement (IF/THEN/ELSE)
 */
static string st_test(test t)
{
  string result;
  bool no_false;
  string cond, strue, sfalse;
 
  cond = st_expression(test_condition(t));
  strue = st_statement(test_true(t));
  no_false = empty_statement_p(test_false(t));
  
  sfalse = no_false? NULL: st_statement(test_false(t));
  
  if (no_false) {
    result = strdup(concatenate(OPENPAREN, cond, CLOSEPAREN, NL,
                                ST_IFTRUE, SPACE, OPENBRACKET, NL, strue, 
                                CLOSEBRACKET, STSEMICOLON,
                                NULL));
  }
  else {
    result = strdup(concatenate(OPENPAREN, cond, CLOSEPAREN, NL,
                                ST_IFTRUE, SPACE, OPENBRACKET, NL, strue, 
                                CLOSEBRACKET, NL,  
                                ST_IFFALSE, SPACE, OPENBRACKET, NL, sfalse, 
                                CLOSEBRACKET, STSEMICOLON,
                                NULL));
  }
  free(cond);
  free(strue);
  if (sfalse) free(sfalse);
  return result;
}
 
/**
 * This method returns Smalltalk-like string representation (pretty-print)
 * for a statement s which is a Sequence Statement 
 * (an ordered set of sequential statements)
 */
static string st_sequence(sequence seq)
{
  string result = strdup(EMPTY);
  MAP(STATEMENT, s,
  {
    string oldresult = result;
    string current = st_statement(s);
    if (current != NULL) {
      result = strdup(concatenate(oldresult, current, NULL));
    }
    else {
      result = strdup(oldresult);
    }
    free(current);
    free(oldresult);
  }, sequence_statements(seq));
  return result;
}
 
/**
 * This method returns Smalltalk-like string representation (pretty-print)
 * for a statement s which is a Loop Statement (DO...ENDDO)
 */
static string st_loop(loop l)
{
  string result, initialisation, loopbody, incrementation;
  string body = st_statement(loop_body(l));
  string index = st_entity_local_name(loop_index(l));
  range r = loop_range(l);
  string low = st_expression(range_lower(r));
  string up = st_expression(range_upper(r));
  string inc = st_expression(range_increment(r));
  intptr_t incasint;
 
  initialisation = strdup(concatenate(index, SPACE, SETVALUE, SPACE, low, STSEMICOLON, NULL));
 
  if (expression_integer_value(range_increment(r), &incasint)) {
      string istr;
    if (incasint >= 0) {
         istr = int2a(incasint);
      inc = strdup(concatenate(ST_PLUS, SPACE, 
                               istr, NULL));
    }
    else {
         istr = int2a(-incasint);
      inc = strdup(concatenate(ST_MINUS, SPACE, 
                               istr, NULL));
    }
    free(istr);
  }
  else {
    inc = strdup(concatenate(ST_PLUS, SPACE, 
                             st_expression(range_increment(r)), NULL));
  }
 
  incrementation = strdup(concatenate(index, SPACE, SETVALUE, SPACE, index, SPACE, inc, NULL));
 
  loopbody = strdup(concatenate(OPENBRACKET, index, SPACE, ST_LE, 
                                SPACE, up, CLOSEBRACKET, SPACE,
                                ST_WHILETRUE, SPACE, OPENBRACKET, NL,
                                body, incrementation, 
                                STSEMICOLON, CLOSEBRACKET, NULL));
                                
 
  result = strdup(concatenate(initialisation, loopbody, STSEMICOLON, NULL));
 
  free(initialisation);
  free(incrementation);
  free(loopbody);
  free(body);
  free(low);
  free(up);
  free(index);
  return result;
}
 
/**
 * This method returns Smalltalk-like string representation (pretty-print)
 * for a statement s which is a While-Loop Statement (DO WHILE...ENDDO)
 */
static string st_whileloop(whileloop w)
{
  string result;
  string body = st_statement(whileloop_body(w));
  string cond = st_expression(whileloop_condition(w));
  /*evaluation eval = whileloop_evaluation(w);*/
 
  result = strdup(concatenate(OPENBRACKET, cond, CLOSEBRACKET, SPACE,
                              ST_WHILETRUE, SPACE, OPENBRACKET, NL,
                              body, 
                              CLOSEBRACKET, STSEMICOLON, NULL));
  
  free(cond);
  free(body);
  return result;
}
 
/**
 * This method returns Smalltalk-like string representation (pretty-print)
 * for a statement s which is a For-Loop Statement (I don't know how to 
 * specify in fortran !!!)
 */
static string st_forloop(forloop f)
{
  string result, loopbody;
  string body = st_statement(forloop_body(f));
  string init = st_expression(forloop_initialization(f));
  string cond = st_expression(forloop_condition(f));
  string inc = st_expression(forloop_increment(f));
  result = strdup(concatenate("for (", init, ";",cond,";",inc,") {" NL, 
                              body, "}" NL, NULL));
  
  loopbody = strdup(concatenate(OPENBRACKET, cond, CLOSEBRACKET, SPACE,
                                ST_WHILETRUE, SPACE, OPENBRACKET, NL,
                                body, inc, 
                                STSEMICOLON, CLOSEBRACKET, NULL));
                                
 
  result = strdup(concatenate(init, loopbody, STSEMICOLON, NULL));
 
  free(loopbody);
  free(inc);
  free(cond);
  free(init);
  free(body);
  return result;
}
 
/**
 * This method returns Smalltalk-like string representation (pretty-print)
 * for a statement s which is a Call Statement (a code line)
 */
static string st_call(call c)
{
  entity called = call_function(c);
  struct s_ppt * ppt = get_ppt(called);
  string result;
 
  /* special case... */
  if (same_string_p(entity_local_name(called), "STOP")) {
        result = NULL;
  }
  else if (same_string_p(entity_local_name(called), "CONTINUE")) {
        result = NULL;
  }
  else if (same_string_p(entity_local_name(called), "RETURN"))
    {
      if (entity_main_module_p(get_current_module_entity()))
        result = strdup(RETURNVALUE " 0");
      else if (current_module_is_a_function())
        result = strdup(RETURNVALUE SPACE RESULT_NAME);
      else
        result = strdup(RETURNVALUE);
    }
  else if (call_constant_p(c))
    {
      result = st_entity_local_name(called);
    }
  else
    {
      string s = st_entity_local_name(called);
      result = ppt->ppt(ppt->c? ppt->c: s, call_arguments(c));
      free(s);
    }
 
  return result;
}
 
/**
 * This function return a string representation of a reference r.
 * A reference is an array element, considering non-array variables
 * (scalar variables) are 0-dimension arrays elements. We must here
 * differently manage scalar, 1-D arrays (using SmallTalk Array 
 * class) and 2-D arrays (using SmallTalk Array2D).
 *
 * NB: in Fortran, the indexes are reversed
 */
static string st_reference(reference r)
{
  string result = strdup(EMPTY), svar;
 
  entity var = reference_variable(r);
  type t = entity_type(var);
  variable v = type_variable(t);
  list ldim = variable_dimensions(v);
  bool pr, pr1, pr2;
 
  svar = st_entity_local_name(reference_variable(r));
 
  if (gen_length(ldim) == 0) {
    
    /* This is a scalar variable, no need to manage array indices */
    result = strdup(st_entity_local_name(var));
    free(svar);
    return result;
  }
 
  else if (gen_length(ldim) == 1) {
    
    dimension dim = DIMENSION(gen_nth(0,ldim));
    expression e = EXPRESSION(gen_nth(0,reference_indices(r)));
    pr = expression_needs_parenthesis_p(e);
 
    dim = DIMENSION(gen_nth(0,ldim));
      
    result = strdup(concatenate(OPENPAREN, svar, SPACE, ARRAY_AT, SPACE,
                                pr? OPENPAREN: EMPTY,
                                st_dimension_reference_as_string (dim, e), 
                                pr? CLOSEPAREN: EMPTY,
                                CLOSEPAREN, NULL));
  }
  
  else if (gen_length(ldim) == 2) {
    
    dimension dim1 = DIMENSION(gen_nth(0,ldim));
    expression e1 = EXPRESSION(gen_nth(0,reference_indices(r)));
    dimension dim2 = DIMENSION(gen_nth(1,ldim));
    expression e2 = EXPRESSION(gen_nth(1,reference_indices(r)));
    pr1 = expression_needs_parenthesis_p(e1);
    pr2 = expression_needs_parenthesis_p(e2);
    
    result = strdup(concatenate(OPENPAREN, svar,
                                SPACE, ARRAY2D_AT_AT_1, SPACE, 
                                pr1? OPENPAREN: EMPTY,
                                st_dimension_reference_as_string (dim1, e1),
                                pr1? CLOSEPAREN: EMPTY,
                                SPACE, ARRAY2D_AT_AT_2, SPACE,
                                pr2? OPENPAREN: EMPTY,
                                st_dimension_reference_as_string (dim2, e2),
                                pr2? CLOSEPAREN: EMPTY,
                                CLOSEPAREN, NULL));
  }
  
  else {
    
    result = strdup(concatenate(COMMENT, "Arrays more than 2D are not handled !", 
                                COMMENT, NULL));
  }
  
  free(svar);
  return result;
 
}
 
static string st_expression(expression e)
{
  string result = NULL;
  syntax s = expression_syntax(e);
  switch (syntax_tag(s))
    {
    case is_syntax_call:
      result = st_call(syntax_call(s));
      break;
    case is_syntax_range:
      result = strdup("range not implemented");
      break;
    case is_syntax_reference:
      result = st_reference(syntax_reference(s));
      break;
      /* add cast, sizeof here */
    default:
      pips_internal_error("unexpected syntax tag");
    }
  return result;
}
 
/*********************************************************
 * Phase main
 *********************************************************/
 
bool print_code_smalltalk(const char* module_name)
{
  FILE * out;
  string ppt, smalltalkcode, dir, filename;
  entity module;
  statement stat;
 
  /* We first build the future resource file, with a .st */
  smalltalkcode = db_build_file_resource_name(DBR_SMALLTALK_CODE_FILE, module_name, STPRETTY);
  module = module_name_to_entity(module_name);
  dir = db_get_current_workspace_directory();
  filename = strdup(concatenate(dir, "/", smalltalkcode, NULL));
  stat = (statement) db_get_memory_resource(DBR_CODE, module_name, true);
 
  set_current_module_entity(module);
  set_current_module_statement(stat);
 
  debug_on("SMALLTALK_PRETTYPRINTER_DEBUG_LEVEL");
  pips_debug(1, "Begin SMALLTALK prettyprinter for %s\n", entity_name(module));
  ppt = smalltalk_code_string(module, stat);
  pips_debug(1, "End SMALLTALK prettyprinter for %s\n", entity_name(module));
 
  pips_debug(3, "What i got is \n%s\n", ppt);
 
  /* save to file */
  out = safe_fopen(filename, "w");
  fprintf(out, "/* SMALLTALK pretty print for module %s. */\n%s", module_name, ppt);
  safe_fclose(out, filename);
 
  free(ppt);
  free(dir);
  free(filename);
 
  DB_PUT_FILE_RESOURCE(DBR_SMALLTALK_CODE_FILE, module_name, smalltalkcode);
 
  reset_current_module_statement();
  reset_current_module_entity();
 
  return true;
}