static char *rcs_version = "gen.c V$Revision: 1.7 $";
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "i2c.h"

// Generate the C code corresponding to a data object AST
// Similar to codegen but for a subset of the AST items.

// This is the start of a restructuring to improve some endemic problems
// Type propogation and AST optimisations are done in mktuple.

// TO DO: statements like bytename++1 = 'x' cause a translator crash.

void codegen_data(ASTIDX tuple /* , gentype wanted */ ) {
  int AST_op = OP(tuple);
  ASTIDX AST_check_op;

  switch (AST_op) {

    case AST_ICONST: {
      int iconst;
      detuple(tuple, &AST_check_op, &iconst);
      if (iconst < 0) {
        // Although the original ICode was for positive integers only.
        // by the time we see an Iconst it may be negative.  The brackets
        // protect us from operator ambiguity with the '-' ...
        dump_code("(%d)", iconst);
      } else {
        dump_code("%d", iconst);
      }
      break;
    }
      
    case AST_RCONST: {
      StrpoolIDX rconstIDX;
      detuple(tuple, &AST_check_op, &rconstIDX);
      char *reals = pooltostr(rconstIDX);
      if (*reals == '-') {
        dump_code("(%s)", reals);
      } else {
        dump_code("%s", reals);
      }
      break;
    }

    case AST_ISTRINGCONST: {
      StrpoolIDX isconstIDX;
      detuple(tuple, &AST_check_op, &isconstIDX);
      dump_code("_imp_str_literal(");
      dump_imp_to_c_string(pooltostr(isconstIDX));
      dump_code(")");
      break;
    }

    case AST_MONOP: {
      int opsym;
      ASTIDX param1;
      detuple(tuple, &AST_check_op, &opsym, &param1);
      switch (opsym) {
        case 'v':
        if (BASE_TYPE(param1) == T_INTEGER) {
          dump_code("_imp_IMOD(%V)", param1);
        } else {
          dump_code("_imp_MOD(%V)", param1);
        }
        break;
        
        case '\\': // NOT
          dump_code("(~(%V))", param1);
          break;
          
        case 'U': // NEGATE
          dump_code("(-(%V))", param1);
          break;
          
      }
      break;
    }

    case AST_BINOP: {
      int opsym;
      ASTIDX param1, param2;
      detuple(tuple, &AST_check_op, &opsym, &param1, &param2);

      switch(opsym) {
        /*
          This confirms that C does type coercion bottom-up - 5/3 looks
          like two ints so the result of that subexpression is 1, not 1.66666
          and therefore the output is 1.5 rather than 2.16666

          There is no direct parallel of this problem in Imp because Imp has
          separate '/' and '//' operators for integer and real division, and
          I don't think there are any other operators that could exhibit
          different behaviour by treating its arguments as integers rather
          than reals.  However this is an idiosyncracy of C which we must
          be aware of when translating Imp to C!  (Explicit casts will be
          necessary for '3/5' or any operands of '/' that are typed as
          integers.

          f = 5/3 + 0.5;
          fprintf(stderr, "%2.8f\n", f);
         */
        case 'Q': // real divide
          dump_code("(double)((double)(%V) %s (double)(%V))", param1, operator[opsym], param2);        
          break;

        case '/': // integer divide   Not sure this is the way to code this.  May need floor or some such.
          dump_code("(long)((long)(%V) %s (long)(%V))", param1, operator[opsym], param2);        
          break;

        case 'u': // ADDA
        case 'q': // SUBA
          // param1 must be an lvalue.  Does param2 have to be %R or would %V or %N suffice?
          dump_code("((%L) %s (%R))", param1, operator[opsym], param2);        
          break;

        case '.':
          dump_code("_imp_join((_imp_string)%V,(_imp_string)%V)", param1, param2);
          break;

        case 'X':
          dump_code("_imp_IEXP(%V, %V)", param1, param2);
          break;

        case 'x':
          dump_code("_imp_REXP(%V, %V)", param1, param2);
          break;

        default:
          dump_code("((%V) %s (%V))", param1, operator[opsym], param2);        
          break;
      }
      break;
    }

    case AST_VAR: {
      int tag;
      // base-level rpresentation of a tag
      detuple(tuple, &AST_check_op, &tag);
      dump_code("%s", pooltostr(C_NAME_IDX(Descriptor[tag])));
      break;
    }

    case AST_CALL: {
      ASTIDX proc, actualparameterlist, formalparameterlist;
      detuple(tuple, &AST_check_op, &proc);
      formalparameterlist = FORMAL_PARAM_LIST(proc);
      actualparameterlist = ACTUAL_PARAM_LIST(proc);

      if ((FORM(proc) == F_MAP)
          && ((LINKAGE(proc) == X_PERM || LINKAGE(proc) == X_PRIM)
              && (strcmp(pooltostr(C_NAME_IDX(proc)), "RECORD")==0))) {
        // special case handling for recordname == RECORD(0)
        dump_code("/*F_MAP2*/*(char *)");
        // Well, it's ugly, but it seems to have done the trick...
      }
      
      dump_code("%s(", pooltostr(C_NAME_IDX(proc)));
      {
        int count;
        detuple(actualparameterlist, &AST_check_op, &count);
        if (count != 0) {
          for (int i = 0; i < count; i++) {
            ASTIDX actualparam = EXTRAFIELD(actualparameterlist, i);
            ASTIDX formalparam = EXTRAFIELD(formalparameterlist, i);
            ASTIDX pass_parameter = mktuple(AST_PASS_PARAMETER, actualparam, formalparam);
            dump_code("%N", pass_parameter); if (i < count - 1) dump_code(", ");
          }
        }
      }
      dump_code(")");
      if (FORM(proc) == F_ROUTINE) dump_code(";\n");

      break;
    }

    case AST_RESOLVE: {
      ASTIDX strtomatch, sourcestring, opd1, opd2;
      int OPD1, OPD2;
      detuple(tuple, &AST_check_op, &strtomatch, &sourcestring, &OPD1, &OPD2, &opd1, &opd2);
      
      dump_code("_imp_resolve(%V, ", sourcestring);
      if (OPD1) dump_code("%A, ", opd1); else dump_code("0 /*NULL*/, ");
      dump_code("%L, ", strtomatch);
      if (OPD2) dump_code("%A)", opd2); else dump_code("0 /*NULL*/)");
      break;
    }

    case AST_ADDRESS_OF: {
      ASTIDX var; //, tag;
      detuple(tuple, &AST_check_op, &var);

      if (IS_A_POINTER(var)) {
        dump_code(/*address_of*/ "%N", var);
      } else {
        dump_code("&%N", var);
      }
      break;
    }

    case AST_INDIRECT_THROUGH: {
      int tag_op;
      ASTIDX var, tag;
      detuple(tuple, &AST_check_op, &var);
      detuple(var, &tag_op, &tag);

      if (IS_A_POINTER(var) && FORM(var) != F_ARRAY_NAME) {
        dump_code(/*indirect_through=Y*/ "*%N", var);
      } else {
        dump_code(/*indirect_through=N*/ "%N", var);
      }
      break;
    }

    case AST_FIELDSELECT: {
      ASTIDX record, field;
      detuple(tuple, &AST_check_op, &record, &field);
      if (IS_A_POINTER(record)) {
        dump_code("%N->%N", record, field);
      } else {
        dump_code("%N.%N", record, field);
      }
      break;
    }

    case AST_ARRAYACCESS: {
      int dims=0;
      ASTIDX array, arrayindex;
      detuple(tuple, &AST_check_op, &array, &arrayindex);
      
      ASTIDX dopevector = DOPEVECTOR(array);
      ASTIDX boundspair = BOUNDS1D(array);
      ASTIDX LB, UB;
      int check_dv_op, check_bounds_op;
      
      if (dopevector != 0) {
        fprintf(stderr, "\n\n\n***************** THIS SECTION APPARENTLY CANNOT BE REMOVED AFTER ALL!!! ******************\n\n\n");
        dump_code("/* BUG! I thought this section in %s:%d was not being executed.  I was wrong. */ ??? ", __FILE__, __LINE__);
        
        detuple(dopevector, &check_dv_op, &dims);
        boundspair = EXTRAFIELD(dopevector, 0);
        detuple(boundspair, &check_bounds_op, &LB, &UB);
        if (dims != 1) {
          dump_code("/* *** %d-D arrays not yet handled! *** */", dims);
        }

        if (OP(LB) == AST_ICONST && USERFIELD(LB, 0) == 0) {
          dump_code("%N[%V]", array, arrayindex);
        } else {
          if (USERFIELD(LB, 0) < 0) {
            dump_code("(%N+%d)[%V]", array, -USERFIELD(LB, 0), arrayindex);
          } else {
            dump_code("(%N-%d)[%V]", array, USERFIELD(LB, 0), arrayindex);
          }
        }
      } else if (boundspair != 0) {
        detuple(boundspair, &check_bounds_op, &LB, &UB);
        if (IS_ZERO(LB)) {
          dump_code("%N[%V]", array, arrayindex);
        } else if (IS_ICONST(LB)) {
          if (USERFIELD(LB, 0) < 0) {
            dump_code("(%N+%d)[%V]", array, -USERFIELD(LB, 0), arrayindex);
          } else {
            dump_code("(%N-%d)[%V]", array, USERFIELD(LB, 0), arrayindex);
          }
        } else {
          dump_code("(%N)[%V]", mktuple(AST_BINOP, '-', array, LB), arrayindex);
        }
      } else if (IS_ARRAY_NAME(array)) {        // So lower bound is implicitly 0
        dump_code("%N[%V]", array, arrayindex);
      } else {
        dump_code("/* D: BUG. BOUNDS INFO MISSING boundspair=%d dopevector=%d */", boundspair, dopevector);
        dump_code("%N[%V]", array, arrayindex);
      }
      break;
    }

    case AST_DYNAMICARRAYACCESS: {
      ASTIDX array, index_list;
      detuple(tuple, &AST_check_op, &array);
      ASTIDX dopevector = DOPEVECTOR(array);

      index_list = INDEX_LIST(array);
      
      int dims = USERFIELD(index_list, 0);
      if (IS_ARRAY_NAME(array)) {
        dump_code("(*N)", array);
      } else {
        dump_code("%N", array);
      }

      for (int dim = 1; dim <= dims; dim++) {
        ASTIDX boundspair = EXTRAFIELD(dopevector, dim-1); /* '-1' to be tidied up */
        ASTIDX index = USERFIELD(index_list, dim);
        ASTIDX LB, UB;
        int check_op;
        detuple(boundspair, &check_op, &LB, &UB);
        if (IS_ICONST(LB) && IS_ZERO(LB)) {
          dump_code("[%V]", index);
        } else {
          //dump_code("[(%N)-(%N)]", index, LB);
          dump_code("[%N]", mktuple(AST_BINOP, '-', index, LB));
        }
      }
      
      break;
    }

    case AST_PASS_PARAMETER: {
      ASTIDX paramop, actop, actualparam, source, formalparam, tagop, formalparamtag;
      detuple(tuple, &paramop, &actualparam, &formalparam);
      detuple(actualparam, &actop, &source);
      detuple(formalparam, &tagop, &formalparamtag);

      // Passing a procedure as a parameter needs to be added.
      // 
      if (IS_ARRAY_NAME(formalparam)) {
        ASTIDX boundspair = BOUNDS1D(source);
        ASTIDX dopevector = DOPEVECTOR(source);
        ASTIDX LB, UB;
        int /*check_dv_op,*/ check_bounds_op;
        
        if (boundspair != 0) { // pass 1-D array with static bounds as a parameter
          
          detuple(boundspair, &check_bounds_op, &LB, &UB);

          if (IS_ZERO(LB)) {
            dump_code("&%N[0]", source);
          } else if (IS_ICONST(LB)) {
            if (USERFIELD(LB, 0) < 0) {
              dump_code("/*is_array_name4*/ &((%N+%d)[0])", source, -USERFIELD(LB, 0));
            } else {
              dump_code("/*is_array_name3*/ &((%N-%d)[0])", source, USERFIELD(LB, 0));
            }
          } else {
            dump_code("/*is_array_name2 BUG UNHANDLED EDGE CASE? */ &(%N[0])", mktuple(AST_BINOP, '-', source, LB));
          }
          
        } else if (dopevector != 0) {
          debug_types(source);

          int dims = USERFIELD(dopevector, 0);
          if (dims != 1) {
            fprintf(stderr, "* IMPLEMENTATION RESTRICTION: cannot pass arrays of %d dimensions as a parameter.\n", dims);
          }
          if (IS_ARRAY_NAME(source)) {
            dump_code("%s", pooltostr(C_NAME_IDX(source)));
          } else {
            dump_code("&%s", pooltostr(C_NAME_IDX(source)));
          }
          for (int dim = 1; dim <= dims; dim++) {
            ASTIDX boundspair = EXTRAFIELD(dopevector, dim-1); // '-1' to be tidied up
            ASTIDX LB, UB;
            int check_op;
            detuple(boundspair, &check_op, &LB, &UB);
            dump_code("[-(%N)]", LB);
          }
        } else {
          if (REQUIRES_AUTO_DEREF(source)) {
            dump_code("/*is_array_name_param2 BUG? */ &%N[0]", source);
          } else {
            dump_code("/*is_array_name_param1 BUG? */ &%N[0]", source);
          }
        }
        
      } else if (IS_NAME(formalparam) /*FP is a %name*/) {
        if (IS_NAME(source) /*source is a %name*/) { // name
          dump_code(/*is_name1*/ "%N", source);
        } else if (FORM(source) == F_MAP) {          // map
          dump_code(/*map*/ "%N", source);
        } else {                                     // scalar
          dump_code(/*is_name2*/ "%A", source);
          // was dump_code(/*is_name2*/ "%N", mktuple(AST_ADDRESS_OF, source));
        }
      } else { /*FP is scalar*/
        dump_code(/*scalar value*/"%V", source);
      }
      break;
    }

    case AST_CAST: {
      ASTIDX var;
      StrpoolIDX cast_string;
      detuple(tuple, &AST_check_op, &var, &cast_string);

      dump_code(/*C2*/"%s(%N)", pooltostr(cast_string), var);
      break;
    }

    case AST_BRACKET: {
      ASTIDX var;
      detuple(tuple, &AST_check_op, &var);
      dump_code("(%N)", var);
      break;
    }

    case AST_UNASS_CHECK: {
      ASTIDX var;
      detuple(tuple, &AST_check_op, &var);
      dump_code("%N", var);
      break;
    }

    default:
      fprintf(stderr,
              "codegen_data: %s not yet implemented in %s\n (does this program use procedure parameters?)\n",
              safe_astname(AST_op), __FILE__);
      exit(1);
  }

}
