#ifndef __FILTER_C__
#define __FILTER_C__ 1

#include "errorf.h"
#include "filter.h"
#include "showicode.h"
#include "icode2ast_data.h"
#include "stack.h"

// to do: interleaved source and line listings are getting out of sync, and I think it
// is because the %spec is picking up the line number of the body rather than the spec.

//----------------------------------------------------------------------------

IMPAST *propagate_types(IMPAST *Program) {
  return Program;
}

//----------------------------------------------------------------------------

// two filters to add:

// 1) missing %recordformatspec needs to be inserted once (currently being approximated in genimp.c)

int uses_recordformat(IMPAST *icode, IMPAST *recfm) {
  // return true if this ICode references the as-yet-undeclared recordformat.
  // If the ICode contains a sub-block, check it too.
  // Procedure DEFs can refer to the missing format in its parameter list
  IMPAST *body = NULL, *paramlist = NULL;
  if (OP(recfm) != OP_DEF) {
    fatalf("Internal error - recfm param to int uses_recordformat() was not a $DEF (it was a %s)\n", icode_name[OP(recfm)]);
  }

  /*debugf("Checking a %s ICode for references to %s {tag=0x%04x}\n",
         icode_name[OP(icode)],
         recfm->def.imp_id,
         recfm->def.tag
         );*/
  if (OP(icode) == OP_DEF) {
    IMPAST *fmt = icode->def.recordformat_field_list;
    int /*linkage,*/ type, form;
    /*int special;*/

    /*linkage = icode->def.linkage;*/
    type = icode->def.type;
    form = icode->def.form;
    /*special = icode->def.special;*/

    switch (form) {

    case F_RECORDFORMAT:
      while (fmt != NULL) {
        if (OP(fmt) == OP_DEF && fmt->def.type == T_RECORD && fmt->def.tag == 0 && fmt->def.recordformatdef == recfm->def.recordformatdef) {
          //debugf("Examine field %s\n", fmt->def.imp_id);
          return TRUE;
        }
        fmt = fmt->generic.next_icode;
      }
      break;


      // TO DO: for a FN/MAP/PRED/ROUT, if the *parameter list* of the procedure contains a recordname, then
      // return TRUE. (Really just need to look for a recordname because seeing a record would imply that the
      // full recordformat had been specified already, as this would have been enforced by pass1)

      // current code checks result types and the fn body but not the parameter list!
      
      // a typical example of something to look for might be:
      //    %routine %spec {main} HANDLEKNOWN(%record (SPECFM) %name NOWWEGOTDETAILS)
      // as in the example from recprob3.imp

      
    case F_MAP:
      // check result type
    case F_FN:
      // imp77's pass1 wouldn't allow %record(fmt)%fn fred if fmt wasn't already fully defined.  Only %name slips by.
      /*debugf("Look at fn/map result type: (def.recordformat type is %s)\n",
        icode_name[OP(recfm)]);*/

      if (icode->def.type == T_RECORD && icode->def.recordformatdef == recfm->def.recordformatdef) return TRUE;  // TO DO: check .recordformat vs .format !
      
    case F_ROUTINE:
    case F_PREDICATE:

      paramlist = icode->def.formal_params;      
      if (paramlist != NULL) {
        //debugf("Check that %s isn't used in the parameter list:\n", recfm->def.imp_id);
        while (paramlist != NULL) { 
          if (uses_recordformat(paramlist, recfm)) return TRUE;
          paramlist = paramlist->generic.next_icode;
        }
        //debugf("End of check that %s wasn't used in the parameter list.\n", recfm->def.imp_id);
      }

      
      // Now check body for references recursively
      body = icode->def.body;
      break;

      // TO DO: after run_stack, accesses to the recordformat type
      // might be happening inside top-level statements such as ASSVAL or CALL!
      // - those may not be getting caught by these tests...
      
      // all these may be objects of a record type
    case F_VOID:
    case F_SIMPLE:
    case F_NAME:
    case F_ARRAY:
    case F_ARRAY_NAME:
    case F_NAME_ARRAY:
    case F_NAME_ARRAY_NAME:
      // We are failing to match with:      %own %record (RECFM) %name FRED
      if (type == T_RECORD) {
        if (icode->def.recordformatdef == NULL && icode->def.format == recfm->def.tag) { // <-- BUGFIX TEST!
          //debugf("Matched! 0x%04x == 0x%04x\n", icode->def.format, recfm->def.tag);
          return TRUE;
        } else {
          //debugf("NO Match! 0x%04x != 0x%04x\n", icode->def.format, recfm->def.tag);
        }
      }
    }
    
  } else if (OP(icode) == OP_BEGIN) {
    body = icode->begin.body;
  }

  if (body != NULL) {
    //debugf("Check that %s isn't used somewhere in a block:\n", recfm->def.imp_id);
    while (body != NULL) {
      if (uses_recordformat(body, recfm)) return TRUE;
      body = body->generic.next_icode;
    }
    //debugf("End of check that %s wasn't used somewhere in a block.\n", recfm->def.imp_id);
  }

  return FALSE;
}

