print_code_smalltalk.c File Reference

#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"
#include "smalltalk-defs.h"

Include dependency graph for print_code_smalltalk.c:

Go to the source code of this file.

Data Structures
struct	s_ppt

Macros
#define	STPRETTY   ".st"
	This phase is used for PHRASE project. More...
#define	RESULT_NAME   "result"
#define	current_module_is_a_function()    (entity_function_p(get_current_module_entity()))

Typedefs
typedef string(*	prettyprinter) (string, list)

Functions
static string	st_statement (statement s)
	This method returns Smalltalk-like string representation (pretty-print) for a statement s. More...
static string	st_sequence (sequence seq)
	This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Sequence Statement (an ordered set of sequential statements) More...
static string	st_call (call c)
	This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Call Statement (a code line) More...
static string	st_expression (expression)
static string	st_reference (reference r)
	This function return a string representation of a reference r. More...
static string	st_test (test t)
	This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Test Statement (IF/THEN/ELSE) More...
static string	st_loop (loop l)
	This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Loop Statement (DO...ENDDO) More...
static string	st_whileloop (whileloop w)
	This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a While-Loop Statement (DO WHILE...ENDDO) More...
static string	st_forloop (forloop f)
	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 !!!) More...
static string	st_entity_local_name (entity var)
	Return beautified string representing name for entity var. More...
static string	st_brace_expression_as_string (expression exp)
	Return string representing expression enclosed by parenthesis. More...
static string	st_dimension_reference_as_string (dimension dim, expression old_expression)
	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. More...
static string	st_dimension_bound_as_string (dimension dim)
	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. More...
static string	st_dim_string (string svar, list ldim)
	Return string representing array initialization for variable svar in SMALLTALK. More...
static string	c_basic_string (basic b)
	Return a string C-like representation of basic b. More...
static string	st_declaration (entity var)
	Return a string representing Smalltalk declaration for entity (constant or variable) var NB: old function this_entity_cdeclaration(entity var) More...
static string	st_declaration_init (entity var)
	Return a string representing Smalltalk declaration initialisation for entity (constant or variable) var. More...
static string	st_declaration_comment (entity var)
	Return a string representing Smalltalk declaration initialisation for entity (constant or variable) var. More...
static bool	constant_p (entity e)
	This function return a bool indicating if related entity e represents a constant. More...
static bool	variable_p (entity e)
	This function return a bool indicating if related entity e represents a variable. More...
static bool	argument_p (entity e)
	This function return a bool indicating if related entity e represents an argument. More...
static string	st_arguments (entity module, bool(*consider_this_entity)(entity), string separator, bool lastsep)
	Return string representing arguments declaration written in SmallTalk style. More...
static string	st_declarations (entity module, bool(*consider_this_entity)(entity), string separator, bool lastsep)
	Return string representing variables or constants declaration written in SmallTalk style. More...
static string	st_declarations_init (entity module, bool(*consider_this_entity)(entity), string separator, bool lastsep)
	Return string representing variables or constants declaration initialisation written in SmallTalk style. More...
static string	st_declarations_comment (entity module, bool(*consider_this_entity)(entity), string separator, bool lastsep)
	Return string representing variables or constants declaration initialisation written in SmallTalk style. More...
static string	st_header (entity module)
	Generate header for SMALLTALK module. More...
static string	smalltalk_code_string (entity module, statement stat)
static bool	expression_needs_parenthesis_p (expression e)
	Return bool indicating if expression e must be enclosed in parenthesis. More...
static string	ppt_assignement (string in_smalltalk, list le)
	Return string representation for a list of expression le representing an assignement, asserting that le is a list of expressions containing exactly TWO expressions. More...
static string	ppt_binary (string in_smalltalk, list le)
	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. More...
static string	ppt_unary (string in_smalltalk, list le)
	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. More...
static string	ppt_unary_post (string in_smalltalk, list le)
	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. More...
static string	ppt_call (string in_smalltalk, list le)
static struct s_ppt *	get_ppt (entity f)
	Return the prettyprinter structure for SmallTalk. More...
bool	print_code_smalltalk (const char *module_name)
	print_code_smalltalk.c More...

Variables
static struct s_ppt	intrinsic_to_smalltalk []
	This data structure encodes the differents intrinsic allowing to convert fortran code to smalltalk code. More...

Macro Definition Documentation

current_module_is_a_function

#define current_module_is_a_function

(

)

(entity_function_p(get_current_module_entity()))

