view release on metacpan or  search on metacpan

Basic/Core/pdlcore.c.PL  view on Meta::CPAN

        sv_setiv(*svp, (IV)1);
      }
    }
  }

  return depth;
}

/* helper function used in pdl_from_array */
static int _detect_datatype(AV *av) {
  SV **item;
  AV *array;
  int count, i;
  if (!av) return PDLA_D;
  count = av_len(av);
  for (i = 0; i < count; i++) {
    item = av_fetch(av, i, 0);
    if (*item) {
      if (SvROK(*item)) {
        array = (AV*)SvRV(*item);
        if (_detect_datatype(array) == PDLA_D) {
          return PDLA_D;
        }
      }
      if (SvOK(*item) && !SvIOK(*item)) {
        return PDLA_D;
      }
    }
  }
#if IVSIZE == 8
  return PDLA_LL;
#else
  return PDLA_L;
#endif
}

/**********************************************************************
 * pdl_from_array - dispatcher gets called only by pdl_avref (defined in
 * Core.xs) - it breaks out to pdl_setav_<type>, below, based on the 
 * type of the destination PDLA.
 */
pdl* pdl_from_array(AV* av, AV* dims, int type, pdl* p)
{
  int ndims, i, level=0;
  PDLA_Indx *pdims;
  PDLA_Anyval undefval = { -1, 0 };

  ndims = av_len(dims)+1;
  pdims = (PDLA_Indx *) pdl_malloc( (ndims) * sizeof(*pdims) );
  for (i=0; i<ndims; i++) {
     pdims[i] = SvIV(*(av_fetch(dims, ndims-1-i, 0))); /* reverse order */
  }

  if (p == NULL)
     p = pdl_new();
  pdl_setdims (p, pdims, ndims);
  if (type == -1) {
    type = _detect_datatype(av);
  }
  p->datatype = type;
  pdl_allocdata (p);
  pdl_make_physical(p);

  {
    /******
     * Copy the undefval to fill empty spots in the piddle...
     */
    SV *sv = get_sv("PDLA::undefval",0);
    if ((!sv) || (sv==&PL_sv_undef)) {
       ANYVAL_FROM_CTYPE(undefval, type, 0);
    }
    else {
       /* Need to set undefvalue from the perl scalar */
       if (SvIOK(sv)) {
         ANYVAL_FROM_CTYPE(undefval, type, SvIV(sv));
       }
       else if (SvNOK(sv)) {
         ANYVAL_FROM_CTYPE(undefval, type, SvNV(sv));
       }
       else {
         ANYVAL_FROM_CTYPE(undefval, type, 0); /* this should not happen */
       }
    }
  }

  switch (type) {
!NO!SUBS!

##########
# Perl snippet autogenerates switch statement to distribute
# pdl_setav calls...
#
  for my $type(typesrtkeys()){
    my $t2 = $PDLA_DATATYPES{$type};
    $t2 =~ s/PDLA_//;
    print OUT <<"!WITH!SUBS!";
  case $type:
    pdl_setav_$t2(p->data,av,pdims,ndims,level, undefval.value.$PDLA::Types::typehash{$type}->{ppsym}, p);
    break;

!WITH!SUBS!

  }
#
# Back to your regularly scheduled C code emission...
########

  print OUT <<'!NO!SUBS!';
  default:
    croak("pdl_from_array: internal error: got type %d",type);
    break;
  }
  p->state &= ~PDLA_NOMYDIMS;
  return p;
}

/*
 * pdl_kludge_copy_<type>  - copy a PDLA into a part of a being-formed PDLA.
 * It is only used by pdl_setav_<type>, to handle the case where a PDLA is part
 * of the argument list. 
 *