/*

This is a suitable test program and will be used as the example when illustrating points:

!
! pass1 doesn't pass the recordformatspec through, and although we can detect when
! 'recfm' is used before it has been fully specified, we can't know the original
! location where it was declared.  We have to take care when reinserting a generated
! recordformatspec to place it where it applies to all necessary uses.
!
%begin
  %recordformatspec recfm                  { recordformat spec has to be inserted here    }
  %integer i = 42                          { or here.  NOT in nest1 because then it would }
  %integermap nest1                        { already be out of scope again before the     }
    %integer filler = 17                   { decaration of 'another'                      }
    %ownrecord (recfm) %name fred
    %result == INTEGER(ADDR(fred))
  %end
  %record (recfm) %name another
  %recordformat recfm(%integer q)
  nest1 = 42
  write(nest1, 0)
  newline
%endofprogram

 */

static IMPAST *insert_recordformatspec(IMPAST *Program, IMPAST *where_used, IMPAST *def) {
  IMPAST *this = Program;
  
  //debugf("Looking for uses of recordformat %s to insert a spec for it...\n", def->def.imp_id);
  while (this != NULL && this != where_used) {

    // we want to put it in at the last possible minute at a statement boundary before 'where_used':
    if (this->generic.line != where_used->generic.line && this->generic.next_icode->generic.line == where_used->generic.line) {
      IMPAST *fmtspec = new_iast(RECFMSPEC);
      fmtspec->recfmspec.imp_id = def->def.imp_id;
      fmtspec->recfmspec.c_id = def->def.c_id;
      fmtspec->recfmspec.def = def;
      fmtspec->recfmspec.tag = def->def.tag;
      fmtspec->recfmspec.unique_tag = def->def.unique_tag;
      
      fmtspec->recfmspec.line = this->generic.line;
      if (fmtspec->recfmspec.line != NULL) fmtspec->recfmspec.line->line.lineno = 0;
      // when outputting C file, be careful not to use the line number of the format at the point of the spec...
      
      /*debugf("This should cause a recordformatspec to be output by genimp.c: %s -> DEF at %05d, tag=0x%04x, UNIQUE_TAG=0x%04x\n",
        def->def.imp_id, fmtspec->recfmspec.def->def.seqno, fmtspec->recfmspec.tag, fmtspec->recfmspec.UNIQUE_TAG);*/

      // Insert between statements:
      fmtspec->generic.next_icode = this->generic.next_icode;
      this->generic.next_icode = fmtspec;

      return Program;
      
    }
    
    this = this->generic.next_icode;
  }
  //warnf("Unable to insert recordformatspec %s so inserting at head of proglist\n", def->def.imp_id);
  
  IMPAST *fmtspec = new_iast(RECFMSPEC);
  fmtspec->recfmspec.imp_id = def->def.imp_id;
  fmtspec->recfmspec.c_id = def->def.c_id;
  fmtspec->recfmspec.def = def;
  fmtspec->recfmspec.tag = def->def.tag;
  fmtspec->recfmspec.unique_tag = def->def.unique_tag;
  fmtspec->recfmspec.line = NULL;
      
  /*debugf("This should cause a recordformatspec to be output by genimp.c: %s -> DEF at %05d, tag=0x%04x, UNIQUE_TAG=0x%04x\n",
           def->def.imp_id, fmtspec->recfmspec.def->def.seqno, fmtspec->recfmspec.tag, fmtspec->recfmspec.UNIQUE_TAG);*/

  // Insert between statements:
  fmtspec->generic.next_icode = Program;
  Program = fmtspec;

  return Program;
      
}

