static char *rcs_version = "gen.c V$Revision: 1.2 $";
#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.

// I'm in two minds as to whether we need a distinction among:
//  lvalue (LHS of assignment)
//  rvalue (simple value in an expression)
//  parameter to a procedure
//  automatic fetch through a pointer
//  address of an lvalue (RHS of a map)
// - well, they are distinct, but the question is how to specify
// them for output and what to put in the AST.  I.e. is the output
// just %N (node) and all asts are evalated the same, but with various
// modifying nodes at the top of the tree, or do we have different
// codes for dump_code for the different contexts, i.e. %L %R %A and %P.


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;

      // This might need to use the Descriptor[] array...
      detuple(tuple, &AST_check_op, &opsym, &param1);

      if (REQUIRES_AUTO_DEREF(param1)) param1 = mktuple(AST_INDIRECT_THROUGH, param1);

      switch (opsym) {
        case 'v':
        if (BASE_TYPE(param1) == T_INTEGER) {
          dump_code("_imp_IMOD(%N)", param1);
        } else {
          dump_code("_imp_MOD(%N)", param1);
        }
        break;
        
        case '\\': // NOT
          dump_code("(~(%N))", param1);
          break;
          
        case 'U': // NEGATE
          dump_code("(-(%N))", param1);
          break;
          
      }
      break;
    }

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

      switch(opsym) {
        case 'u': // ADDA
        case 'q': // SUBA
          // param1 must be an lvalue
          //if (REQUIRES_AUTO_DEREF(param2)) param2 = mktuple(AST_INDIRECT_THROUGH, param2);
          dump_code("((%L) %s (%R))", param1, operator[opsym], param2);        
          break;

        case '.':
          if (REQUIRES_AUTO_DEREF(param1)) param1 = mktuple(AST_INDIRECT_THROUGH, param1);
          if (REQUIRES_AUTO_DEREF(param2)) param2 = mktuple(AST_INDIRECT_THROUGH, param2);
          dump_code("_imp_join((_imp_string)%L,(_imp_string)%L)", param1, param2);
          break;

        case 'X':
          if (REQUIRES_AUTO_DEREF(param1)) param1 = mktuple(AST_INDIRECT_THROUGH, param1);
          if (REQUIRES_AUTO_DEREF(param2)) param2 = mktuple(AST_INDIRECT_THROUGH, param2);
          dump_code("_imp_IEXP(%L, %L)", param1, param2);
          break;

        case 'x':
          if (REQUIRES_AUTO_DEREF(param1)) param1 = mktuple(AST_INDIRECT_THROUGH, param1);
          if (REQUIRES_AUTO_DEREF(param2)) param2 = mktuple(AST_INDIRECT_THROUGH, param2);
          dump_code("_imp_REXP(%L, %L)", param1, param2);
          break;

        default:
          if (REQUIRES_AUTO_DEREF(param1)) param1 = mktuple(AST_INDIRECT_THROUGH, param1);
          if (REQUIRES_AUTO_DEREF(param2)) param2 = mktuple(AST_INDIRECT_THROUGH, param2);
          dump_code("((%N) %s (%L))", 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);
      if (REQUIRES_AUTO_DEREF(sourcestring)) sourcestring = mktuple(AST_INDIRECT_THROUGH, sourcestring); // <-- perhaps %L should do that
      
      dump_code("_imp_resolve(%L, ", 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);
      
      if (REQUIRES_AUTO_DEREF(arrayindex)) arrayindex=mktuple(AST_INDIRECT_THROUGH, 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[%N]", array, arrayindex);
        } else {
          if (USERFIELD(LB, 0) < 0) {
            dump_code("(%N+%d)[%N]", array, -USERFIELD(LB, 0), arrayindex);
          } else {
            dump_code("(%N-%d)[%N]", array, USERFIELD(LB, 0), arrayindex);
          }
        }
      } else if (boundspair != 0) {
        detuple(boundspair, &check_bounds_op, &LB, &UB);
        if (IS_ZERO(LB)) {
          dump_code("%N[%N]", array, arrayindex);
        } else if (IS_ICONST(LB)) {
          if (USERFIELD(LB, 0) < 0) {
            dump_code("(%N+%d)[%N]", array, -USERFIELD(LB, 0), arrayindex);
          } else {
            dump_code("(%N-%d)[%N]", array, USERFIELD(LB, 0), arrayindex);
          }
        } else {
          dump_code("(%N)[%N]", mktuple(AST_BINOP, '-', array, LB), arrayindex);
        }
      } else if (IS_ARRAY_NAME(array)) {        // So lower bound is implicitly 0
        dump_code("%N[%N]", array, arrayindex);
      } else {
        dump_code("/* D: BUG. BOUNDS INFO MISSING boundspair=%d dopevector=%d */", boundspair, dopevector);
        dump_code("%N[%N]", 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);
        if (REQUIRES_AUTO_DEREF(index)) index=mktuple(AST_INDIRECT_THROUGH, index);
        ASTIDX LB, UB;
        int check_op;
        detuple(boundspair, &check_op, &LB, &UB);
        if (IS_ICONST(LB) && IS_ZERO(LB)) {
          dump_code("[%N]", 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);

      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*/ "%N", mktuple(AST_ADDRESS_OF, source));
        }
      } else { /*FP is scalar*/
        if (REQUIRES_AUTO_DEREF(source)) source = mktuple(AST_INDIRECT_THROUGH, source);
        dump_code(/*scalar value*/"%N", source);
      }
      break;
    }

    case AST_LVALUE: {
      ASTIDX var;
      int tag;
      detuple(tuple, &AST_check_op, &var);
      detuple(var, &AST_check_op, &tag);
      dump_code("%s", pooltostr(C_NAME_IDX(Descriptor[tag])));
      break;
    }

    case AST_RVALUE: {
      int tag;
      ASTIDX var;
      detuple(tuple, &AST_check_op, &var);
      detuple(var, &AST_check_op, &tag);
      if (   AST_check_op == AST_VAR
          && FORM(tuple) == F_SIMPLE // &&   (!IS_A_POINTER(Descriptor[tag]))
          && (BASE_TYPE(Descriptor[tag]) == T_INTEGER)
          && PARM_UNASS 
         ) {
        dump_code("/*RV*/_U(%s)", pooltostr(C_NAME_IDX(Descriptor[tag])));
      } else {
        dump_code("%s", pooltostr(C_NAME_IDX(Descriptor[tag])));
      }
      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",
              safe_astname(AST_op), __FILE__);
      exit(1);
  }

}