Definition at line 76 of file print_code_smalltalk.c.

RESULT_NAME

#define RESULT_NAME   "result"

Definition at line 74 of file print_code_smalltalk.c.

STPRETTY

#define STPRETTY   ".st"

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

Definition at line 70 of file print_code_smalltalk.c.

Typedef Documentation

prettyprinter

typedef string(* prettyprinter) (string, list)

Definition at line 958 of file print_code_smalltalk.c.

Function Documentation

argument_p()

static bool argument_p ( entity  e )

static

This function return a bool indicating if related entity e represents an argument.

Formal variables

Definition at line 679 of file print_code_smalltalk.c.

{
  /* Formal variables */
  return type_variable_p(entity_type(e)) && 
    storage_formal_p(entity_storage(e));
}

References entity_storage, entity_type, storage_formal_p, and type_variable_p.

Referenced by generic_c_words_simplified_entity(), st_header(), and words_type().

Here is the caller graph for this function:

c_basic_string()

static string c_basic_string ( basic  b )

static

Return a string C-like representation of basic b.

Definition at line 332 of file print_code_smalltalk.c.

{
  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);
}

References basic_float, basic_int, basic_tag, is_basic_bit, is_basic_derived, is_basic_float, is_basic_int, is_basic_logical, is_basic_pointer, is_basic_string, is_basic_typedef, pips_debug, pips_internal_error, SPACE, and strdup().

Referenced by st_declaration_comment().

Here is the call graph for this function:

Here is the caller graph for this function:

constant_p()

static bool constant_p ( entity  e )

static

This function return a bool indicating if related entity e represents a constant.

Constant variables

Definition at line 656 of file print_code_smalltalk.c.

{
  /* Constant variables */
  return storage_rom_p(entity_storage(e)) && 
    value_symbolic_p(entity_initial(e)) &&
    type_functional_p(entity_type(e));
}

References entity_initial, entity_storage, entity_type, storage_rom_p, type_functional_p, and value_symbolic_p.

Referenced by call_to_points_to_sinks(), constant_points_to_indices_p(), constant_reference_to_normalized_constant_reference(), expression_string_constant_p(), expression_to_points_to_cells(), expression_with_constant_signed_integer_value_p(), extended_expression_constant_p(), intrinsic_call_to_points_to_sinks(), reference_to_points_to_sinks(), reference_with_constant_indices_p(), smalltalk_code_string(), store_independent_points_to_indices_p(), ternary_intrinsic_call_to_points_to_sinks(), and unary_intrinsic_call_to_points_to_sinks().

Here is the caller graph for this function:

expression_needs_parenthesis_p()

static bool expression_needs_parenthesis_p ( expression  e )

static

Return bool indicating if expression e must be enclosed in parenthesis.

Definition at line 1243 of file print_code_smalltalk.c.

{
  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;
    }
}

References call_function, expression_syntax, get_ppt(), is_syntax_call, is_syntax_range, is_syntax_reference, s_ppt::ppt, ppt_binary(), syntax_call, and syntax_tag.

Referenced by ppt_assignement(), ppt_binary(), and st_reference().

Here is the call graph for this function:

Here is the caller graph for this function:

get_ppt()

static struct s_ppt* get_ppt ( entity  f )

static

Return the prettyprinter structure for SmallTalk.

Definition at line 1230 of file print_code_smalltalk.c.

{
  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;
}

References entity_local_name(), f(), s_ppt::intrinsic, intrinsic_to_smalltalk, and same_string_p.

Referenced by expression_needs_parenthesis_p(), and st_call().

Here is the call graph for this function:

Here is the caller graph for this function:

ppt_assignement()

static string ppt_assignement ( string  in_smalltalk, list  le  )

static

Return string representation for a list of expression le representing an assignement, asserting that le is a list of expressions containing exactly TWO expressions.

This is a scalar variable

Definition at line 974 of file print_code_smalltalk.c.

{
  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;
}

References ARRAY2D_AT_AT_PUT_1, ARRAY2D_AT_AT_PUT_2, ARRAY2D_AT_AT_PUT_3, ARRAY_AT_PUT_1, ARRAY_AT_PUT_2, CAR, CDR, CLOSEPAREN, concatenate(), DIMENSION, EMPTY, entity_type, EXPRESSION, expression_needs_parenthesis_p(), expression_syntax, free(), gen_length(), gen_nth(), is_syntax_reference, OPENPAREN, pips_assert, reference_indices, reference_variable, s1, SPACE, st_dimension_reference_as_string(), st_entity_local_name(), st_expression(), st_reference(), strdup(), syntax_reference, syntax_tag, type_variable, and variable_dimensions.

