macros.c

Go to the documentation of this file.

/*
 
  $Id: macros.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
/*
 * Partial Fortran statement functions support by cold expansion.
 */
 
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
 
#include "genC.h"
#include "parser_private.h"
#include "linear.h"
#include "ri.h"
#include "ri-util.h"
 
#include "misc.h"
#include "properties.h"
 
#include "syntax.h"
 
/*********************************************************** MACRO HANDLING */
 
typedef struct {
    call lhs;
    expression rhs;
} macro_t;
 
static macro_t * current_macros;
static int current_macros_size = 0;
static int current_macro_index = 0; /* next available chunk */
 
void parser_init_macros_support(void)
{
    pips_debug(5, "initializing macro-expansion support stuff\n");
 
    current_macro_index = 0; /* ??? memory leak... */
    
    if (current_macros_size==0)
    {
        current_macros_size = 10;
        current_macros = (macro_t*)
            malloc(sizeof(macro_t)*current_macros_size);
        pips_assert("malloc ok", current_macros);
    }
}
 
void parser_close_macros_support(void)
{
    pips_debug(5, "closing macro-expansion support stuff\n");
 
    for (current_macro_index--; current_macro_index>=0; current_macro_index--)
    {
        call c;
        entity macro;
 
        free_expression(current_macros[current_macro_index].rhs);
        c = current_macros[current_macro_index].lhs;
 
        macro = call_function(c);
        free_call(c);
 
        /* what about the entity? 
         * It might exist such a real top-level entity...
         * what if added as a callee...
         * the entity should be destroyed...
         * best would be to have it as a local entity,
         * and have the calles and top-level updates delayed.
         */
        remove_from_called_modules(macro);
    }
}
 
static macro_t * find_entity_macro(entity e)
{
    int i;
    for (i=0; i<current_macro_index; i++)
        if (same_entity_p(e, call_function(current_macros[i].lhs)))
            return &current_macros[i];
    
    return NULL; /* not found */
}
 
bool parser_entity_macro_p(entity e)
{
    return find_entity_macro(e)==NULL;
}
 
void parser_add_a_macro(call c, expression e)
{
    entity macro = call_function(c);
 
    pips_debug(5, "adding macro %s\n", entity_name(macro));
    pips_assert("macros support initialized", current_macros_size>0);
 
    if (current_macro_index>=current_macros_size) /* resize! */
    {
        current_macros_size*=2;
        current_macros = (macro_t*) 
            realloc(current_macros, sizeof(macro_t)*current_macros_size);
        pips_assert("realloc ok", current_macros);
    }
    
    if (find_entity_macro(macro) != NULL) {
      pips_user_warning("Macro \"%s\" is not yet defined.\n", 
                        entity_name(macro));
      ParserError("parser_add_a_macro",
                  "It may be an undeclared array.\n");
    }
 
    /* expand macros in the macro! It is ok, because
     * referenced macros must appear in preceding lines (F77 15-5, line 3-5).
     */
    parser_substitute_all_macros_in_expression(e);
 
    /* store the result.
     */
    current_macros[current_macro_index].lhs = c;
    current_macros[current_macro_index].rhs = e;
    current_macro_index++;
}
 
 
/* is there a call to some untrusted function?
 */
static bool some_call;
 
static bool call_flt(call c)
{
    value v = entity_initial(call_function(c));
    if (value_intrinsic_p(v) || value_constant_p(v) || value_symbolic_p(v))
        return true;
    /* else untrusted!
     */
    some_call = true;
    gen_recurse_stop(NULL);
    return false;
}
 
static bool untrusted_call_p(expression e)
{
    some_call = false;
    gen_recurse(e, call_domain, call_flt, gen_null);
    return some_call;
}
 
 
 
/****************************************************** MACRO SUBSTITUTION */
 
/* must take care not to substitute in an inserted expression
 */
static expression s_init = expression_undefined, s_repl = expression_undefined;
static list /* of expression */ already_subs = NIL;
 
static bool expr_flt(expression e)
{
    return !gen_in_list_p(e, already_subs);
}
 
static void expr_rwt(expression e)
{
    if (expression_equal_p(s_init, e)) 
    {
        free_syntax(expression_syntax(e));
        expression_syntax(e) = copy_syntax(expression_syntax(s_repl));
        already_subs = CONS(EXPRESSION, e, already_subs);
    }
}
 
/* substitutes occurences of initial by replacement in tree
 */
static void substitute_expression_in_expression(
    expression tree,
    expression initial,
    expression replacement)
{
    /* ifdebug(8) { */
    /*  pips_debug(8, "tree/initial/replacement\n"); */
    /*  print_expression(tree); */
    /*  print_expression(initial); */
    /*  print_expression(replacement); */
    /* } */
 
    s_init = initial; 
    s_repl = replacement;
 
    gen_recurse(tree, expression_domain, expr_flt, expr_rwt);
 
    s_init = expression_undefined;
    s_repl = expression_undefined;
}
 
void reset_substitute_expression_in_expression(void)
{
    gen_free_list(already_subs); 
    already_subs = NIL;
}
 
void parser_macro_expansion(expression e)
{
    bool warned = false;
    macro_t * def;
    call c, lhs;
    entity macro;
    expression rhs;
    list /* of expression */ lactuals, lformals;
 
    if (!expression_call_p(e)) return;
    
    c = syntax_call(expression_syntax(e));
    macro = call_function(c);
    lactuals = call_arguments(c);
 
    /* get the macro definition. */
    def = find_entity_macro(macro);
 
    if (def==NULL) {
        pips_debug(5, "no macro definition for %s\n", entity_name(macro));
        return;
    }
 
    lhs = def->lhs;
    rhs = copy_expression(def->rhs); /* duplicated, for latter subs. */
 
    pips_assert("right macro function", macro == call_function(lhs));
    
    lformals = call_arguments(lhs);
 
    pips_assert("same #args", gen_length(lactuals)==gen_length(lformals));
 
    reset_substitute_expression_in_expression();
 
    /* replace each formal by its actual.
     */
    for (; !ENDP(lactuals); POP(lactuals), POP(lformals))
    {
        expression actu, form;
 
        form = EXPRESSION(CAR(lformals)); /* MUST be a simple reference */
        pips_assert("dummy arg ok", 
                    expression_reference_p(form) &&
          ENDP(reference_indices(syntax_reference(expression_syntax(form)))));
 
        /* if the replacement is a constant, or a reference without
         * calls to external functions, it should be safe 
         */
        actu = EXPRESSION(CAR(lactuals));
 
        if (!warned && untrusted_call_p(actu)) {
            pips_user_warning("maybe non safe substitution of macro %s!\n",
                              module_local_name(macro));
            warned = true;
        }
 
        substitute_expression_in_expression(rhs, form, actu);
    }
 
    reset_substitute_expression_in_expression();
 
    /* it is important to keep the same expression, for gen_recurse use.
     */
    free_syntax(expression_syntax(e));
    expression_syntax(e) = expression_syntax(rhs);
    expression_syntax(rhs) = syntax_undefined;
    free(rhs);
}
 
 
void parser_substitute_all_macros(statement s)
{
    if (current_macro_index>0 &&
        get_bool_property("PARSER_EXPAND_STATEMENT_FUNCTIONS"))
        gen_recurse(s, expression_domain, gen_true, parser_macro_expansion);
}
 
 
void parser_substitute_all_macros_in_expression(expression e)
{
  parser_substitute_all_macros((statement)e);
}