/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* reshape APL2 V1.0.0 *************************************************
* Reshapes the right argument to the shape specified by the left.      *
* Left must have rank <= 1. Its elements specify shape of result.      *
* Elements are drawn from the right argument, repeated cyclically.     *
***********************************************************************/
#define INCLUDES APLMEM+APLCB
#include "includes.h"
Aplcb reshape(left,rite)
Aplcb left,rite;
{
     Apltype; Dtacopy; Errinit; Errstop; Getcb; Integer; Perm;
     extern int aplerr;
     int datacnt,datatyp,i,*ip,j,*jp,rank;
     Aplcb out;

     if (errinit()) return(errstop(0,left,rite,NULL));
     if (left->aplrank>1) return(errstop(10,left,rite,NULL)); /* shape */
     if (0 == (rank = left->aplcount))
          if (left->aplrank) datacnt = 1; /* output is a scalar */
          else { datacnt = 0; rank = 1; } /* output is empty vector */
     else { /* get datacnt for nonscalar */
          datacnt=1; /* may change */
          if ( !(left->aplflags & APLINT) ) {
               left = integer(left);
               if (aplerr) return(errstop(0,left,rite,NULL));
          }
          jp = left->aplptr.aplint;
          for (i=0; i<rank; i++) {
               if (0 > (j = *jp++)) return(errstop(113,left,rite,NULL));
               datacnt *= j; /* get dimension */
     }    }
     if (datacnt && rite->aplcount==0) return(errstop(11,left,rite,NULL));
     datatyp = rite->aplflags & (APLMASK + APLAPL);
     if (NULL != (out = getcb(NULL,datacnt,datatyp+APLTEMP,rank,NULL))) {
          if (rank > 1) { /* not scalar or vector, set dimensions */
               ip = out->apldim; /* point to output dimensions */
               jp = left->aplptr.aplint;
               for (i=0; i<rank; i++) *ip++ = *jp++; /* get dimen. */
          }
          jp = out->aplptr.aplint;
          if (datacnt) {
               if ( !rite->aplrank ) /* scalar in? */
                    jp = dtacopy(jp,rite->aplptr.aplint,datacnt,0,datatyp);
               else for (i=0; i<datacnt; i+=j)
                    jp = dtacopy(jp,rite->aplptr.aplint,
                         (j=imin(rite->aplcount,datacnt-i)),1,datatyp);
          }
          else if (datatyp & APLAPL) {
               *((Aplcb *)jp) = perm(apltype(rite)); /* type */
               rite = NULL; /* don't free twice */
          }
     }
     return(errstop(0,left,rite,out));
}