static IMPAST *patch_up_recordformats(IMPAST *Program, IMPAST *target) {
  // Scan from the start of Program down to (but not including) 'target',
  // looking for any places where the recordformat in 'target' was
  // referenced.  If we find one, a %recordformatspec will be required.
  IMPAST *icode = Program;
  //debugf("patch_up_recordformats()\n");
  while (icode != target) {
    if (uses_recordformat(icode, target)) {
      // We found one, so we need to generate a recordformatspec and insert it before this icode.
      return insert_recordformatspec(Program, icode, target);
    }
    icode = icode->generic.next_icode;
  }
  return Program;
}

IMPAST *handle_missing_recordformat_specs(IMPAST *Program) {
  IMPAST *this;  //, *Parent = NULL;

  // first we can through the top-level block (begin/endofprogram below) and look for a simple recordformat declaration:
  this = Program;
  //debugf("Looking for a recordformat declaration starting at %05d...\n", Program->generic.seqno);
  while (this != NULL) {
    if (OP(this) == OP_DEF) {
      if (FORM(this) == F_RECORDFORMAT && !IS_SPEC(this)) {
        // We have a recordformat declaration.  Now go back and re-scan from the
        // start of this block up to here, and see if there are any uses of this
        // recordformat.  If there are, a recordformatspec will be required.
        //debugf("Found a recordformat %s at this level.\n", this->def.imp_id);
        Program = patch_up_recordformats(Program, this);  // reassigning Program isn't going to work here :-( *** BUG *** ***TO DO***
        //debugf("Patch-up of %s done, moving on to finding more recordformats to check...\n", this->def.imp_id);
      }
    }
    //Parent = this;
    this = this->generic.next_icode;
  }
  //debugf("No more recordformat declarations at this level, I'll look in procs and blocks next...\n");
  // And after this block is done, we'll go back in and handle nested blocks and procs
  this = Program;
  while (this != NULL) {
    if ((OP(this) == OP_BEGIN) && (this->begin.body != NULL)) {
      this->begin.body = handle_missing_recordformat_specs(this->begin.body);
    } else if (OP(this) == OP_DEF && this->def.body != NULL) {
      this->def.body = handle_missing_recordformat_specs(this->def.body);
    }
    //Parent = this;
    this = this->generic.next_icode;
  }
  return Program;
}

//----------------------------------------------------------------------------

// 2) procedure parameter list needs to be moved into parameter list from code that follows within the procedure body
/*
   (do this for the top-level proglist and recursively for any procs & blocks)
   
   Find a proc/fn/map/pred DEF with spec=0 indirect=0
   
   Examine its parameter list.
   
   For each parameter that is a proc/fn/map/pred with spec=0 indirect=1
      scan the code following the DEF for a DEF with the same tag value
      (and incidentally, spec=1 indirect=1)
   
   When found, replace the DEF in the parameter list with the later one,
   and remove the later one from the chain.
   
   Let's get this working before looking at forward references for these procedures
   (which by that point ought to be relatively easy to add, by copying the updated
   DEF, but changing spec from 0 to 1.)
 */