Here is the call graph for this function:

ppt_binary()

static string ppt_binary ( string  in_smalltalk, list  le  )

static

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.

Definition at line 1073 of file print_code_smalltalk.c.

{
  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;
}

References CAR, CDR, CLOSEPAREN, concatenate(), EMPTY, EXPRESSION, expression_needs_parenthesis_p(), free(), gen_length(), OPENPAREN, pips_assert, s1, SPACE, st_expression(), and strdup().

Referenced by expression_needs_parenthesis_p().

Here is the call graph for this function:

Here is the caller graph for this function:

ppt_call()

static string ppt_call ( string  in_smalltalk, list  le  )

static

Attention: not like this for io statements

Definition at line 1131 of file print_code_smalltalk.c.

{
  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;
}

ppt_unary()

static string ppt_unary ( string  in_smalltalk, list  le  )

static

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.

Definition at line 1106 of file print_code_smalltalk.c.

{
  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;
}

References CAR, concatenate(), EXPRESSION, free(), gen_length(), pips_assert, SPACE, st_expression(), and strdup().

Here is the call graph for this function:

ppt_unary_post()

static string ppt_unary_post ( string  in_smalltalk, list  le  )

static

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.

Definition at line 1121 of file print_code_smalltalk.c.

{
  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;
}

References CAR, concatenate(), EXPRESSION, free(), gen_length(), pips_assert, SPACE, st_expression(), and strdup().

Here is the call graph for this function:

print_code_smalltalk()

bool print_code_smalltalk

(

const char *

module_name

)

print_code_smalltalk.c

We first build the future resource file, with a .st

save to file

Parameters

module_name

odule_name

Definition at line 1670 of file print_code_smalltalk.c.

{
  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;
}

References concatenate(), db_build_file_resource_name(), db_get_current_workspace_directory(), db_get_memory_resource(), DB_PUT_FILE_RESOURCE, debug_on, entity_name, fprintf(), free(), module, module_name(), module_name_to_entity(), out, pips_debug, s_ppt::ppt, reset_current_module_entity(), reset_current_module_statement(), safe_fclose(), safe_fopen(), set_current_module_entity(), set_current_module_statement(), smalltalk_code_string(), STPRETTY, and strdup().

Here is the call graph for this function:

smalltalk_code_string()

static string smalltalk_code_string ( entity  module, statement  stat  )

static

HEAD generates the header

Generates the variables declarations

What about declarations associated to statements ???

Generates the constant declarations

Generates the variables declarations initialisation

Generates the variables declarations comments

Generates the constant declarations initialisation

Generates the body

Definition at line 860 of file print_code_smalltalk.c.

{
  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;
}

References BEGINTEMPVAR, concatenate(), constant_p(), ENDTEMPVAR, free(), ifdebug, module, NL, print_entities(), print_statement(), printf(), SPACE, st_declarations(), st_declarations_comment(), st_declarations_init(), st_header(), st_statement(), statement_declarations, strdup(), STSEMICOLON, and variable_p().

Referenced by print_code_smalltalk().

Here is the call graph for this function:

Here is the caller graph for this function:

st_arguments()

static string st_arguments ( entity  module, bool(*)(entity)  consider_this_entity, string  separator, bool  lastsep  )

static

Return string representing arguments declaration written in SmallTalk style.

Assert that entity represent a value code

Definition at line 691 of file print_code_smalltalk.c.

{
  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;
}

References code_declarations, concatenate(), debug(), ENTITY, entity_initial, free(), MAP, module, pips_assert, st_entity_local_name(), strdup(), value_code, and value_code_p.

Referenced by st_header().

Here is the call graph for this function:

Here is the caller graph for this function:

st_brace_expression_as_string()

static string st_brace_expression_as_string ( expression  exp )

static

Return string representing expression enclosed by parenthesis.

Definition at line 132 of file print_code_smalltalk.c.

{
  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;
}

References brace_expression_p(), call_arguments, CLOSEBRACKET, concatenate(), exp, EXPRESSION, expression_syntax, expression_to_string(), MAP, OPENBRACKET, strdup(), and syntax_call.

Referenced by st_declaration_init().

Here is the call graph for this function:

Here is the caller graph for this function:

st_call()

static string st_call ( call  c )

static

