File Coverage

blib/lib/PDLA/Types.pm
Criterion Covered Total %
statement 24 98 24.4
branch 3 28 10.7
condition 0 3 0.0
subroutine 8 31 25.8
pod 6 7 85.7
total 41 167 24.5


line stmt bran cond sub pod time code
1              
2             ### Generated from Types.pm.PL automatically - do not modify! ###
3              
4             package PDLA::Types;
5             require Exporter;
6 2     2   8 use Carp;
  2         3  
  2         3515  
7              
8              
9             @EXPORT = qw( $PDLA_B $PDLA_S $PDLA_US $PDLA_L $PDLA_IND $PDLA_LL $PDLA_F $PDLA_D $PDLA_A
10             @pack %typehash );
11              
12             @EXPORT_OK = (@EXPORT, qw/types ppdefs typesrtkeys mapfld typefld/);
13             %EXPORT_TAGS = (
14             All=>[@EXPORT,qw/types ppdefs typesrtkeys mapfld typefld/],
15             );
16              
17             @ISA = qw( Exporter );
18              
19              
20              
21             # Data types/sizes (bytes) [must be in order of complexity]
22             # Enum
23             ( $PDLA_B, $PDLA_S, $PDLA_US, $PDLA_L, $PDLA_IND, $PDLA_LL, $PDLA_F, $PDLA_D, $PDLA_A ) = (0..8);
24             # Corresponding pack types
25             @pack= qw/C* s* S* l* q* q* f* d* (a8)*/;
26             @names= qw/PDLA_B PDLA_S PDLA_US PDLA_L PDLA_IND PDLA_LL PDLA_F PDLA_D PDLA_A/;
27              
28             %PDLA::Types::typehash = (
29             PDLA_B =>
30             {
31             'ppsym' => 'B',
32             'ioname' => 'byte',
33             'convertfunc' => 'byte',
34             'usenan' => 0,
35             'sym' => 'PDLA_B',
36             'ppforcetype' => 'byte',
37             'ctype' => 'PDLA_Byte',
38             'numval' => 0,
39             'defbval' => 'UCHAR_MAX',
40             'realctype' => 'unsigned char'
41             }
42             ,
43             PDLA_S =>
44             {
45             'convertfunc' => 'short',
46             'ioname' => 'short',
47             'ppsym' => 'S',
48             'sym' => 'PDLA_S',
49             'ppforcetype' => 'short',
50             'usenan' => 0,
51             'numval' => 1,
52             'ctype' => 'PDLA_Short',
53             'realctype' => 'short',
54             'defbval' => 'SHRT_MIN'
55             }
56             ,
57             PDLA_US =>
58             {
59             'realctype' => 'unsigned short',
60             'defbval' => 'USHRT_MAX',
61             'numval' => 2,
62             'ctype' => 'PDLA_Ushort',
63             'sym' => 'PDLA_US',
64             'ppforcetype' => 'ushort',
65             'usenan' => 0,
66             'ppsym' => 'U',
67             'convertfunc' => 'ushort',
68             'ioname' => 'ushort'
69             }
70             ,
71             PDLA_L =>
72             {
73             'numval' => 3,
74             'ctype' => 'PDLA_Long',
75             'realctype' => 'int',
76             'defbval' => 'INT_MIN',
77             'ppsym' => 'L',
78             'convertfunc' => 'long',
79             'ioname' => 'long',
80             'sym' => 'PDLA_L',
81             'ppforcetype' => 'int',
82             'usenan' => 0
83             }
84             ,
85             PDLA_IND =>
86             {
87             'realctype' => 'long',
88             'defbval' => 'LONG_MIN',
89             'numval' => 4,
90             'ctype' => 'PDLA_Indx',
91             'ppforcetype' => 'indx',
92             'sym' => 'PDLA_IND',
93             'usenan' => 0,
94             'ppsym' => 'N',
95             'convertfunc' => 'indx',
96             'ioname' => 'indx'
97             }
98             ,
99             PDLA_LL =>
100             {
101             'defbval' => 'LONG_MIN',
102             'realctype' => 'long',
103             'ctype' => 'PDLA_LongLong',
104             'numval' => 5,
105             'usenan' => 0,
106             'sym' => 'PDLA_LL',
107             'ppforcetype' => 'longlong',
108             'ppsym' => 'Q',
109             'ioname' => 'longlong',
110             'convertfunc' => 'longlong'
111             }
112             ,
113             PDLA_F =>
114             {
115             'ctype' => 'PDLA_Float',
116             'numval' => 6,
117             'defbval' => '-FLT_MAX',
118             'realctype' => 'float',
119             'ioname' => 'float',
120             'convertfunc' => 'float',
121             'ppsym' => 'F',
122             'usenan' => 1,
123             'ppforcetype' => 'float',
124             'sym' => 'PDLA_F'
125             }
126             ,
127             PDLA_D =>
128             {
129             'ppsym' => 'D',
130             'convertfunc' => 'double',
131             'ioname' => 'double',
132             'ppforcetype' => 'double',
133             'sym' => 'PDLA_D',
134             'usenan' => 1,
135             'numval' => 7,
136             'ctype' => 'PDLA_Double',
137             'realctype' => 'double',
138             'defbval' => '-DBL_MAX'
139             }
140             ,
141             PDLA_A =>
142             {
143             'sym' => 'PDLA_A',
144             'ppforcetype' => 'anyval',
145             'usenan' => 0,
146             'ppsym' => 'A',
147             'convertfunc' => 'anyval',
148             'ioname' => 'anyval',
149             'realctype' => 'double',
150             'defbval' => '-DBL_MAX',
151             'numval' => 8,
152             'ctype' => 'PDLA_Anyval'
153             }
154             ,
155             ); # end typehash definition
156              
157             # Cross-reference by common names
158             %PDLA::Types::typenames = ();
159             for my $k(keys %PDLA::Types::typehash) {
160             my $n = $PDLA::Types::typehash{$k}->{'numval'};
161             $PDLA::Types::typenames{$k} = $n;
162             $PDLA::Types::typenames{$n} = $n;
163             $PDLA::Types::typenames{$PDLA::Types::typehash{$k}->{ioname}} = $n;
164             $PDLA::Types::typenames{$PDLA::Types::typehash{$k}->{ctype}} = $n;
165             }
166              
167              
168             =head1 NAME
169              
170             PDLA::Types - define fundamental PDLA Datatypes
171              
172             =head1 SYNOPSIS
173              
174             use PDLA::Types;
175              
176             $pdl = ushort( 2.0, 3.0 );
177             print "The actual c type used to store ushort's is '" .
178             $pdl->type->realctype() . "'\n";
179             The actual c type used to store ushort's is 'unsigned short'
180              
181             =head1 DESCRIPTION
182              
183             Internal module - holds all the PDLA Type info. The type info can be
184             accessed easily using the C object returned by
185             the L method.
186              
187             Skip to the end of this document to find out how to change
188             the set of types supported by PDLA.
189              
190             =head1 Support functions
191              
192             A number of functions are available for module writers
193             to get/process type information. These are used in various
194             places (e.g. C, C) to generate the
195             appropriate type loops, etc.
196              
197             =head2 typesrtkeys
198              
199             return array of keys of typehash sorted in order of type complexity
200              
201             =cut
202              
203             sub typesrtkeys {
204 15     15 1 89 return sort {$typehash{$a}->{numval} <=> $typehash{$b}->{numval}}
  288         439  
205             keys %typehash;
206             }
207              
208             =head2 ppdefs
209              
210             return array of pp symbols for all known types
211              
212             =cut
213              
214             sub ppdefs {
215 3     3 1 10 return map {$typehash{$_}->{ppsym}} typesrtkeys;
  27         53  
216             }
217              
218             =head2 typefld
219              
220             return specified field (C<$fld>) for specified type (C<$type>)
221             by querying type hash
222              
223             =cut
224              
225             sub typefld {
226 126     126 1 164 my ($type,$fld) = @_;
227 126 50       234 croak "unknown type $type" unless exists $typehash{$type};
228             croak "unknown field $fld in type $type"
229 126 50       261 unless exists $typehash{$type}->{$fld};
230 126         379 return $typehash{$type}->{$fld};
231             }
232              
233             =head2 mapfld (in_value, in_key, out_key)
234              
235             Map a given source field to the corresponding target field by
236             querying the type hash. This gives you a way to say, "Find the type
237             whose C<$in_key> is equal to C<$value>, and return that type's value
238             for C<$out_key>. For example:
239              
240             # Does byte type use nan?
241             $uses_nan = PDLA::Types::mapfld(byte => 'ppforcetype', 'usenan');
242             # Equivalent:
243             $uses_nan = byte->usenan;
244            
245             # What is the actual C type for the value that we call 'long'?
246             $type_name = PDLA::Types::mapfld(long => 'convertfunc', 'realctype');
247             # Equivalent:
248             $type_name = long->realctype;
249              
250             As you can see, the equivalent examples are much shorter and legible, so you
251             should only use mapfld if you were given the type index (in which case the
252             actual type is not immediately obvious):
253              
254             $type_index = 4;
255             $type_name = PDLA::Types::mapfld($type_index => numval, 'realctype');
256              
257             =cut
258              
259             sub mapfld {
260 4     4 1 6 my ($type,$src,$trg) = @_;
261 4         10 my @keys = grep {$typehash{$_}->{$src} eq $type} typesrtkeys;
  36         65  
262 4 50       26 return @keys > 0 ? $typehash{$keys[0]}->{$trg} : undef;
263             }
264              
265             =head2 typesynonyms
266              
267             =for ref
268              
269             return type related synonym definitions to be included in pdl.h .
270             This routine must be updated to include new types as required.
271             Mostly the automatic updating should take care of the vital
272             things.
273              
274             =cut
275              
276             sub typesynonyms {
277             my $add = join "\n",
278 0           map {"#define PDLA_".typefld($_,'ppsym')." ".typefld($_,'sym')}
279 0     0 1   grep {"PDLA_".typefld($_,'ppsym') ne typefld($_,'sym')} typesrtkeys;
  0            
280 0           print "adding...\n$add\n";
281 0           return "$add\n";
282             }
283              
284             =head2 datatypes_header
285              
286             =for ref
287              
288             return C header text for F and F.
289              
290             =cut
291              
292             sub datatypes_header {
293 0     0 1   require Config;
294 0           $PDLA_Indx_type = $Config::Config{'ivtype'};
295 0 0         warn "Using new 64bit index support\n" if $Config::Config{'ivsize'}==8;
296              
297 0           my $enum = '';
298 0           my $typedefs = '';
299 0           for (sort { $typehash{$a}{'numval'}<=>$typehash{$b}{'numval'} } keys %typehash) {
  0            
300 0           $enum .= $typehash{$_}{'sym'}.", ";
301 0           $typedefs .= "typedef $typehash{$_}{'realctype'} $typehash{$_}{'ctype'};\n";
302             }
303 0           chop $enum;
304 0           chop $enum;
305              
306 0           my $indx_type = typefld('PDLA_IND','realctype');
307 0           $typedefs .= '#define IND_FLAG ';
308 0 0         if ($indx_type eq 'long'){
    0          
309 0           $typedefs .= qq|"ld"|;
310             } elsif ($indx_type eq 'long long'){
311 0           $typedefs .= qq|"lld"|;
312             } else {
313 0           $typedefs .= qq|"d"|;
314             }
315 0           $typedefs .= "\n\n";
316              
317 0           my $PDLA_DATATYPES = <<"EOD";
318              
319             /*****************************************************************************/
320             /*** This section of .h file generated automatically by ***/
321             /*** PDLA::Types::datatypes_header() - don't edit manually ***/
322              
323             /* Data types/sizes [must be in order of complexity] */
324              
325             enum pdl_datatypes { $enum };
326              
327             /* Define the pdl data types */
328              
329             $typedefs
330              
331             /* typedef $PDLA_Indx_type PDLA_Indx; */
332              
333             /*****************************************************************************/
334              
335             EOD
336              
337 0           $PDLA_DATATYPES .= "\n".typesynonyms()."\n";
338 0           $PDLA_DATATYPES;
339             }
340              
341             =head1 PDLA::Type OBJECTS
342              
343             This module declares one class - C - objects of this class
344             are returned by the L method of a piddle. It has
345             several methods, listed below, which provide an easy way to access
346             type information:
347              
348             Additionally, comparison and stringification are overloaded so that
349             you can compare and print type objects, e.g.
350              
351             $nofloat = 1 if $pdl->type < float;
352             die "must be double" if $type != double;
353              
354             For further examples check again the
355             L method.
356              
357             =over 4
358              
359             =item enum
360              
361             Returns the number representing this datatype (see L).
362              
363             =item symbol
364              
365             Returns one of 'PDLA_B', 'PDLA_S', 'PDLA_US', 'PDLA_L', 'PDLA_LL', 'PDLA_F'
366             or 'PDLA_D'.
367              
368             =item ctype
369              
370             Returns the macro used to represent this type in C code (eg 'PDLA_Long').
371              
372             =item ppsym
373              
374             The letter used to represent this type in PP code code (eg 'U' for L).
375              
376             =item realctype
377              
378             The actual C type used to store this type.
379              
380             =item shortctype
381              
382             The value returned by C without the 'PDLA_' prefix.
383              
384             =item badvalue
385              
386             The special numerical value used to represent bad values for this type.
387             See L for more details.
388              
389             =cut
390              
391              
392             =item orig_badvalue
393              
394             The default special numerical value used to represent bad values for this
395             type. (You can change the value that represents bad values for each type
396             during runtime.) See the
397             L for more details.
398              
399             =cut
400              
401              
402             =back
403              
404             =cut
405              
406             {
407             package PDLA::Type;
408             sub new {
409 0     0     my($type,$val) = @_;
410 0 0         if("PDLA::Type" eq ref $val) { return bless [@$val],$type; }
  0            
411 0 0 0       if(ref $val and $val->isa(PDLA)) {
412 0 0         if($val->getndims != 0) {
413 0           PDLA::Core::barf(
414             "Can't make a type out of non-scalar piddle $val!");
415             }
416 0           $val = $val->at;
417             }
418 0 0         PDLA::Core::barf("Can't make a type out of non-scalar $val!".
419             (ref $val)."!") if ref $val;
420              
421 0 0         if(length($PDLA::Types::typenames{$val})) {
422 0           $val =~ s/^\s*//o;
423 0           $val =~ s/\s*$//o;
424 0           return bless [$PDLA::Types::typenames{$val}],$type;
425             } else {
426             die("Unknown type string '$val' (should be one of ".
427 0           join(",",map { $PDLA::Types::typehash{$_}->{ioname} } @names).
  0            
428             ")\n");
429             }
430             }
431              
432 0     0     sub enum { return $_[0]->[0]; }
433 0     0     sub symbol { return $PDLA::Types::names[ $_[0]->enum ]; }
434             sub PDLA::Types::types { # return all known types as type objects
435 0     0 0   map { new PDLA::Type PDLA::Types::typefld($_,'numval') }
  0            
436             PDLA::Types::typesrtkeys();
437             }
438              
439             sub ctype {
440 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{ctype};
441             }
442             sub ppsym {
443 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{ppsym};
444             }
445             sub realctype {
446 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{realctype};
447             }
448             sub ppforcetype {
449 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{ppforcetype};
450             }
451             sub convertfunc {
452 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{convertfunc};
453             }
454             sub sym {
455 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{sym};
456             }
457             sub numval {
458 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{numval};
459             }
460             sub usenan {
461 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{usenan};
462             }
463             sub ioname {
464 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{ioname};
465             }
466             sub defbval {
467 0     0     return $PDLA::Types::typehash{$_[0]->symbol}->{defbval};
468             }
469              
470 2     2   10 no strict 'refs';
  2         2  
  2         286  
471             sub badvalue {
472 0     0     my ( $self, $val ) = @_;
473 0           my $name = "PDLA::_badvalue_int" . $self->enum();
474 0 0         if ( defined $val ) { return &{$name}( $val )->sclr; }
  0            
  0            
475 0           else { return &{$name}()->sclr; }
  0            
476             }
477              
478             sub orig_badvalue {
479 0     0     my $self = shift;
480 0           my $name = "PDLA::_default_badvalue_int" . $self->enum();
481 0           return &{$name}()->sclr;
  0            
482             }
483 2     2   10 use strict 'refs';
  2         2  
  2         426  
484              
485              
486 0     0     sub shortctype { my $txt = $_[0]->ctype; $txt =~ s/PDLA_//; return $txt; }
  0            
  0            
487              
488             # make life a bit easier
489             use overload (
490 0     0   0 "\"\"" => sub { lc $_[0]->shortctype },
491 0     0   0 "eq" => sub { my($self, $other, $swap) = @_;
492 0         0 return ("$self" eq $other);
493             },
494 0     0   0 "cmp" => sub { my($self, $other, $swap) = @_;
495 0 0       0 return ($swap ? $other cmp "$self" : "$self" cmp $other);
496             },
497 0 0   0   0 "<=>" => sub { $_[2] ? $_[1]->enum <=> $_[0]->enum :
498             $_[0]->enum <=> $_[1]->enum },
499 2     2   9 );
  2         2  
  2         29  
500              
501              
502             } # package: PDLA::Type
503             # Return
504             1;
505              
506             __END__