IMPAST *handle_proc_params(IMPAST *Program) {
  IMPAST *icode = Program;  //, *Parent = NULL;

  while (icode != NULL) {

    // Handle recursion in case this code is called after blocks and procs are folded...
    if (OP(icode) == OP_BEGIN) {
      if (icode->begin.body != NULL) icode->begin.body = handle_proc_params(icode->begin.body);
    } else if (OP(icode) == OP_DEF && IS_PROCEDURE(icode)) {
      if (icode->def.body != NULL) icode->def.body = handle_proc_params(icode->def.body);
    }
    
    if (OP(icode) == OP_DEF) {
      // if we are defining a rt/fn/map/pred and the parameter list contains a rt/fn/map/pred then ...
      if (IS_PROCEDURE(icode) && (!IS_SPEC(icode)) && (!IS_INDIRECT(icode))) {
        //debugf("Examining proc %s to see if it takes any proc parameters\n", icode->def.imp_id);
        IMPAST *paramlist = icode->def.formal_params;
        while (paramlist != NULL) {
          if (OP(paramlist) == OP_DEF) {
            if (IS_PROCEDURE(paramlist) && (!IS_SPEC(paramlist)) /*&& IS_INDIRECT(paramlist)*/) {
              //debugf("It does... proc %s\n", paramlist->def.imp_id);
              // Now we search what followed <icode> for a DEF with the same tag value
              // (and incidentally, spec=1 indirect=1. Or maybe not.)
              IMPAST *follows; //, *followparent = NULL;

              if (icode->def.body != NULL) {
                follows = icode->def.body;
                //debugf("Checking the body for a spec with parameters:\n");
              } else {
                follows = icode->def.next_icode;
                //debugf("Checking the code that follows this proc DEF for a spec with parameters:\n");
              }
              
              while (OP(follows) == OP_DEF) {
                //debugf("Checking param %s\n", follows->def.imp_id);
                if (follows->def.tag == paramlist->def.tag) {
                  //debugf("Got it! (tag=0x%04x)\n", paramlist->def.tag);
                  // First, replace the subproc's spec in the enclosing proc's parameter list with this one, which now includes the subproc's parameters:
                  IMPAST *next_param = paramlist->def.next_icode;
                  memmove(paramlist, follows, sizeof(ICODE_DEF));
                  paramlist->def.ostate &= ~8; paramlist->def.is_spec = 0;  // remove the spec=1 bit!
                  paramlist->def.line = NULL;
                  // (we don't want the '%spec' to be output in the parameter
                  //  list, but we don't want a body to be output either!
                  //  However something is causing a \n to
                  //  be output after the proc spec in the param list so let's
                  //  set any body to NULL just in case...)
                  paramlist->def.body = NULL;
                  
                  paramlist->def.next_icode = next_param;
                  // And finally, remove 'follows' from the proglist, since we don't want to output that to Imp or C - it was only there for pass2 internal use.
                  follows->def.suppress = 1;
                  //debugf("Moving on to check any remaining parameters of %s\n", icode->def.imp_id);
                  break;
                }
                /*followparent = follows;*/ follows = follows->def.next_icode;
              }
            } else {
              // IS_PROCEDURE(paramlist) && (!IS_SPEC(paramlist)) && IS_INDIRECT(paramlist)
              //debugf("param %s is not a proc: IS_PROCEURE=%d IS_SPEC=%d IS_INDIRECT=%d\n", paramlist->def.imp_id, IS_PROCEDURE(paramlist), IS_SPEC(paramlist), IS_INDIRECT(paramlist));
            }
          } else if (OP(paramlist) == OP_FINISH) break;
          paramlist = paramlist->generic.next_icode;
        }
        //debugf("Param list all checked. Going back to scannng for procedures that take procedure parameters\n");
      } else {
        //debugf("(DEF %s is not a proc)\n", icode->def.imp_id);
      }
    }
    /*Parent = icode;*/ icode = icode->generic.next_icode;
  }

  return Program;
}

IMPAST *fixup_procparam_specs(IMPAST *Program) {
  IMPAST *icode = Program, *next_icode;  //, *Parent = NULL
  // This one has to be run after blocks have been folded.
  while (icode != NULL) {
    if (OP(icode) == OP_BEGIN) {
      if (icode->begin.body) icode->begin.body = fixup_procparam_specs(icode->begin.body);
    } else if (OP(icode) == OP_DEF && IS_PROCEDURE(icode)) {
      if (icode->def.body) icode->def.body = fixup_procparam_specs(icode->def.body);
      next_icode = icode->def.next_icode;
      if (IS_SPEC(icode)) {
        // Look ahead to find the actual declaration!
        IMPAST *lookahead = icode->generic.next_icode;
        while (lookahead) {
          if (OP(lookahead) == OP_DEF && lookahead->def.tag == icode->def.tag) {
            //debugf("%%spec and body found for %s! (matches %s)\n", lookahead->def.imp_id, icode->def.imp_id);
            memmove(icode, lookahead, sizeof(ICODE_DEF));
            icode->def.ostate |= 8; icode->def.is_spec = 1; // set the spec=1 bit!
            icode->def.next_icode = next_icode;
            icode->def.line = NULL;
            break;
          }
          lookahead = lookahead->generic.next_icode;
        }
      }
    }
    /*Parent = icode;*/ icode = icode->generic.next_icode;
  }
  return Program;
}