This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Call Statement (a code line)

special case...

Definition at line 1532 of file print_code_smalltalk.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;
}

References s_ppt::c, call_arguments, call_constant_p, call_function, current_module_is_a_function, entity_local_name(), entity_main_module_p(), free(), get_current_module_entity(), get_ppt(), s_ppt::ppt, RESULT_NAME, RETURNVALUE, same_string_p, SPACE, st_entity_local_name(), and strdup().

Referenced by st_expression(), and st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

st_declaration()

static string st_declaration ( entity  var )

static

Return a string representing Smalltalk declaration for entity (constant or variable) var NB: old function this_entity_cdeclaration(entity var)

Definition at line 421 of file print_code_smalltalk.c.

{
  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("");
}

References concatenate(), entity_local_name(), entity_storage, entity_type, free(), is_storage_rom, is_type_enum, is_type_struct, is_type_union, is_type_variable, st_entity_local_name(), storage_tag, strdup(), and type_tag.

Referenced by st_declarations(), and st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

st_declaration_comment()

static string st_declaration_comment ( entity  var )

static

Return a string representing Smalltalk declaration initialisation for entity (constant or variable) var.

Definition at line 591 of file print_code_smalltalk.c.

{
  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;
}

References c_basic_string(), COMMENT, comment(), concatenate(), entity_name, entity_type, free(), gen_length(), is_type_enum, is_type_struct, is_type_union, is_type_variable, pips_debug, st_entity_local_name(), strdup(), type_tag, type_variable, variable_basic, and variable_dimensions.

Referenced by st_declarations_comment().

Here is the call graph for this function:

Here is the caller graph for this function:

st_declaration_init()

static string st_declaration_init ( entity  var )

static

Return a string representing Smalltalk declaration initialisation for entity (constant or variable) var.

This is a constant, we must initialize it

This variable must be initialized Anyway, i don't know how to initialize a variable at declaration in Fortran !!!

Definition at line 473 of file print_code_smalltalk.c.

{
  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;
}

References brace_expression_p(), concatenate(), constant_int, constant_int_p, entity_initial, entity_name, entity_storage, entity_type, exp, expression_to_string(), free(), gen_length(), int2a(), is_storage_rom, is_type_enum, is_type_struct, is_type_union, is_type_variable, pips_debug, SETVALUE, SPACE, st_brace_expression_as_string(), st_dim_string(), st_entity_local_name(), storage_tag, strdup(), symbolic_constant, type_tag, type_variable, value_constant, value_constant_p, value_expression, value_expression_p, value_symbolic, value_symbolic_p, value_undefined_p, and variable_dimensions.

Referenced by st_declarations_init().

Here is the call graph for this function:

Here is the caller graph for this function:

st_declarations()

static string st_declarations ( entity  module, bool(*)(entity)  consider_this_entity, string  separator, bool  lastsep  )

static

Return string representing variables or constants declaration written in SmallTalk style.

Assert that entity represent a value code

Definition at line 726 of file print_code_smalltalk.c.

{
  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;
}

References code_declarations, concatenate(), debug(), ENTITY, entity_initial, free(), MAP, module, pips_assert, st_declaration(), st_entity_local_name(), strdup(), value_code, and value_code_p.

Referenced by smalltalk_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

st_declarations_comment()

static string st_declarations_comment ( entity  module, bool(*)(entity)  consider_this_entity, string  separator, bool  lastsep  )

static

Return string representing variables or constants declaration initialisation written in SmallTalk style.

Assert that entity represent a value code

Definition at line 801 of file print_code_smalltalk.c.

{
  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;
}

References code_declarations, concatenate(), debug(), ENTITY, entity_initial, free(), MAP, module, pips_assert, st_declaration_comment(), st_entity_local_name(), strdup(), value_code, and value_code_p.

Referenced by smalltalk_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

st_declarations_init()

static string st_declarations_init ( entity  module, bool(*)(entity)  consider_this_entity, string  separator, bool  lastsep  )

static

Return string representing variables or constants declaration initialisation written in SmallTalk style.

Assert that entity represent a value code

Definition at line 761 of file print_code_smalltalk.c.

{
  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;
}

References code_declarations, concatenate(), debug(), ENTITY, entity_initial, free(), MAP, module, pips_assert, st_declaration_init(), st_entity_local_name(), strdup(), value_code, and value_code_p.

Referenced by smalltalk_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

st_dim_string()

static string st_dim_string ( string  svar, list  ldim  )

static

