view release on metacpan or  search on metacpan

Pari.pm  view on Meta::CPAN

  my @const;			# Need to do it outside any block!
  @_ = map {
    if (/^:(?!DEFAULT)(.*)/) {
      my $tag = $1;
      my $sect = $tag;
      my @pre;
      $tag = -1, @pre = (@EXPORT_OK,@EXPORT) if ($tag eq 'all');
      $tag = -1 if ($tag eq 'PARI');
      $tag = $sections{$tag} if $tag !~ /^-?\d+$/ and exists $sections{$tag};
      push @pre, 'link_gnuplot', 'set_plot_fh', 'plot_outfile_set' if $tag eq $sections{graphic};
      if ($tag =~ /^prec=(\d+)$/) {
	setprecision($1);
	();
      } elsif ($tag =~ /^(int|hex|float)$/) {
	die "Overloaded constants are not supported in this version of Perl"
	  if $] < 5.004_69;
	push @const, $overloaded_const_word{$tag} => $overloaded_const{$tag};
	# print "Constants: $overloaded_const_word{$tag} => $overloaded_const{$tag} \n";
	();
      } elsif (defined $tag and $tag =~ /^-?\d+$/) {
	(@pre, listPari($tag));
      } else {
	die "Unknown section '$sect' specified";
      }
    } else {
      ($_);
    }
  } @_;

  overload::constant(splice @const, 0, 2) while @const;

  # print "EXPORT_OK: @EXPORT_OK\n";
  push @EXPORT_OK,
      grep( ($_ ne ':DEFAULT'
	     and not $export_ok{$_}++
	     and (eval {loadPari($_), 1} or warn $@), !$@) ,
	    @_);
  # Invalidate Exporter cache, so that new %EXPORT_OK is noticed:
  undef %EXPORT;
  # print "EXPORT_OK: @EXPORT_OK\n";
  &Exporter::export($p,(caller(0))[0],@_);
}

sub _can {			# Without taking into account inheritance...
  my ($obj, $meth) = (shift, shift);
  return \&$meth if defined &$meth;
  return \&$meth if eval {loadPari($meth), 1};
  return;
}

sub can {
  my ($obj, $meth) = (@_);
  my $f = $obj->SUPER::can($meth);
  return $f if defined $f;
  # There is no "usual" way to get the function; try loadPari()
  $f = eval { loadPari($meth) };
  return $f if defined $f;
  return;
}

sub O ($;$) {
  return PARI("O($_[0]^$_[1])") if @_ == 2;
  return PARI("O($_[0])") if typ($_[0]) == 10; # Poly
  Carp::croak("O(number**power) not implemented, use O(number,power) instead");
}

sub PARImat_tr {mattranspose(PARImat(@_))}
#sub string ($$) {
#  PARI (qq'string($_[0],"$_[1]")');
#}

sub installPerlFunction {my @a=@_; $a[0] = \&{$a[0]}; installPerlFunctionCV(@a)}

my $name;

for $name (keys %converted) {
  push @EXPORT_OK, $name;
  next if defined &$name;
  # string needs to format numbers to 8.3...
  no strict 'refs';
  if ($name eq 'addhelp' or $name eq 'plotstring') {
    *$name = sub { PARI ( qq($name($_[0],"$_[1]")) ) }
  } else {				# probably `kill' only
    *$name = sub { local $"=','; PARI("$name(@_)") }	# "
  }
}

@export_ok{@EXPORT_OK,@EXPORT} = (1) x (@EXPORT_OK + @EXPORT);

sub __my_NOP {}

my %supported_cmd = qw(q 0   p setprecision   e __my_NOP);		# ???  WRONG !!!
my $supported_cmd_rx = '(?:' . join( '|', keys %supported_cmd) . ')';
$supported_cmd_rx = qr($supported_cmd_rx);
my $matched_par;
$matched_par = qr[[^()]*(?:\((??{$matched_par})\)[^()]*)*];		# arbitrary string with ( and ) matching

sub remove_nl ($) { (my $in = shift) =~ s/\n//g; $in }

my %POSTF = qw(K 1 M 2 G 3 T 4);
sub allocatemem_prot ($) {
  my $mem = shift;
  $mem =~ s/^(.*)([KMGT])/$1*1000**$POSTF{$2}/e;
  eval {allocatemem($mem); 1} or $@ =~ /^PARI:\s\sat\s+\S*\s+line\s+\d+\.?\s*$/ or die "allocatemem($mem) died: $@"
}

sub MP___a___($) { $Math::Pari::__args::a->[shift] }
sub __wrap_PARI_macro ($) {
  my $name = shift;
  sub {
    local $Math::Pari::__args::a = [@_];
    PARI("$name(" . (join ',', map "MP___a___($_)", 0..$#_) . ")")
  }
}

sub PARI_with_default_mem ($) {
  my($in) = shift;
  $in =~ s/(?:^|;)default\(parisize,("?)($matched_par)\1\)\s*$// or return PARI($in);
  my $s = "$2";
  PARI($in);
  allocatemem_prot($s);