//----------------------------------------------------------------------------

IMPAST *apply_aliases(IMPAST *Program) {
  // Scan program for ALIAS opcodes preceding DEF codes, and attach the alias to the def.
  IMPAST *icode = Program, *Parent = NULL;
  while (icode != NULL) {
    if (icode->generic.opcode == OP_ALIAS) {
      if (icode->alias.next_icode->generic.opcode == OP_DEF) {
        icode->alias.next_icode->def.alias = icode;
        //fflush(stdout); fprintf(stderr, "! Setting alias of %s to %s\n", icode->alias.next_icode->def.imp_id, icode->alias.alias);
        if (Parent != NULL) {
          Parent->generic.next_icode = icode->alias.next_icode; // unpick the  ALIAS opcode
        } else {
          Program = icode->alias.next_icode;
        }
      } else {
        fflush(stdout); fprintf(stderr, "? ALIAS at %05d not followed by DEF at %05d\n", icode->generic.seqno, icode->generic.next_icode->generic.seqno);
      }
    }
    Parent = icode;
    icode = icode->generic.next_icode;
  }
  return Program;
}


//----------------------------------------------------------------------------

IMPAST *assign_linenos(IMPAST *Program) {
  // Scan program for LINE opcodes and apply to following icodes.
  IMPAST *icode = Program, *line = NULL, *Parent = NULL;
    
  while (icode != NULL) {
      
    if (icode->generic.opcode == OP_LINE) {
      line = icode;
      if (Parent != NULL) {
        Parent->generic.next_icode = icode->generic.next_icode; // remove this LINE directive from the program chain
        icode = icode->generic.next_icode;
        // Parent remains the same...
      } else {
        Program = icode->generic.next_icode; // but initial icode is now whatever followed that initial LINE
        icode = icode->generic.next_icode;
        // Parent remains NULL...
      }
    } else {
      icode->generic.line = line; // usually last LINE icode, but could be NULL...
      Parent = icode;
      icode = icode->generic.next_icode; // continue to tag all following opcodes with the last noted LINE.
    }
  }
  return Program;
}


//----------------------------------------------------------------------------

IMPAST *assign_formal_params(IMPAST *Program) {
  IMPAST *icode = Program;
  IMPAST *following = NULL;
  
  while (icode != NULL) {

    if (icode->generic.opcode == OP_DEF && IS_PROCEDURE(icode) /* && !IS_SPEC(icode) */) {  // remove START/FINISH from %spec as well as actual routines
      IMPAST *def = icode;
      if (def->def.next_icode == NULL) {
        warnf("no code following routine declaration??? - serious internal problem!\n");
        return Program; // paranoia. Shouldn't happen.
      }
      IMPAST *params = def->def.next_icode;

      if (params->generic.opcode != OP_START) {
        warnf("Procedure body %s is not a START/FINISH block  (DEF was followed by a %s)\n",
              def->def.imp_id,
              icode_name[params->generic.opcode]);
      }
      
      params = params->generic.next_icode; // remove the START, get the list of params
      def->def.formal_params = params;  // if proc has no params, params will now be a FINISH

      IMPAST *ParentParam = NULL;
      while (params->generic.opcode != OP_FINISH) {
        ParentParam = params;
        params = params->generic.next_icode;
        if (params == NULL) {
          errorf("A parameter list ended in NULL\n");
          return Program; // try to salvage during development but when live this would be fatal
        }
      }
      if (OP(params) != OP_FINISH) {
        warnf("After scanning list of params, last item was a %s, not a FINISH\n", icode_name[OP(params)]);
      }
      following = params->def.next_icode;
      if (OP(def->def.formal_params) == OP_FINISH) def->def.formal_params = NULL; // could be coded more tidily
      if (ParentParam != NULL) ParentParam->generic.next_icode = NULL;
      def->def.next_icode = following;
      params->generic.next_icode = NULL; // remove the FINISH
      icode = following;
    } else {
      icode = icode->generic.next_icode;
    }
  }
  return Program;
}


//----------------------------------------------------------------------------