Return string representing array initialization for variable svar in SMALLTALK.

Definition at line 286 of file print_code_smalltalk.c.

{
  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;
  }
}

References ARRAY, ARRAY2D, ARRAY2D_NEW1, ARRAY2D_NEW2, ARRAY_NEW, concatenate(), DIMENSION, gen_length(), gen_nth(), pips_debug, SETVALUE, SPACE, st_dimension_bound_as_string(), and strdup().

Referenced by st_declaration_init().

Here is the call graph for this function:

Here is the caller graph for this function:

st_dimension_bound_as_string()

static string st_dimension_bound_as_string ( dimension  dim )

static

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.

Definition at line 223 of file print_code_smalltalk.c.

                                                           {
  
  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;
}

References CLOSEBRACE, concatenate(), dimension_lower, dimension_upper, EMPTY, expression_integer_value(), free(), int2a(), intptr_t, OPENBRACE, pips_debug, st_expression(), and strdup().

Referenced by st_dim_string().

Here is the call graph for this function:

Here is the caller graph for this function:

st_dimension_reference_as_string()

static string st_dimension_reference_as_string ( dimension  dim, expression  old_expression  )

static

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.

Definition at line 158 of file print_code_smalltalk.c.

                                                                                          {
 
  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;
}

References CLOSEBRACE, concatenate(), dimension_lower, EMPTY, expression_integer_value(), free(), int2a(), intptr_t, OPENBRACE, pips_debug, st_expression(), and strdup().

Referenced by ppt_assignement(), and st_reference().

Here is the call graph for this function:

Here is the caller graph for this function:

st_entity_local_name()

static string st_entity_local_name ( entity  var )

static

Return beautified string representing name for entity var.

Delete all the prefixes

Definition at line 93 of file print_code_smalltalk.c.

{
  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);
}

References current_module_is_a_function, entity_local_name(), ENUM_PREFIX, get_current_module_entity(), MAIN_PREFIX, MEMBER_SEP_STRING, pips_debug, RESULT_NAME, same_string_p, strdup(), STRUCT_PREFIX, TYPEDEF_PREFIX, and UNION_PREFIX.

Referenced by ppt_assignement(), st_arguments(), st_call(), st_declaration(), st_declaration_comment(), st_declaration_init(), st_declarations(), st_declarations_comment(), st_declarations_init(), st_header(), st_loop(), st_reference(), and st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

st_expression()

static string st_expression ( expression  e )

static

add cast, sizeof here

Definition at line 1644 of file print_code_smalltalk.c.

{
  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;
}

References expression_syntax, is_syntax_call, is_syntax_range, is_syntax_reference, pips_internal_error, st_call(), st_reference(), strdup(), syntax_call, syntax_reference, and syntax_tag.

Referenced by ppt_assignement(), ppt_binary(), ppt_unary(), ppt_unary_post(), st_dimension_bound_as_string(), st_dimension_reference_as_string(), st_forloop(), st_loop(), st_test(), and st_whileloop().

Here is the call graph for this function:

Here is the caller graph for this function:

st_forloop()

static string st_forloop ( forloop  f )

static

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 !!!)

Definition at line 1502 of file print_code_smalltalk.c.

{
  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;
}

References CLOSEBRACKET, concatenate(), f(), forloop_body, forloop_condition, forloop_increment, forloop_initialization, free(), init, NL, OPENBRACKET, SPACE, st_expression(), st_statement(), ST_WHILETRUE, strdup(), and STSEMICOLON.

Referenced by st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

st_header()

static string st_header ( entity  module )

static

Generate header for SMALLTALK module.

Generates the arguments declarations

Definition at line 834 of file print_code_smalltalk.c.

{
  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;
}

References argument_p(), COMMENT, concatenate(), entity_type, module, NL, pips_assert, SPACE, st_arguments(), st_entity_local_name(), strdup(), and type_functional_p.

Referenced by smalltalk_code_string().

Here is the call graph for this function:

Here is the caller graph for this function:

st_loop()

static string st_loop ( loop  l )

static

This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Loop Statement (DO...ENDDO)

Definition at line 1423 of file print_code_smalltalk.c.

{
  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;
}

References CLOSEBRACKET, concatenate(), expression_integer_value(), free(), int2a(), intptr_t, loop_body, loop_index, loop_range, NL, OPENBRACKET, range_increment, range_lower, range_upper, SETVALUE, SPACE, st_entity_local_name(), st_expression(), ST_LE, ST_MINUS, ST_PLUS, st_statement(), ST_WHILETRUE, strdup(), and STSEMICOLON.

