1# These are suspended for now... 2 3# use blib; # For Types.pm 4# require './PP.pm'; 5 6open PP, "PP.pm" or die "can't open PP.pm"; 7$str = join '',<PP>; 8$str =~ m|\@PDL::PP::EXPORT\s*=\s*qw/([^/]*)/|s; 9$str = $1; # Get the contents of the qw// 10 11 12$pm = ' 13=head1 NAME 14 15PDL::PP::Dump -- dump pp_xxx calls to stdout 16 17=head1 SYNOPSIS 18 19 perl -MPDL::PP::Dump Basic/Ops/ops.pd 20 21=head1 DESCRIPTION 22 23The most basic PP script debugger thinkable. 24 25=head1 AUTHOR 26 27Christian Soeller <c.soeller@auckland.ac.nz> . 28 29=cut 30 31package PDL::PP::Dump; 32 33use Exporter; 34@ISA = Exporter; 35 36@EXPORT = qw('.$str.q|); 37 38my $typecheck =0; 39 40sub import { 41 my ($pack,$arg) = @_; 42 $typecheck =1 if defined $arg && $arg =~ /^typecheck$/i; 43 @_ = ($pack); 44 goto &Exporter::import; 45} 46 47sub printargs { 48 my $name = shift; 49 print "$name("; 50 print join ',',map("'$_'",@_); 51 print ");\n"; 52} 53 54for (@EXPORT) { 55 if ($_ !~ /pp_def/) { 56 my $def = "sub $_ { printargs($_,\@_) unless \$typecheck }"; 57 # print "defining =>\n$def\n"; 58 eval($def); 59 } 60} 61 62sub pp_def { 63 my($name,%hash) = @_; 64 use PDL::Types ':All'; 65 66 if ($typecheck) { 67 my @alltypes = ppdefs; my $jointypes = join '',@alltypes; 68 my $types = exists $hash{GenericTypes} ? $hash{GenericTypes} : [@alltypes]; 69 for my $key (qw/Code BackCode/) { 70 if (exists $hash{$key}) { 71 while ($hash{$key} =~ s/\$T([a-zA-Z]+)\s*\(([^)]*)\)//) { 72 my ($mactypes,$alternatives) = ($1,$2); 73 # print "type macro ($mactypes) in $name\n"; 74 my @mactypes = split '', $mactypes; 75 print "$name has extra types in macro: $mactypes vs $jointypes\n" 76 unless $mactypes =~ /^\s*[$jointypes]+\s*$/; 77 for my $gt (@$types) { 78 print "$name has no Macro for generic type $gt (has $mactypes)" 79 unless grep {$gt eq $_} @mactypes; 80 } 81 } 82 } 83 } 84 } else { 85 print "pp_def('$name',\n"; 86 foreach (keys(%hash)) { 87 if ($_ =~ /(Generic)*Types/) { 88 print "$_ => [" . join(',',@{$hash{$_}}) . "]\n"; 89 } else { 90 print "$_ =>\n'".$hash{$_}."',\n"; 91 } 92 } 93 print ");\n"; 94 } 95} 96 971; 98|; 99 100print $pm; 101 102