IMPAST *handle_recordformat_declarations(IMPAST *Program) {
  // This is used in a scan of the whole program before we extract procs or blocks...

  IMPAST *this = Program, *Parent = NULL;

  while (this != NULL) {
    if (    OP(this) == OP_DEF && FORM(this) == F_RECORDFORMAT
         && OP(NEXT(this)) == OP_START
        ) {
      IMPAST *def = this;
      IMPAST *format = NEXT(def);

      this->def.recordformat_field_list = format;
      while (OP(format) != OP_FINISH) {
        // TO DO: handle alts...
        format = NEXT(format);
      }
      IMPAST *next = NEXT(format);
      format->finish.next_icode = NULL;

      // because these are being pulled out of the linear proglist
      // and miss the effects of Program = run_stack(Program) ...
      this->def.recordformat_field_list = run_stack(this->def.recordformat_field_list);
      
      if (Parent != NULL) {
        Parent->generic.next_icode = def;
        def->def.next_icode = next;
        Parent = def;
        this = next;
        // Parent remains parent
      } else {
        Parent = def;
        Program = Parent;
        Parent->def.next_icode = next;
        this = next;
      }

    } else {
      Parent = this;
      this = NEXT(this);
    }
  }
  return Program;
}



//----------------------------------------------------------------------------

IMPAST *separate_perms(IMPAST *Program) {
  IMPAST *perms, *this, *parent;

  if (Program == NULL) return Program;
  if (Program->generic.opcode == OP_LINE) return Program; // No perms present!

  perms = new_iast(PERMS);
  perms->perms.opcode = ASTOP_PERMS;
  perms->perms.perms = Program;
  perms->perms.line = NULL;
  parent = NULL; this = Program;
  while (this != NULL) {
    if (this->generic.opcode == OP_LINE) {
      // Everything before the first LINE directive must be perms.
      // We'll bundle all the perms into a group so that when we
      // output the program we can replace the entire perms
      // declarations with a #include if we want to.
      Program = perms;
      if (parent != NULL) {
        parent->generic.next_icode = NULL;
      } else {
        return Program; // *NO PERMS PRESENT*
      }
      perms->perms.next_icode = this;
      return perms;
    } else if (this->generic.opcode == OP_CONTROL && this->control.data == 0) {
      // LINE dirctives already removed so we'll trigger on the last item
      // in my perms.inc, which is %control 0 ...
      perms->perms.next_icode = this->control.next_icode;
      this->control.next_icode = NULL;
      return perms;
    }
    parent = this;
    this = this->generic.next_icode;
  }
  return Program;
}


//----------------------------------------------------------------------------
/*

current problem minimum example: there are 3 CALLs below.  Only 1 survives

[0]    00678 z CONTROL 0x0000
[1]    00680 H BEGIN  main {lev=0 --> 1}
[2]        00682 $ DEF    {main} TOPLEVEL1 tag=0x00ad a/tf=7 b/format=0 c/ostate=0  type=0 (<type:0>) form=7 (routine) special=0 (none) linkage=0 (auto) spec=0 indirect=0 no_unass_check=0 \
(NEXT ICODE=00690)  (FPARAMS=00684)

[2]        00690 E CALL
[2]        00701 E CALL
[2]        00704 E CALL
[1]      00706 ; END    {main} TOPLEVEL1 {lev=2 --> 1}
[1]      00711 E CALL
[0]    00713 ; END    main {lev=1 --> 0}
[-1]  00714 ; END     {lev=0 --> -1}

 */
IMPAST *fold_blocks(IMPAST *Program, IMPAST **what_follows) {
  IMPAST *this;

  // At the top level (i.e. when last_op == -1) we run down the entire program list,
  // finding procs or blocks, and folding them into a single ast operation which we
  // replace in the program list in the same location as where we extracted the block.
  // At this point the program list is linear so we don't need to think too much about
  // tree-walking down the operands of our new AST entries.  If during the processing
  // of any block we come across a nested block, it will be handled recursively.  An
  // unbalanced END at the top level corresponds to %endoffile and we stop there.

  // As described elsewhere, when taking an extracted proc or block from the linear AST
  // and attaching it to the .body field of an ASTOP_BLOCK or an OP_DEF, we'll remove
  // any BEGIN/END opcodes and rely on the last item being NULL to terminate it.
  
  //debugf("folding started  last_op = %d  OP_END = %d\n", last_op, OP_END);

  // At this point both a BEGIN and a proc DEF have a corresponding END.  Once attached
  // to a body the END should be removed.  For consistency the BEGIN should not be present
  // in the body list of the the BEGIN ICode, and the BEGIN ICode's next_icode points
  // to what follows the whole BEGIN/END block in the linear AST.


  this = Program;
  for (;;) {
    IMPAST *rest;
    if (this == NULL) {
      *what_follows = NULL;
      return Program;
    } else if (OP(this) == OP_BEGIN) {
      if (this->begin.body != NULL) fatalf("fold BEGIN: already has a body attached\n");
      this->begin.body = fold_blocks(this->begin.next_icode, &rest);
      this->begin.next_icode = rest;
      this = rest;

    } else if (OP(this) == OP_DEF && IS_PROCEDURE(this) && !IS_SPEC(this)) {
      if (this->def.body != NULL) fatalf("fold DEF proc: already has a body attached\n");
      this->def.body = fold_blocks(this->def.next_icode, &rest);
      this->def.next_icode = rest;
      this = rest;
      
    } else if (OP(this) == OP_END) {
      rest = this->generic.next_icode;
      this->generic.next_icode = NULL;
      *what_follows = rest;
      return Program;
      
    } else {
      this = this->generic.next_icode; // accumulate chain.
    }
    
  }

  return Program;
}


//----------------------------------------------------------------------------

void print_bound_list(FILE *out, IMPAST *bound) {
  while (bound != NULL) {
    fprintf(out, "%05d ", bound->generic.seqno);
    bound = bound->boundspair.next_bound;
  }
}

IMPAST *reverse_bounds_list(FILE *out, IMPAST *list) {
  IMPAST *prev = NULL;
  IMPAST *current = list;
  IMPAST *next = NULL;

  //fprintf(out, "Reversing bounds list [ ");
  //print_bound_list(out, list);
  
  while (current != NULL) {
    next = current->boundspair.next_bound;     // Store the next node
    current->boundspair.next_bound = prev;     // Reverse the current node's pointer
    prev = current;                         // Move pointers one position forward
    current = next;
  }
  // prev is now the new head of the reversed list
  //fprintf(out, "] to [ ");
  //print_bound_list(out, prev);
  //fprintf(out, "]\n");
  return prev;
}

void print_index_list(FILE *out, IMPAST *bound) {
  while (bound != NULL) {
    fprintf(out, "%05d ", bound->generic.seqno);
    bound = bound->generic.next_icode;
  }
}

IMPAST *reverse_index_list(FILE *out, IMPAST *list) {
  IMPAST *prev = NULL;
  IMPAST *current = list;
  IMPAST *next = NULL;

  fprintf(out, "Reversing index list [ ");
  print_index_list(out, list);
  
  while (current != NULL) {
    next = current->generic.next_icode;     // Store the next node
    current->generic.next_icode = prev;     // Reverse the current node's pointer
    prev = current;                         // Move pointers one position forward
    current = next;
  }
  // prev is now the new head of the reversed list
  fprintf(out, "] to [ ");
  print_index_list(out, prev);
  fprintf(out, "]\n");
  return prev;
}

IMPAST *reverse_array_index_declaration_order(IMPAST *Program) {
  IMPAST *icode = Program;

  while (icode != NULL) {
    //debugf("icode: [%05d]\n", icode->generic.seqno);
    if (OP(icode) == OP_DEF) {
      if (FORM(icode) == F_ARRAY || FORM(icode) == F_NAME_ARRAY) {
        //debugf("REVERSING [bounds_list @ %05d] %s %s\n", icode->def.bounds_list->generic.seqno, formdesc[FORM(icode)], icode->def.c_id);
        //show_icode(icode->def.bounds_list, stderr);
        icode->def.bounds_list = reverse_bounds_list(stderr, icode->def.bounds_list);
      } else {
        //debugf("Skip %s %s\n", formdesc[FORM(icode)], icode->def.c_id);
      }
    }
    icode = icode->generic.next_icode;
  }
  return Program;
}

//----------------------------------------------------------------------------

#endif // !__FILTER_C__