Referenced by st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

st_reference()

static string st_reference ( reference  r )

static

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

This is a scalar variable, no need to manage array indices

Definition at line 1577 of file print_code_smalltalk.c.

{
  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;
 
}

References ARRAY2D_AT_AT_1, ARRAY2D_AT_AT_2, ARRAY_AT, CLOSEPAREN, COMMENT, concatenate(), DIMENSION, EMPTY, entity_type, EXPRESSION, expression_needs_parenthesis_p(), free(), gen_length(), gen_nth(), OPENPAREN, reference_indices, reference_variable, SPACE, st_dimension_reference_as_string(), st_entity_local_name(), strdup(), type_variable, and variable_dimensions.

Referenced by ppt_assignement(), and st_expression().

Here is the call graph for this function:

Here is the caller graph for this function:

st_sequence()

static string st_sequence ( sequence  seq )

static

This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Sequence Statement (an ordered set of sequential statements)

Definition at line 1400 of file print_code_smalltalk.c.

{
  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;
}

References concatenate(), current, EMPTY, free(), MAP, sequence_statements, st_statement(), STATEMENT, and strdup().

Referenced by st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

st_statement()

static string st_statement ( statement  s )

static

This method returns Smalltalk-like string representation (pretty-print) for a statement s.

nstructured u = instruction_unstructured(i);

tatement g = instruction_goto(i);

add switch, forloop break, continue, return instructions here

Definition at line 1264 of file print_code_smalltalk.c.

{
  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;
}

References COMMENT, concatenate(), debug(), ENDP, ENTITY, f(), free(), ifdebug, instruction_call, instruction_forloop, instruction_loop, instruction_sequence, instruction_tag, instruction_test, instruction_whileloop, is_instruction_call, is_instruction_forloop, is_instruction_goto, is_instruction_loop, is_instruction_sequence, is_instruction_test, is_instruction_unstructured, is_instruction_whileloop, MAP, NL, pips_debug, pips_user_warning, print_statement(), printf(), st_call(), st_declaration(), st_entity_local_name(), st_forloop(), st_loop(), st_sequence(), st_test(), st_whileloop(), statement_declarations, statement_instruction, strdup(), and STSEMICOLON.

Referenced by smalltalk_code_string(), st_forloop(), st_loop(), st_sequence(), st_test(), and st_whileloop().

Here is the call graph for this function:

Here is the caller graph for this function:

st_test()

static string st_test ( test  t )

static

This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a Test Statement (IF/THEN/ELSE)

Definition at line 1363 of file print_code_smalltalk.c.

{
  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;
}

References CLOSEBRACKET, CLOSEPAREN, concatenate(), empty_statement_p(), free(), NL, OPENBRACKET, OPENPAREN, SPACE, st_expression(), ST_IFFALSE, ST_IFTRUE, st_statement(), strdup(), STSEMICOLON, test_condition, test_false, and test_true.

Referenced by st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

st_whileloop()

static string st_whileloop ( whileloop  w )

static

This method returns Smalltalk-like string representation (pretty-print) for a statement s which is a While-Loop Statement (DO WHILE...ENDDO)

valuation eval = whileloop_evaluation(w);

Definition at line 1480 of file print_code_smalltalk.c.

{
  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;
}

References CLOSEBRACKET, concatenate(), free(), NL, OPENBRACKET, SPACE, st_expression(), st_statement(), ST_WHILETRUE, strdup(), STSEMICOLON, whileloop_body, and whileloop_condition.

Referenced by st_statement().

Here is the call graph for this function:

Here is the caller graph for this function:

variable_p()

static bool variable_p ( entity  e )

static

This function return a bool indicating if related entity e represents a variable.

Definition at line 668 of file print_code_smalltalk.c.

{
  storage s = entity_storage(e);
  return type_variable_p(entity_type(e)) &&
    (storage_ram_p(s) || storage_return_p(s));
}

References entity_storage, entity_type, storage_ram_p, storage_return_p, and type_variable_p.

Referenced by smalltalk_code_string().

Here is the caller graph for this function:

Variable Documentation

intrinsic_to_smalltalk

struct s_ppt intrinsic_to_smalltalk[]

static

This data structure encodes the differents intrinsic allowing to convert fortran code to smalltalk code.

Definition at line 1131 of file print_code_smalltalk.c.

Referenced by get_ppt().