"Fossies" - the Fresh Open Source Software Archive

Member "PDL-2.080/Basic/SourceFilter/NiceSlice.pm" (23 May 2022, 35613 Bytes) of package /linux/misc/PDL-2.080.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "NiceSlice.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.079_vs_2.080.

    1 BEGIN {
    2    my %engine_ok = (
    3       'Filter::Util::Call' => 'PDL/NiceSlice/FilterUtilCall.pm',
    4       'Filter::Simple'     => 'PDL/NiceSlice/FilterSimple.pm',
    5       'Module::Compile'     => 'PDL/NiceSlice/ModuleCompile.pm',
    6    );  # to validate names
    7 
    8    ## TODO: Add configuration argument to perldl.conf
    9    $PDL::NiceSlice::engine = $engine_ok{'Filter::Simple'};  # default engine type
   10    ## $PDL::NiceSlice::engine = $engine_ok{'Filter::Util::Call'};  # default engine type
   11 
   12    if ( exists $ENV{PDL_NICESLICE_ENGINE} ) {
   13       my $engine = $ENV{PDL_NICESLICE_ENGINE};
   14       if ( exists $engine_ok{$engine} and $engine_ok{$engine} ) {
   15          $PDL::NiceSlice::engine = $engine_ok{$engine};
   16          warn "PDL::NiceSlice using engine '$engine'\n" if $PDL::verbose;
   17       } elsif ( exists $engine_ok{$engine} and not $engine_ok{$engine} ) {
   18          warn "PDL::NiceSlice using default engine\n" if $PDL::verbose;
   19       } else {
   20          die "PDL::NiceSlice: PDL_NICESLICE_ENGINE set to invalid engine '$engine'\n";
   21       }
   22    }
   23 }
   24 
   25 package PDL::NiceSlice;
   26 
   27 use strict;
   28 use warnings;
   29 our $VERSION = '1.001';
   30 $VERSION = eval $VERSION;
   31 
   32 $PDL::NiceSlice::debug //= 0;
   33 # replace all occurrences of the form
   34 #
   35 #   $pdl(args);
   36 # or
   37 #   $pdl->(args);
   38 # with
   39 #
   40 #   $pdl->slice(processed_args);
   41 #
   42 #
   43 # Modified 2-Oct-2001: don't modify $var(LIST) if it's part of a
   44 # "for $var(LIST)" or "foreach $var(LIST)" statement.  CED.
   45 #
   46 # Modified 5-Nov-2007: stop processing if we encounter m/^no\s+PDL\;:\;:NiceSlice\;\s*$/.
   47 
   48 # the next one is largely stolen from Regexp::Common
   49 my $RE_cmt = qr'(?:(?:\#)(?:[^\n]*)(?:\n))';
   50 
   51 use Text::Balanced; # used to find parenthesis-delimited blocks 
   52 
   53 BEGIN {
   54 # fix for problem identified by Ingo, also EOP fix that needs propagating back
   55 my $ncws = qr/\s+/;
   56 my $comment = qr/(?<![\$\@%])#.*/;
   57 my $id = qr/\b(?!([ysm]|q[rqxw]?|tr)\b)\w+/;
   58 my $EOP = qr/\n\n|\n#|\Z/;
   59 my $CUT = qr/\n=cut.*$EOP/;
   60 my $pod_or_DATA = qr/
   61               ^=(?:head[1-4]|item) .*? $CUT
   62             | ^=pod .*? $CUT
   63             | ^=for .*? $CUT
   64             | ^=begin .*? $CUT
   65             | ^__(DATA|END)__\r?\n.*
   66             /smx;
   67 my %extractor_for = (
   68     code_no_comments
   69                => [ { DONT_MATCH => $comment },
   70                     $ncws, { DONT_MATCH => $pod_or_DATA }, \&Text::Balanced::extract_variable,
   71                     $id, { DONT_MATCH => \&Text::Balanced::extract_quotelike }   ],
   72 );
   73 use Filter::Simple ();
   74 my $orig_gen_std_filter_for = \&Filter::Simple::gen_std_filter_for;
   75 sub my_gen_std_filter_for {
   76     my ($type, $transform) = @_;
   77     goto &$orig_gen_std_filter_for if !$extractor_for{$type};
   78     return sub {
   79         my $instr;
   80         my @components;
   81         for (Text::Balanced::extract_multiple($_,$extractor_for{$type})) {
   82             if (ref())     { push @components, $_; $instr=0 }
   83             elsif ($instr) { $components[-1] .= $_ }
   84             else           { push @components, $_; $instr=1 }
   85         }
   86         my $count = 0;
   87         my $extractor =      qr/\Q$;\E(.{4})\Q$;\E/s;
   88         $_ = join "",
   89               map { ref $_ ? $;.pack('N',$count++).$; : $_ }
   90                   @components;
   91         @components = grep { ref $_ } @components;
   92         $transform->(@_);
   93         s/$extractor/${$components[unpack('N',$1)]}/g;
   94     }
   95 }
   96 # override the current extract_quotelike() routine
   97 # needed before using Filter::Simple to work around a bug
   98 # between Text::Balanced and Filter::Simple for our purpose.
   99 no warnings 'redefine';
  100 *Filter::Simple::gen_std_filter_for = \&my_gen_std_filter_for;
  101 }
  102 
  103 # a call stack for error processing
  104 my @callstack = ('stackbottom');
  105 sub curarg {
  106   my $arg = $callstack[-1]; # return top element of stack
  107   $arg =~ s/\((.*)\)/$1/s;
  108   return $arg;
  109 }
  110 sub savearg ($) {push @callstack,$_[0]}
  111 sub poparg () {pop @callstack}
  112 
  113 my @srcstr = (); # stack for refs to current source strings
  114 my $offset = 1;  # line offset
  115 my $file   = 'unknown';
  116 
  117 my $mypostfix = '';
  118 
  119 sub autosever {
  120   my ($this,$arg) = @_;
  121   $arg = 1 unless defined $arg;
  122   if ($arg) {$mypostfix = '->sever'} else
  123     {$mypostfix = ''}
  124 }
  125 
  126 sub line {
  127   die __PACKAGE__." internal error: can't determine line number"
  128     if $#srcstr < 0;
  129   my $pretext = substr ${$srcstr[0]}, 0, pos(${$srcstr[0]})-1;
  130   return ($pretext =~ tr/\n/\n/)+$offset;
  131 }
  132 
  133 sub filterdie {
  134   my ($msg) = @_;
  135   die "$msg\n\t at $file near line ".
  136     line().", slice expression '".curarg()."'\n";
  137 }
  138 
  139 # non-bracketed prefix matching regexp
  140 my $prebrackreg = qr/^([^\(\{\[]*)/;
  141 
  142 # split regex $re separated arglist
  143 # but ignore bracket-protected bits
  144 # (i.e. text that is within matched brackets)
  145 sub splitprotected ($$) {
  146   my ($re,$txt) = @_;
  147   my ($got,$pre) = (1,'');
  148   my @chunks = ('');
  149   my $ct = 0; # infinite loop protection
  150   while ($got && $txt =~ /[({\[]/ && $ct++ < 1000) {
  151     # print "iteration $ct\n";
  152     ($got,$txt,$pre) =
  153       Text::Balanced::extract_bracketed($txt,'{}()[]',$prebrackreg);
  154     my @partialargs = split $re, $pre, -1;
  155     $chunks[-1] .= shift @partialargs if @partialargs;
  156     push @chunks, @partialargs;
  157     $chunks[-1] .= $got;
  158   }
  159   filterdie "possible infinite parse loop, slice arg '".curarg()."'"
  160                if $ct == 1000;
  161   my @partialargs = split $re, $txt, -1;
  162   $chunks[-1] .= shift @partialargs if @partialargs;
  163   push @chunks, @partialargs;
  164   return @chunks;
  165 }
  166 
  167 # a pattern that finds occurrences of the form
  168 #
  169 #  $var(
  170 #
  171 # and
  172 #
  173 #  ->(
  174 #
  175 # used as the prefix pattern for findslice
  176 my $wspat = qr/(?:\s|$RE_cmt|\Q$;\E.{4}\Q$;\E)*/; # last bit Filter::Simple
  177 my $prefixpat = qr/.*?  # arbitrary leading stuff
  178                    ((?<!&)\$\w+  # $varname not preceded by '&'
  179                     |->)         # or just '->'
  180                    $wspat
  181                    (?=\()/smx;   # directly followed by open '(' (look ahead)
  182 
  183 # translates a single arg into corresponding slice format
  184 sub onearg ($) {
  185   my ($arg) = @_;
  186   print STDERR "processing arg '$arg'\n" if $PDL::NiceSlice::debug;
  187   return q|'X'| if $arg =~ /^\s*:??\s*$/;     # empty arg or just colon
  188   # recursively process args for slice syntax
  189   $arg = findslice($arg,$PDL::NiceSlice::debug) if $arg =~ $prefixpat;
  190   # no doubles colon are matched to avoid confusion with Perl's C<::>
  191   if ($arg =~ /(?<!:):(?!:)/) { # a start:stop:delta range
  192     my @args = splitprotected '(?<!:):(?!:)', $arg;
  193     filterdie "invalid range in slice expression '".curarg()."'"
  194       if @args > 3;
  195     $args[0] = 0 if !defined $args[0] || $args[0] =~ /^\s*$/;
  196     $args[1] = -1 if !defined $args[1] || $args[1] =~ /^\s*$/;
  197     $args[2] = undef if !defined $args[2] || $args[2] =~ /^\s*$/;
  198     return "[".join(',',grep defined,@args)."]"; # replace single ':' with ','
  199   }
  200   # the (pos) syntax, i.e. 0D slice
  201   return "[$arg,0,0]" if $arg =~ s/^\s*\((.*)\)\s*$/$1/; # use the new [x,x,0]
  202   # we don't allow [] syntax (although that's what slice uses)
  203   filterdie "invalid slice expression containing '[', expression was '".
  204     curarg()."'" if $arg =~ /^\s*\[/;
  205 
  206   # If the arg starts with '*' it's a dummy call -- force stringification
  207   # and prepend a '*' for handling by slice.
  208   return "(q(*).($arg))" if($arg =~ s/^\s*\*//);
  209 
  210   # this must be a simple position, leave as is
  211   return "$arg";
  212 }
  213 
  214 # process the arg list
  215 sub procargs {
  216   my ($txt) = @_;
  217   print STDERR "procargs: got '$txt'\n" if $PDL::NiceSlice::debug;
  218   # $txt =~ s/^\s*\((.*)\)\s*$/$1/s; # this is now done by findslice
  219   # push @callstack, $txt; # for later error reporting
  220   my $args = $txt =~ /^\s*$/s ? '' :
  221     join ',', map {onearg $_} splitprotected ',', $txt;
  222     ## Leave whitespace/newlines in so line count
  223     ## is preserved in error messages.  Makes the
  224     ## filtered output ugly---iffi the input was
  225     ## ugly...
  226     ## 
  227     ## $args =~ s/\s//sg; # get rid of whitespace
  228   # pop @callstack; # remove from call stack
  229   print STDERR "procargs: returned '($args)'\n" if $PDL::NiceSlice::debug;
  230   return "($args)";
  231 }
  232 
  233 # this is the real workhorse that translates occurrences
  234 # of $x(args) into $args->slice(processed_arglist)
  235 #
  236 sub findslice {
  237   my ($src,$verbose) = @_;
  238   push @srcstr, \$src;
  239   $verbose //= 0;
  240   my $processed = '';
  241   my $ct=0; # protect against infinite loop
  242   my ($found,$prefix,$dummy);
  243   while ( $src =~ m/\G($prefixpat)/ && (($found,$dummy,$prefix) =
  244        Text::Balanced::extract_bracketed($src,'()',$prefixpat))[0]
  245       && $ct++ < 1000) {
  246     print STDERR "pass $ct: found slice expr $found at line ".line()."\n"
  247       if $verbose;
  248 
  249 #  Do final check for "for $var(LIST)" and "foreach $var(LIST)" syntax. 
  250 #  Process into a 'slice' call only if it's not that.
  251 
  252     if ($prefix =~ m/for(?:each)?\b(?:$wspat(?:my|our))?$wspat\$\w+$wspat$/s ||
  253       # foreach statement: Don't translate
  254     $prefix =~ m/->\s*\$\w+$/s) # e.g. $x->$method(args)
  255       # method invocation via string, don't translate either
  256     {
  257     # note: even though we reject this one we need to call
  258         #       findslice on $found in case
  259     #       it contains slice expressions
  260       $processed .= $prefix.findslice($found,$verbose);
  261     } else {      # statement is a real slice and not a foreach
  262 
  263       my ($call,$pre,$post,$arg);
  264 
  265       # the following section got an overhaul in v0.99
  266       # to fix modifier parsing and allow >1 modifier
  267       # this code still needs polishing
  268       savearg $found; # error reporting
  269       print STDERR "findslice: found '$found'\n" if $PDL::NiceSlice::debug;
  270       $found =~ s/^\s*\((.*)\)\s*$/$1/s;
  271       my ($slicearg,@mods) = splitprotected ';', $found;
  272       filterdie "more than 1 modifier group: @mods" if @mods > 1;
  273       # filterdie "invalid modifier $1"
  274       # if $found =~ /(;\s*[[:graph:]]{2,}?\s*)\)$/;
  275       print STDERR "MODS: " . join(',',@mods) . "\n" if $PDL::NiceSlice::debug;
  276       my @post = (); # collects all post slice operations
  277       my @pre = ();
  278       if (@mods) {
  279     (my $mod = $mods[0]) =~ s/\s//sg; # eliminate whitespace
  280     my @modflags = split '', $mod;
  281     print STDERR "MODFLAGS: @modflags\n" if $PDL::NiceSlice::debug;
  282     filterdie "more than 1 modifier incompatible with ?: @modflags"
  283       if @modflags > 1 && grep (/\?/, @modflags); # only one flag with where
  284     my %seen = ();
  285     if (@modflags) {
  286       for my $mod1 (@modflags) {
  287         if ($mod1 eq '?') {
  288           $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
  289           $call = 'where';
  290           $arg = "(" . findslice($slicearg,$verbose) . ")";
  291           # $post = ''; # no post action required
  292         } elsif ($mod1 eq '_') {
  293           $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
  294           push @pre, 'flat->';
  295           $call ||= 'slice';       # do only once
  296           $arg = procargs($slicearg);
  297           # $post = ''; # no post action required
  298         } elsif ($mod1 eq '|') {
  299           $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
  300           $call ||= 'slice';
  301           $arg ||= procargs($slicearg);
  302           push @post, '->sever';
  303         } elsif ($mod1 eq '-') {
  304           $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
  305           $call ||= 'slice';
  306           $arg ||= procargs($slicearg);
  307           push @post, '->reshape(-1)';
  308         } else {
  309           filterdie "unknown modifier $mod1";
  310         }
  311       }
  312     } else { # empty modifier block
  313       $call = 'slice';
  314       $arg = procargs($slicearg);
  315       # $post = '';
  316     }
  317       } else { # no modifier block
  318          $call = 'slice';
  319          $arg = procargs($slicearg);
  320          # $post = '';
  321          # $call = 'slice_if_pdl';     # handle runtime checks for $self type
  322          # $arg =~ s/\)$/,q{$found})/;  # add original argument string
  323                                         # in case $self is not an ndarray
  324                                         # and the original call must be
  325                                         # generated
  326       }
  327       $pre = join '', @pre;
  328       # assumption here: sever should be last
  329       # and order of other modifiers doesn't matter
  330       $post = join '', sort @post; # need to ensure that sever is last
  331       $processed .= $prefix. ($prefix =~ /->$wspat$/ ?
  332                 '' : '->').
  333     $pre.$call.$arg.$post.$mypostfix;
  334     }
  335 
  336   } # end of while loop
  337 
  338   poparg;      # clean stack
  339   pop @srcstr; # clear stack
  340   # append the remaining text portion
  341   #     use substr only if we have had at least one pass
  342   #     through above loop (otherwise pos is uninitialized)
  343   $processed . ($ct > 0 ? substr $src, pos($src) : $src);
  344 }
  345 
  346 ##############################
  347 # termstr - generate a regexp to find turn-me-off strings
  348 # CED 5-Nov-2007
  349 sub terminator_regexp{
  350     my $clstr = shift;
  351     $clstr =~ s/([^a-zA-Z0-9])/\\$1/g;
  352     my $termstr = '^\s*no\s+'.$clstr.'\s*;\s*(#.*)*$';
  353     return qr/$termstr/o; # allow trailing comments
  354 }
  355 
  356 sub reinstator_regexp{
  357     my $clstr = shift;
  358     $clstr =~ s/([^a-zA-Z0-9])/\\$1/g;
  359     my $reinstr = '^\s*use\s+'.$clstr.'\s*;\s*(#.*)*$';
  360     return qr/$reinstr/o; # allow trailing comments
  361 }
  362 
  363 # safe eval of findslice that should be used within perldl or pdl2
  364 # as a preprocessor
  365 sub perldlpp {
  366  my ($class, $txt) = @_;
  367  local($_);
  368  ##############################
  369  # Backwards compatibility to before the two-parameter form. The only
  370  # call should be around line 206 of PDL::AutoLoader, but one never
  371  # knows....
  372  #    -- CED 5-Nov-2007
  373  if(!defined($txt)) { 
  374      print "PDL::NiceSlice::perldlpp -- got deprecated one-argument form, from ".(join("; ",caller))."...\n";
  375      $txt = $class; 
  376      $class = "PDL::NiceSlice";
  377  }
  378 
  379  ## Debugging to track exactly what is going on -- left in, in case it's needed again
  380  if($PDL::NiceSlice::debug > 1) {
  381      print "PDL::NiceSlice::perldlpp - got:\n$txt\n";
  382      my $i;
  383      for $i(0..5){
  384      my($package,$filename,$line,$subroutine, $hasargs) = caller($i);
  385      printf("layer %d: %20s, %40s, line %5d, sub %20s, args: %d\n",$i,$package,$filename,$line,$subroutine,$hasargs);
  386      }
  387  }
  388 
  389  ##############################
  390  ## This block sort-of echoes import(), below...
  391  ## Crucial difference: we don't give up the ghost on termination conditions, only
  392  ## mask out current findslices.  That's because future uses won't be processed
  393  ## (for some reason source filters don't work on evals).
  394 
  395  my @lines= split /\n/,$txt;
  396 
  397  my $terminator = terminator_regexp($class);
  398  my $reinstator = reinstator_regexp($class);
  399 
  400  my($status, $off, $end, $new, $count);
  401  eval {
  402      do {
  403      my $data = "";
  404      while(@lines) {
  405          $_= shift @lines;
  406          if(defined($terminator) && m/$terminator/) {
  407          $_ = "## $_";
  408          $off = 1;
  409          last;
  410          }
  411          if(defined($reinstator) && m/$reinstator/) {
  412          $_ = "## $_";
  413          }
  414          if(m/^\s*(__END__|__DATA__)\s*$/) {
  415          $end=$1; $off = 1;
  416          last;
  417          }
  418          $data .= "$_\n";
  419          $count++;
  420          $_="";
  421      }
  422      $_ = $data;
  423      $_ = findslice $_, $PDL::NiceSlice::debug ;
  424      $_ .= "no $class;\n" if $off;
  425      $_ .= "$end\n" if $end;
  426      $new .= "$_";
  427      
  428      while($off && @lines) {
  429          $_ = shift @lines;
  430          if(defined($reinstator) && m/$reinstator/) {
  431          $off = 0;
  432          $_ = "## $_";
  433          }
  434          if(defined($terminator) && m/$terminator/) {
  435          $_ = "## $_";
  436          }
  437 
  438          $new .= "$_\n";
  439 
  440      }
  441      } while(@lines && !$end);
  442  };
  443      
  444  if ($@) {
  445    my $err = $@;
  446    for (split '','#!|\'"%~/') {
  447      return "print q${_}NiceSlice error: $err${_}"
  448        unless $err =~ m{[$_]};
  449     }
  450    return "print q{NiceSlice error: $err}"; # if this doesn't work
  451                                                # we're stuffed
  452  }
  453 
  454  if($PDL::NiceSlice::debug > 1) {
  455      print "PDL::NiceSlice::perldlpp - returning:\n$new\n";
  456  }
  457  return $new;
  458 }
  459 
  460 BEGIN {
  461    require "$PDL::NiceSlice::engine";
  462 }
  463 
  464 =head1 NAME
  465 
  466 PDL::NiceSlice - toward a nicer slicing syntax for PDL
  467 
  468 =head1 SYNOPSYS
  469 
  470   use PDL::NiceSlice;
  471 
  472   $x(1:4) .= 2;             # concise syntax for ranges
  473   print $y((0),1:$end);     # use variables in the slice expression
  474   $x->transpose->(($pos-1)) .= 0; # default method syntax
  475 
  476   $idx = long 1, 7, 3, 0;   # an ndarray of indices
  477   $x(-3:2:2,$idx) += 3;     # mix explicit indexing and ranges
  478   $x->clump(1,2)->(0:30);   # 'default method' syntax
  479   $x(myfunc(0,$var),1:4)++; # when using functions in slice expressions
  480                             # use parentheses around args!
  481 
  482   $y = $x(*3);              # Add dummy dimension of order 3
  483 
  484   # modifiers are specified in a ;-separated trailing block
  485   $x($x!=3;?)++;            # short for $x->where($x!=3)++
  486   $x(0:1114;_) .= 0;        # short for $x->flat->(0:1114)
  487   $y = $x(0:-1:3;|);        # short for $x(0:-1:3)->sever
  488   $n = sequence 3,1,4,1;
  489   $y = $n(;-);              # drop all dimensions of size 1 (AKA squeeze)
  490   $y = $n(0,0;-|);          # squeeze *and* sever
  491   $c = $x(0,3,0;-);         # more compact way of saying $x((0),(3),(0))
  492 
  493 =head1 DESCRIPTION
  494 
  495 Slicing is a basic, extremely common operation, and PDL's
  496 L<PDL::Slices/slice> method would be cumbersome to use in many
  497 cases.  C<PDL::NiceSlice> rectifies that by incorporating new slicing
  498 syntax directly into the language via a perl I<source filter> (see
  499 L<perlfilter>).  NiceSlice adds no new functionality, only convenient syntax.
  500 
  501 NiceSlice is loaded automatically in the perldl or pdl2 shell, but (to avoid
  502 conflicts with other modules) must be loaded explicitly in standalone
  503 perl/PDL scripts (see below).  If you prefer not to use a prefilter on
  504 your standalone scripts, you can use the L<PDL::Slices/slice>
  505 method in those scripts,
  506 rather than the more compact NiceSlice constructs.
  507 
  508 =head1 Use in scripts and C<perldl> or C<pdl2> shell
  509 
  510 The new slicing syntax can be switched on and off in scripts
  511 and perl modules by using or unloading C<PDL::NiceSlice>.
  512 
  513 But now back to scripts and modules.
  514 Everything after C<use PDL::NiceSlice> will be translated
  515 and you can use the new slicing syntax. Source filtering
  516 will continue until the end of the file is encountered.
  517 You can stop sourcefiltering before the end of the file
  518 by issuing a C<no PDL::NiceSlice> statement.
  519 
  520 Here is an example:
  521 
  522   use PDL::NiceSlice;
  523 
  524   # this code will be translated
  525   # and you can use the new slicing syntax
  526 
  527   no PDL::NiceSlice;
  528 
  529   # this code won't
  530   # and the new slicing syntax will raise errors!
  531 
  532 See also L<Filter::Simple> and F<example> in this distribution for
  533 further examples.
  534 
  535 NOTE: Unlike "normal" modules you need to include a
  536 C<use PDL::NiceSlice> call in each and every file that
  537 contains code that uses the new slicing syntax. Imagine
  538 the following situation: a file F<test0.pl>
  539 
  540    # start test0.pl
  541    use PDL;
  542    use PDL::NiceSlice;
  543 
  544    $x = sequence 10;
  545    print $x(0:4),"\n";
  546 
  547    require 'test1.pl';
  548    # end test0.pl
  549 
  550 that C<require>s a second file F<test1.pl>
  551 
  552    # begin test1.pl
  553    $aa = sequence 11;
  554    print $aa(0:7),"\n";
  555    1;
  556    # end test1.pl
  557 
  558 Following conventional perl wisdom everything should be alright
  559 since we C<use>d C<PDL> and C<PDL::NiceSlice> already from within
  560 F<test0.pl> and by the time F<test1.pl> is C<require>d things should
  561 be defined and imported, etc. A quick test run will, however, produce
  562 something like the following:
  563 
  564   perl test0.pl
  565  [0 1 2 3 4]
  566  syntax error at test1.pl line 3, near "0:"
  567  Compilation failed in require at test0.pl line 7.
  568 
  569 This can be fixed by adding the line
  570 
  571   use PDL::NiceSlice;
  572 
  573 C<before> the code in F<test1.pl> that uses the
  574 new slicing syntax (to play safe just include the line
  575 near the top of the file), e.g.
  576 
  577    # begin corrected test1.pl
  578    use PDL::NiceSlice;
  579    $aa = sequence 11;
  580    print $aa(0:7),"\n";
  581    1;
  582    # end test1.pl
  583 
  584 Now things proceed more smoothly
  585 
  586   perl test0.pl
  587  [0 1 2 3 4]
  588  [0 1 2 3 4 5 6 7]
  589 
  590 Note that we don't need to issue C<use PDL> again.
  591 C<PDL::NiceSlice> is a somewhat I<funny> module in
  592 that respect. It is a consequence of the way source
  593 filtering works in Perl (see also the IMPLEMENTATION
  594 section below).
  595 
  596 =head2 evals and C<PDL::NiceSlice>
  597 
  598 Due to C<PDL::NiceSlice> being a source filter it won't work
  599 in the usual way within evals. The following will I<not> do what
  600 you want:
  601 
  602   $x = sequence 10;
  603   eval << 'EOE';
  604 
  605   use PDL::NiceSlice;
  606   $y = $x(0:5);
  607 
  608   EOE
  609   print $y;
  610 
  611 Instead say:
  612 
  613   use PDL::NiceSlice;
  614   $x = sequence 10;
  615   eval << 'EOE';
  616 
  617   $y = $x(0:5);
  618 
  619   EOE
  620   print $y;
  621 
  622 Source filters I<must> be executed at compile time to be effective. And
  623 C<PDL::NiceSlice> is just a source filter (although it is not
  624 necessarily obvious for the casual user).
  625 
  626 =head1 The new slicing syntax
  627 
  628 Using C<PDL::NiceSlice> slicing ndarrays becomes so much easier since, first of
  629 all, you don't need to make explicit method calls. No
  630 
  631   $pdl->slice(....);
  632 
  633 calls, etc. Instead, C<PDL::NiceSlice> introduces two ways in which to
  634 slice ndarrays without too much typing:
  635 
  636 =over 2
  637 
  638 =item *
  639 
  640 using parentheses directly following a scalar variable name,
  641 for example
  642 
  643    $c = $y(0:-3:4,(0));
  644 
  645 =item *
  646 
  647 using the so called I<default method> invocation in which the
  648 ndarray object is treated as if it were a reference to a
  649 subroutine (see also L<perlref>). Take this example that slices
  650 an ndarray that is part of a perl list C<@b>:
  651 
  652   $c = $b[0]->(0:-3:4,(0));
  653 
  654 =back
  655 
  656 The format of the argument list is the same for both types of
  657 invocation and will be explained in more detail below.
  658 
  659 =head2 Parentheses following a scalar variable name
  660 
  661 An arglist in parentheses following directly after a scalar variable
  662 name that is I<not> preceded by C<&> will be resolved as a slicing
  663 command, e.g.
  664 
  665   $x(1:4) .= 2;         # only use this syntax on ndarrays
  666   $sum += $x(,(1));
  667 
  668 However, if the variable name is immediately preceded by a C<&>,
  669 for example
  670 
  671   &$x(4,5);
  672 
  673 it will not be interpreted as a slicing expression. Rather, to avoid
  674 interfering with the current subref syntax, it will be treated as an
  675 invocation of the code reference C<$x> with argumentlist C<(4,5)>.
  676 
  677 The $x(ARGS) syntax collides in a minor way with the perl syntax.  In
  678 particular, ``foreach $var(LIST)'' appears like a PDL slicing call.  
  679 NiceSlice avoids translating the ``for $var(LIST)'' and 
  680 ``foreach $var(LIST)'' constructs for this reason.  Since you
  681 can't use just any old lvalue expression in the 'foreach' 'for'
  682 constructs -- only a real perl scalar will do -- there's no 
  683 functionality lost.  If later versions of perl accept 
  684 ``foreach <lvalue-expr> (LIST)'', then you can use the code ref
  685 syntax, below, to get what you want.
  686 
  687 =head2 The I<default method> syntax
  688 
  689 The second syntax that will be recognized is what I called the
  690 I<default method> syntax. It is the method arrow C<-E<gt>> directly
  691 followed by an open parenthesis, e.g.
  692 
  693   $x->transpose->(($pos)) .= 0;
  694 
  695 Note that this conflicts with the use of normal code references, since you
  696 can write in plain Perl
  697 
  698   $sub = sub { print join ',', @_ };
  699   $sub->(1,'a');
  700 
  701 NOTE: Once C<use PDL::NiceSlice> is in effect (you can always switch it off with
  702 a line C<no PDL::NiceSlice;> anywhere in the script) the source filter will incorrectly
  703 replace the above call to C<$sub> with an invocation of the slicing method.
  704 This is one of the pitfalls of using a source filter that doesn't know
  705 anything about the runtime type of a variable (cf. the
  706 Implementation section).
  707 
  708 This shouldn't be a major problem in practice; a simple workaround is to use
  709 the C<&>-way of calling subrefs, e.g.:
  710 
  711   $sub = sub { print join ',', @_ };
  712   &$sub(1,'a');
  713 
  714 =head2 When to use which syntax?
  715 
  716 Why are there two different ways to invoke slicing?
  717 The first syntax C<$x(args)> doesn't work with chained method calls. E.g.
  718 
  719   $x->xchg(0,1)(0);
  720 
  721 won't work. It can I<only> be used directly following a valid perl variable
  722 name. Instead, use the I<default method> syntax in such cases:
  723 
  724   $x->transpose->(0);
  725 
  726 Similarly, if you have a list of ndarrays C<@pdls>:
  727 
  728   $y = $pdls[5]->(0:-1);
  729 
  730 =head2 The argument list
  731 
  732 The argument list is a comma separated list. Each argument specifies
  733 how the corresponding dimension in the ndarray is sliced. In contrast
  734 to usage of the L<PDL::Slices/slice> method the arguments should
  735 I<not> be quoted. Rather freely mix literals (1,3,etc), perl
  736 variables and function invocations, e.g.
  737 
  738   $x($pos-1:$end,myfunc(1,3)) .= 5;
  739 
  740 There can even be other slicing commands in the arglist:
  741 
  742   $x(0:-1:$pdl($step)) *= 2;
  743 
  744 NOTE: If you use function calls in the arglist make sure that
  745 you use parentheses around their argument lists. Otherwise the
  746 source filter will get confused since it splits the argument
  747 list on commas that are not protected by parentheses. Take
  748 the following example:
  749 
  750   sub myfunc { return 5*$_[0]+$_[1] }
  751   $x = sequence 10;
  752   $sl = $x(0:myfunc 1, 2);
  753   print $sl;
  754  PDL barfed: Error in slice:Too many dims in slice
  755  Caught at file /usr/local/bin/perldl, line 232, pkg main
  756 
  757 
  758 The simple fix is
  759 
  760   $sl = $x(0:myfunc(1, 2));
  761   print $sl;
  762  [0 1 2 3 4 5 6 7]
  763 
  764 Note that using prototypes in the definition of myfunc does not help.
  765 At this stage the source filter is simply not intelligent enough to
  766 make use of this information. So beware of this subtlety.
  767 
  768 Another pitfall to be aware of: currently, you can't use the conditional
  769 operator in slice expressions (i.e., C<?:>, since the parser confuses them
  770 with ranges). For example, the following will cause an error:
  771 
  772   $x = sequence 10;
  773   $y = rand > 0.5 ? 0 : 1; # this one is ok
  774   print $x($y ? 1 : 2);    # error !
  775  syntax error at (eval 59) line 3, near "1,
  776 
  777 For the moment, just try to stay clear of the conditional operator
  778 in slice expressions (or provide us with a patch to the parser to
  779 resolve this issue ;).
  780 
  781 =head2 Modifiers
  782 
  783 Following a suggestion originally put forward by Karl Glazebrook the
  784 latest versions of C<PDL::NiceSlice> implement I<modifiers> in slice
  785 expressions. Modifiers are convenient shorthands for common variations
  786 on PDL slicing. The general syntax is
  787 
  788     $pdl(<slice>;<modifier>)
  789 
  790 Four modifiers are currently implemented:
  791 
  792 =over
  793 
  794 =item *
  795 
  796 C<_> : I<flatten> the ndarray before applying the slice expression. Here
  797 is an example
  798 
  799    $y = sequence 3, 3;
  800    print $y(0:-2;_); # same as $y->flat->(0:-2)
  801  [0 1 2 3 4 5 6 7]
  802 
  803 which is quite different from the same slice expression without the modifier
  804 
  805    print $y(0:-2);
  806  [
  807   [0 1]
  808   [3 4]
  809   [6 7]
  810  ]
  811 
  812 =item *
  813 
  814 C<|> : L<sever|PDL::Core/sever> the link to the ndarray, e.g.
  815 
  816    $x = sequence 10;
  817    $y = $x(0:2;|)++;  # same as $x(0:2)->sever++
  818    print $y;
  819  [1 2 3]
  820    print $x; # check if $x has been modified
  821  [0 1 2 3 4 5 6 7 8 9]
  822 
  823 =item *
  824 
  825 C<?> : short hand to indicate that this is really a
  826 L<where|PDL::Primitive/where> expression
  827 
  828 As expressions like
  829 
  830   $x->where($x>5)
  831 
  832 are used very often you can write that shorter as
  833 
  834   $x($x>5;?)
  835 
  836 With the C<?>-modifier the expression preceding the modifier is I<not>
  837 really a slice expression (e.g. ranges are not allowed) but rather an
  838 expression as required by the L<where|PDL::Primitive/where> method.
  839 For example, the following code will raise an error:
  840 
  841   $x = sequence 10;
  842   print $x(0:3;?);
  843  syntax error at (eval 70) line 3, near "0:"
  844 
  845 That's about all there is to know about this one.
  846 
  847 =item *
  848 
  849 C<-> : I<squeeze> out any singleton dimensions. In less technical terms:
  850 reduce the number of dimensions (potentially) by deleting all
  851 dims of size 1. It is equivalent to doing a L<reshape|PDL::Core/reshape>(-1).
  852 That can be very handy if you want to simplify
  853 the results of slicing operations:
  854 
  855   $x = ones 3, 4, 5;
  856   $y = $x(1,0;-); # easier to type than $x((1),(0))
  857   print $y->info;
  858  PDL: Double D [5]
  859 
  860 It also provides a unique opportunity to have smileys in your code!
  861 Yes, PDL gives new meaning to smileys.
  862 
  863 =back
  864 
  865 =head2 Combining modifiers
  866 
  867 Several modifiers can be used in the same expression, e.g.
  868 
  869   $c = $x(0;-|); # squeeze and sever
  870 
  871 Other combinations are just as useful, e.g. C<;_|> to flatten and
  872 sever. The sequence in which modifiers are specified is not important.
  873 
  874 A notable exception is the C<where> modifier (C<?>) which must not
  875 be combined with other flags (let me know if you see a good reason
  876 to relax this rule).
  877 
  878 Repeating any modifier will raise an error:
  879 
  880   $c = $x(-1:1;|-|); # will cause error
  881  NiceSlice error: modifier | used twice or more
  882 
  883 Modifiers are still a new and experimental feature of
  884 C<PDL::NiceSlice>. I am not sure how many of you are actively using
  885 them. I<Please do so and experiment with the syntax>. I think
  886 modifiers are very useful and make life a lot easier.  Feedback is
  887 welcome as usual. The modifier syntax will likely be further tuned in
  888 the future but we will attempt to ensure backwards compatibility
  889 whenever possible.
  890 
  891 =head2 Argument formats
  892 
  893 In slice expressions you can use ranges and secondly,
  894 ndarrays as 1D index lists (although compare the description
  895 of the C<?>-modifier above for an exception).
  896 
  897 =over 2
  898 
  899 =item * ranges
  900 
  901 You can access ranges using the usual C<:> separated format:
  902 
  903   $x($start:$stop:$step) *= 4;
  904 
  905 Note that you can omit the trailing step which then defaults to 1.  Double
  906 colons (C<::>) are not allowed to avoid clashes with Perl's namespace
  907 syntax. So if you want to use steps different from the default
  908 you have to also at least specify the stop position.
  909 Examples:
  910 
  911   $x(::2);   # this won't work (in the way you probably intended)
  912   $x(:-1:2); # this will select every 2nd element in the 1st dim
  913 
  914 Just as with L<PDL::Slices/slice> negative indices count from the end of the dimension
  915 backwards with C<-1> being the last element. If the start index is larger
  916 than the stop index the resulting ndarray will have the elements in reverse
  917 order between these limits:
  918 
  919   print $x(-2:0:2);
  920  [8 6 4 2 0]
  921 
  922 A single index just selects the given index in the slice
  923 
  924   print $x(5);
  925  [5]
  926 
  927 Note, however, that the corresponding dimension is not removed from
  928 the resulting ndarray but rather reduced to size 1:
  929 
  930   print $x(5)->info
  931  PDL: Double D [1]
  932 
  933 If you want to get completely rid of that dimension enclose the index
  934 in parentheses (again similar to the L<PDL::Slices/slice> syntax):
  935 
  936   print $x((5));
  937  5
  938 
  939 In this particular example a 0D ndarray results. Note that this syntax is
  940 only allowed with a single index. All these will be errors:
  941 
  942   print $x((0,4));  # will work but not in the intended way
  943   print $x((0:4));  # compile time error
  944 
  945 An empty argument selects the whole dimension, in this example
  946 all of the first dimension:
  947 
  948   print $x(,(0));
  949 
  950 Alternative ways to select a whole dimension are
  951 
  952   $x = sequence 5, 5; 
  953   print $x(:,(0));
  954   print $x(0:-1,(0));
  955   print $x(:-1,(0));
  956   print $x(0:,(0));
  957 
  958 Arguments for trailing dimensions can be omitted. In that case
  959 these dimensions will be fully kept in the sliced ndarray:
  960 
  961   $x = random 3,4,5;
  962   print $x->info;
  963  PDL: Double D [3,4,5]
  964   print $x((0))->info;
  965  PDL: Double D [4,5]
  966   print $x((0),:,:)->info;  # a more explicit way
  967  PDL: Double D [4,5]
  968   print $x((0),,)->info;    # similar
  969  PDL: Double D [4,5]
  970 
  971 =item * dummy dimensions
  972 
  973 As in L<PDL::Slices/slice>, you can insert a dummy dimension by preceding a
  974 single index argument with '*'.  A lone '*' inserts a dummy dimension of 
  975 order 1; a '*' followed by a number inserts a dummy dimension of that order.
  976 
  977 =item * ndarray index lists
  978 
  979 The second way to select indices from a dimension is via 1D ndarrays
  980 of indices. A simple example:
  981 
  982   $x = random 10;
  983   $idx = long 3,4,7,0;
  984   $y = $x($idx);
  985 
  986 This way of selecting indices was previously only possible using
  987 L<PDL::Slices/dice> (C<PDL::NiceSlice> attempts to unify the
  988 C<slice> and C<dice> interfaces). Note that the indexing ndarrays must
  989 be 1D or 0D. Higher dimensional ndarrays as indices will raise an error:
  990 
  991   $x = sequence 5, 5;
  992   $idx2 = ones 2,2;
  993   $sum = $x($idx2)->sum;
  994  ndarray must be <= 1D at /home/XXXX/.perldlrc line 93
  995 
  996 Note that using index ndarrays is not as efficient as using ranges.
  997 If you can represent the indices you want to select using a range
  998 use that rather than an equivalent index ndarray. In particular,
  999 memory requirements are increased with index ndarrays (and execution
 1000 time I<may> be longer). That said, if an index ndarray is the way to
 1001 go use it!
 1002 
 1003 =back
 1004 
 1005 As you might have expected ranges and index ndarrays can be freely
 1006 mixed in slicing expressions:
 1007 
 1008   $x = random 5, 5;
 1009   $y = $x(-1:2,pdl(3,0,1));
 1010 
 1011 =head2 ndarrays as indices in ranges
 1012 
 1013 You can use ndarrays to specify indices in ranges. No need to
 1014 turn them into proper perl scalars with the new slicing syntax.
 1015 However, make sure they contain not more than one element! Otherwise
 1016 a runtime error will be triggered. First a couple of examples that
 1017 illustrate proper usage:
 1018 
 1019   $x = sequence 5, 5;
 1020   $rg = pdl(1,-1,3);
 1021   print $x($rg(0):$rg(1):$rg(2),2);
 1022  [
 1023   [11 14]
 1024  ]
 1025   print $x($rg+1,:$rg(0));
 1026  [
 1027   [2 0 4]
 1028   [7 5 9]
 1029  ]
 1030 
 1031 The next one raises an error 
 1032 
 1033   print $x($rg+1,:$rg(0:1));
 1034  multielement ndarray where only one allowed at XXX/Core.pm line 1170.
 1035 
 1036 The problem is caused by using the 2-element ndarray C<$rg(0:1)> as the
 1037 stop index in the second argument C<:$rg(0:1)> that is interpreted as
 1038 a range by C<PDL::NiceSlice>. You I<can> use multielement ndarrays as
 1039 index ndarrays as described above but not in ranges. And
 1040 C<PDL::NiceSlice> treats any expression with unprotected C<:>'s as a
 1041 range.  I<Unprotected> means as usual 
 1042 I<"not occurring between matched parentheses">.
 1043 
 1044 =head1 IMPLEMENTATION
 1045 
 1046 C<PDL::NiceSlice> exploits the ability of Perl to use source filtering
 1047 (see also L<perlfilter>). A source filter basically filters (or
 1048 rewrites) your perl code before it is seen by the
 1049 compiler. C<PDL::NiceSlice> searches through your Perl source code and when
 1050 it finds the new slicing syntax it rewrites the argument list
 1051 appropriately and splices a call to the C<slice> method using the
 1052 modified arg list into your perl code. You can see how this works in
 1053 the L<perldl> or L<pdl2|PDL::Perldl2> shells by switching on
 1054 reporting (see above how to do that).
 1055 
 1056 =head1 BUGS
 1057 
 1058 =head2 Conditional operator
 1059 
 1060 The conditional operator can't be used in slice expressions (see
 1061 above).
 1062 
 1063 =head2 The C<DATA> file handle
 1064 
 1065 I<Note>: To avoid clobbering the C<DATA> filehandle C<PDL::NiceSlice>
 1066 switches itself off when encountering the C<__END__> or C<__DATA__> tokens.
 1067 This should not be a problem for you unless you use C<SelfLoader> to load
 1068 PDL code including the new slicing from that section. It is even desirable
 1069 when working with L<Inline::Pdlpp>, see below.
 1070 
 1071 =head2 Possible interaction with L<Inline::Pdlpp>
 1072 
 1073 There is currently an undesired interaction between C<PDL::NiceSlice>
 1074 and L<Inline::Pdlpp>. Since PP code generally
 1075 contains expressions of the type C<$var()> (to access ndarrays, etc)
 1076 C<PDL::NiceSlice> recognizes those I<incorrectly> as
 1077 slice expressions and does its substitutions. This is not a problem
 1078 if you use the C<DATA> section for your Pdlpp code -- the recommended
 1079 place for Inline code anyway. In that case
 1080 C<PDL::NiceSlice> will have switched itself off before encountering any
 1081 Pdlpp code (see above):
 1082 
 1083     # use with Inline modules
 1084   use PDL;
 1085   use PDL::NiceSlice;
 1086   use Inline Pdlpp;
 1087 
 1088   $x = sequence(10);
 1089   print $x(0:5);
 1090 
 1091   __END__
 1092 
 1093   __Pdlpp__
 1094 
 1095   ... inline stuff
 1096 
 1097 Otherwise switch C<PDL::NiceSlice> explicitly off around the
 1098 Inline::Pdlpp code:
 1099 
 1100   use PDL::NiceSlice;
 1101 
 1102   $x = sequence 10;
 1103   $x(0:3)++;
 1104   $x->inc;
 1105 
 1106   no PDL::NiceSlice; # switch off before Pdlpp code
 1107   use Inline Pdlpp => "Pdlpp source code";
 1108 
 1109 The cleaner solution is to always stick with the
 1110 C<DATA> way of including your C<Inline> code as
 1111 in the first example. That way you keep your nice Perl
 1112 code at the top and all the ugly Pdlpp stuff etc at
 1113 the bottom.
 1114 
 1115 =head2 Bug reports
 1116 
 1117 Feedback and bug reports are welcome. Please include an example
 1118 that demonstrates the problem. Log bug reports in the PDL
 1119 issues tracker at L<https://github.com/PDLPorters/pdl/issues>
 1120 or send them to the pdl-devel mailing list
 1121 (see L<http://pdl.perl.org/?page=mailing-lists>).
 1122 
 1123 
 1124 =head1 COPYRIGHT
 1125 
 1126 Copyright (c) 2001, 2002 Christian Soeller. All Rights Reserved.
 1127 This module is free software. It may be used, redistributed
 1128 and/or modified under the same terms as PDL itself
 1129 (see L<http://pdl.perl.org>).
 1130 
 1131 =cut
 1132 
 1133 1;