craft.c File Reference

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include "linear.h"
#include "genC.h"
#include "misc.h"
#include "properties.h"
#include "text-util.h"
#include "ri-util.h"
#include "prettyprint.h"

Include dependency graph for craft.c:

Go to the source code of this file.

Functions
static void	rewrite_modulo_expression (expression exp)
	Prettyprinter for CRAFT loops. More...
expression	remove_modulo (expression exp)
	===================================================================== More...
text	text_loop_craft (entity module, const char *label, int margin, loop obj, int n, list lr, list lidx)
	===================================================================== More...

Function Documentation

remove_modulo()

expression remove_modulo

(

expression

exp

)

=====================================================================

craft.c

Parameters

exp

xp

Definition at line 83 of file craft.c.

{
  gen_recurse(exp, expression_domain, gen_true, rewrite_modulo_expression);
 
  return(exp);
}

References exp, expression_domain, gen_recurse, gen_true(), and rewrite_modulo_expression().

Referenced by text_loop_craft().

Here is the call graph for this function:

Here is the caller graph for this function:

rewrite_modulo_expression()

static void rewrite_modulo_expression ( expression  exp )

static

Prettyprinter for CRAFT loops.

There are memory leaks here since a new expression is constructed. ====================================================================== void rewrite_modulo_expression(exp):

filter on the call "ca". It removes all the call to the modulo function.

AP 94/12/20

Definition at line 57 of file craft.c.

{
  syntax sy;
  call ca;
  entity func;
  list args;
  expression first_arg;
 
  sy = expression_syntax(exp);
  if(syntax_tag(sy) == is_syntax_call) {
    ca = syntax_call(sy);
    func = call_function(ca);
    if(strcmp(entity_local_name(func), MODULO_OPERATOR_NAME) == 0) {
      args = call_arguments(ca);
      if(gen_length(args) != 2)
        user_error("rewrite_modulo_expression",
                   "\nA modulo not with exactly 2 arguments\n");
      else {
        first_arg = EXPRESSION(CAR(args));
        expression_syntax(exp) = expression_syntax(first_arg);
      }
    }
  }
}

References call_arguments, call_function, CAR, entity_local_name(), exp, EXPRESSION, expression_syntax, gen_length(), is_syntax_call, MODULO_OPERATOR_NAME, syntax_call, syntax_tag, and user_error.

Referenced by remove_modulo().

Here is the call graph for this function:

Here is the caller graph for this function:

text_loop_craft()

text text_loop_craft	(	entity	module,
		const char*	label,
		int	margin,
		loop	obj,
		int	n,
		list	lr,
		list	lidx
	)

=====================================================================

Parameters

module	odule
label	abel
margin	argin
obj	bj
lr	r
lidx	idx

Definition at line 92 of file craft.c.

{
  text result_text = make_text(NIL);
  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_craft(module, label, margin,
                                  instruction_loop(i), n, lr, lidx);
    }
  }
  else {
    list pc, lli, llr, args, new_lli = NIL;
    unformatted u;
    int c;
    char *comment;
    expression lhs_exp = expression_undefined;
    syntax lhs_sy;
    
    args = call_arguments(instruction_call(i));
    if(!ENDP(args))
      lhs_exp = copy_expression(EXPRESSION(CAR(args)));
    else
      user_error("text_loop_craft",
                 "Call to an assign with no argument\n");
 
    lhs_sy = expression_syntax(lhs_exp);
    if(syntax_tag(lhs_sy) != is_syntax_reference)
      user_error("text_loop_craft", "\n An lhs expression not a ref\n");
    else {
      lli = reference_indices(syntax_reference(lhs_sy));
      for(; !ENDP(lli); POP(lli)) {
        new_lli = gen_nconc(new_lli, CONS(EXPRESSION,
                                          remove_modulo(EXPRESSION(CAR(lli))),
                                          NIL));
      }
      reference_indices(syntax_reference(lhs_sy)) = new_lli;
    }
 
    // BUG: missing overflow checks
    comment = (char*) malloc(64);
    char * x = comment;
    x += sprintf(comment, "CDIR$ DOSHARED(");
    for(lli = lidx; !ENDP(lli); POP(lli)) {
      x += sprintf(x, "%s", entity_local_name(ENTITY(CAR(lli))));
      if(CDR(lli) != NIL)
        x += sprintf(x, ", ");
    }
    list pdl = NIL;
    x += sprintf(x, ") ON %s\n", words_to_string(words_expression(lhs_exp, &pdl)));
    gen_free_list(pdl);
    ADD_SENTENCE_TO_TEXT(result_text, make_sentence(is_sentence_formatted,
                                                    comment));
 
    for(lli = lidx, llr = lr, c = 0; !ENDP(lli); POP(lli), POP(llr), c++) {
      pc = CHAIN_SWORD(NIL, "DO " );
      pc = CHAIN_SWORD(pc, entity_local_name(ENTITY(CAR(lli))));
      pc = CHAIN_SWORD(pc, " = ");
      pc = gen_nconc(pc, words_loop_range(RANGE(CAR(llr)), &pdl));
      gen_free_list(pdl);
      u = make_unformatted(strdup(label), n,
                           margin+c*INDENTATION, pc);
      ADD_SENTENCE_TO_TEXT(result_text,
                           make_sentence(is_sentence_unformatted, u));
    }
    MERGE_TEXTS(result_text, text_statement(module, margin+c*INDENTATION,
                                            loop_body(obj), &pdl));
    gen_free_list(pdl);
 
    for(c = gen_length(lidx)-1; c > -1; c--) {
      ADD_SENTENCE_TO_TEXT(result_text,
                           MAKE_ONE_WORD_SENTENCE(margin+c*INDENTATION,
                                                  "ENDDO"));
    }
  }
  return(result_text);
}

References ADD_SENTENCE_TO_TEXT, call_arguments, CAR, CDR, CHAIN_SWORD, comment(), CONS, copy_expression(), ENDP, ENTITY, entity_local_name(), EXPRESSION, expression_syntax, expression_undefined, gen_free_list(), gen_length(), gen_nconc(), INDENTATION, instruction_assign_p(), instruction_call, instruction_loop, instruction_loop_p, is_sentence_formatted, is_sentence_unformatted, is_syntax_reference, loop_body, loop_index, loop_range, MAKE_ONE_WORD_SENTENCE, make_sentence(), make_text(), make_unformatted(), malloc(), MERGE_TEXTS, module, NIL, POP, RANGE, reference_indices, remove_modulo(), statement_instruction, strdup(), syntax_reference, syntax_tag, text_statement(), user_error, words_expression(), words_loop_range(), words_to_string(), and x.

Referenced by text_loop().

Here is the call graph for this function:

Here is the caller graph for this function: