cmfortran.c

Go to the documentation of this file.

/*
 
  $Id: cmfortran.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
/* Prettyprinter for CM FORTRAN loops.
 
   There are memory leaks here since a new expression is constructed.
 
*/
 
#include <stdio.h>
#include <string.h>
 
#include "linear.h"
 
#include "genC.h"
 
#include "text-util.h"
#include "ri-util.h"
 
#include "prettyprint.h"
 
/*======================================================================*/
cons *words_cmf_loop_range(obj)
range obj;
{
    cons *pc;
    call c = syntax_call(expression_syntax(range_increment(obj)));
 
    pc = Words_Subexpression(range_lower(obj), 0, true);
    pc = CHAIN_SWORD(pc,":");
    pc = gen_nconc(pc, Words_Subexpression(range_upper(obj), 0, true));
    if (/*  expression_constant_p(range_increment(obj)) && */
         strcmp( entity_local_name(call_function(c)), "1") == 0 )
        return(pc);
    pc = CHAIN_SWORD(pc,":");
    pc = gen_nconc(pc, Words_Expression(range_increment(obj)));
 
    return(pc);
}
 
 
/*======================================================================*/
text text_loop_cmf(module, label, margin, obj, n, lr, lidx)
     entity module;
     const char* label;
     int margin;
     loop obj;
     int n;
     list lr, lidx;
{
  text result_text = text_undefined;
  instruction i;
  entity idx;
  range r;
 
  i = statement_instruction(loop_body(obj));
  idx = loop_index(obj);
  r = loop_range(obj);
 
  lr = gen_nconc(lr, CONS(RANGE, r, NIL));
  lidx = gen_nconc(lidx, CONS(ENTITY, idx, NIL));
 
  if(!instruction_assign_p(i)) {
    if(instruction_loop_p(i)) {
      result_text = text_loop_cmf(module, label, margin,
                                  instruction_loop(i), n, lr, lidx);
    }
  }
  else {
    list pc, lli, llr;
    unformatted u;
 
    pc = CHAIN_SWORD(NIL, "FORALL(");
    for(lli = lidx, llr = lr; !ENDP(lli); POP(lli), POP(llr)) {
      pc = CHAIN_SWORD(pc, entity_local_name(ENTITY(CAR(lli))));
      pc = CHAIN_SWORD(pc, " = ");
      pc = gen_nconc(pc, words_cmf_loop_range(RANGE(CAR(llr))));
      if(CDR(lli) != NIL)
        pc = CHAIN_SWORD(pc, ", ");
    }
    pc = CHAIN_SWORD(pc, ") ");
    pc = gen_nconc(pc, Words_Call(instruction_call(i), 0, true, true));
    u = make_unformatted(strdup(label), n, margin, pc) ;
    result_text = make_text(CONS(SENTENCE,
                                 make_sentence(is_sentence_unformatted,
                                               u),
                                 NIL));
  }
  return(result_text);
}