| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# |
|
2
|
|
|
|
|
|
|
# this script is executed directly from the top-level Makefile.PL |
|
3
|
|
|
|
|
|
|
# (ie before the standard "loop through the directories" behaviour |
|
4
|
|
|
|
|
|
|
# of the WriteMakefile() call in that file) |
|
5
|
|
|
|
|
|
|
# |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use strict; |
|
8
|
|
|
|
|
|
|
use Config; |
|
9
|
|
|
|
|
|
|
use File::Basename qw(&basename &dirname); |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
my @TYPE_VERBATIM = qw/ |
|
12
|
|
|
|
|
|
|
realctype ppforcetype usenan real unsigned integer identifier |
|
13
|
|
|
|
|
|
|
/; |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Figure out the 4 byte integer type on this machine |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub packtypeof_PDL_Indx { |
|
18
|
|
|
|
|
|
|
if ($Config{'ivsize'} == 8) { |
|
19
|
|
|
|
|
|
|
return 'q*'; |
|
20
|
|
|
|
|
|
|
} |
|
21
|
|
|
|
|
|
|
elsif ($Config{'ivsize'} == 4 ) { |
|
22
|
|
|
|
|
|
|
return 'l*'; |
|
23
|
|
|
|
|
|
|
} |
|
24
|
|
|
|
|
|
|
else { |
|
25
|
|
|
|
|
|
|
die "Types.pm.PL: packtype for ivsize==$Config{'ivsize'} not handled\n"; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
} |
|
28
|
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub typeof_PDL_Indx { |
|
30
|
|
|
|
|
|
|
warn "Types.pm.PL: using typedef $Config{'ivtype'} PDL_Indx\n"; |
|
31
|
|
|
|
|
|
|
return $Config{'ivtype'} |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub typeof_PDL_Long { |
|
35
|
|
|
|
|
|
|
return 'int' if $Config{'intsize'}==4; |
|
36
|
|
|
|
|
|
|
return 'long' if $Config{'longsize'}==4; |
|
37
|
|
|
|
|
|
|
die "Can not find an integer datatype of size 4 bytes!!!\n"; |
|
38
|
|
|
|
|
|
|
} |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub typeof_PDL_i64 { |
|
41
|
|
|
|
|
|
|
return $Config{i64type} or |
|
42
|
|
|
|
|
|
|
die "Can not find an integer 64 bit type"; |
|
43
|
|
|
|
|
|
|
} |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Data types *must* be listed in order of complexity!! |
|
46
|
|
|
|
|
|
|
# this is critical for type conversions!!! |
|
47
|
|
|
|
|
|
|
# |
|
48
|
|
|
|
|
|
|
my @types = ( |
|
49
|
|
|
|
|
|
|
{ |
|
50
|
|
|
|
|
|
|
identifier => 'B', |
|
51
|
|
|
|
|
|
|
pdlctype => 'PDL_Byte',# to be defined in pdl.h |
|
52
|
|
|
|
|
|
|
realctype => 'unsigned char', |
|
53
|
|
|
|
|
|
|
ppforcetype => 'byte', # for some types different from ctype |
|
54
|
|
|
|
|
|
|
usenan => 0, # do we need NaN handling for this type? |
|
55
|
|
|
|
|
|
|
packtype => 'C*', # the perl pack type |
|
56
|
|
|
|
|
|
|
defaultbadval => 'UCHAR_MAX', |
|
57
|
|
|
|
|
|
|
real=>1, |
|
58
|
|
|
|
|
|
|
integer=>1, |
|
59
|
|
|
|
|
|
|
unsigned=>1, |
|
60
|
|
|
|
|
|
|
}, |
|
61
|
|
|
|
|
|
|
{ |
|
62
|
|
|
|
|
|
|
identifier => 'S', |
|
63
|
|
|
|
|
|
|
pdlctype => 'PDL_Short', |
|
64
|
|
|
|
|
|
|
realctype => 'short', |
|
65
|
|
|
|
|
|
|
ppforcetype => 'short', |
|
66
|
|
|
|
|
|
|
usenan => 0, |
|
67
|
|
|
|
|
|
|
packtype => 's*', |
|
68
|
|
|
|
|
|
|
defaultbadval => 'SHRT_MIN', |
|
69
|
|
|
|
|
|
|
real=>1, |
|
70
|
|
|
|
|
|
|
integer=>1, |
|
71
|
|
|
|
|
|
|
unsigned=>0, |
|
72
|
|
|
|
|
|
|
}, |
|
73
|
|
|
|
|
|
|
{ |
|
74
|
|
|
|
|
|
|
identifier => 'US', |
|
75
|
|
|
|
|
|
|
onecharident => 'U', # only needed if different from identifier |
|
76
|
|
|
|
|
|
|
pdlctype => 'PDL_Ushort', |
|
77
|
|
|
|
|
|
|
realctype => 'unsigned short', |
|
78
|
|
|
|
|
|
|
ppforcetype => 'ushort', |
|
79
|
|
|
|
|
|
|
usenan => 0, |
|
80
|
|
|
|
|
|
|
packtype => 'S*', |
|
81
|
|
|
|
|
|
|
defaultbadval => 'USHRT_MAX', |
|
82
|
|
|
|
|
|
|
real=>1, |
|
83
|
|
|
|
|
|
|
integer=>1, |
|
84
|
|
|
|
|
|
|
unsigned=>1, |
|
85
|
|
|
|
|
|
|
}, |
|
86
|
|
|
|
|
|
|
{ |
|
87
|
|
|
|
|
|
|
identifier => 'L', |
|
88
|
|
|
|
|
|
|
pdlctype => 'PDL_Long', |
|
89
|
|
|
|
|
|
|
realctype => &typeof_PDL_Long, |
|
90
|
|
|
|
|
|
|
ppforcetype => 'int', |
|
91
|
|
|
|
|
|
|
usenan => 0, |
|
92
|
|
|
|
|
|
|
packtype => 'l*', |
|
93
|
|
|
|
|
|
|
defaultbadval => 'INT_MIN', |
|
94
|
|
|
|
|
|
|
real=>1, |
|
95
|
|
|
|
|
|
|
integer=>1, |
|
96
|
|
|
|
|
|
|
unsigned=>0, |
|
97
|
|
|
|
|
|
|
}, |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# The PDL_Indx type will be either the same as PDL_Long or, probably, |
|
100
|
|
|
|
|
|
|
# the same as PDL_LongLong depending on the platform. Will need to |
|
101
|
|
|
|
|
|
|
# determine the actual type at build time. |
|
102
|
|
|
|
|
|
|
{ |
|
103
|
|
|
|
|
|
|
identifier => 'IND', |
|
104
|
|
|
|
|
|
|
onecharident => 'N', # only needed if different from identifier |
|
105
|
|
|
|
|
|
|
pdlctype => 'PDL_Indx', |
|
106
|
|
|
|
|
|
|
realctype => &typeof_PDL_Indx, |
|
107
|
|
|
|
|
|
|
ppforcetype => 'indx', |
|
108
|
|
|
|
|
|
|
usenan => 0, |
|
109
|
|
|
|
|
|
|
packtype => &packtypeof_PDL_Indx, |
|
110
|
|
|
|
|
|
|
defaultbadval => 'LONG_MIN', |
|
111
|
|
|
|
|
|
|
real=>1, |
|
112
|
|
|
|
|
|
|
integer=>1, |
|
113
|
|
|
|
|
|
|
unsigned=>0, |
|
114
|
|
|
|
|
|
|
}, |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# note that the I/O routines have *not* been updated to be aware of |
|
117
|
|
|
|
|
|
|
# such a type yet |
|
118
|
|
|
|
|
|
|
{ |
|
119
|
|
|
|
|
|
|
identifier => 'LL', |
|
120
|
|
|
|
|
|
|
onecharident => 'Q', # only needed if different from identifier |
|
121
|
|
|
|
|
|
|
pdlctype => 'PDL_LongLong', |
|
122
|
|
|
|
|
|
|
realctype => &typeof_PDL_i64, |
|
123
|
|
|
|
|
|
|
ppforcetype => 'longlong', |
|
124
|
|
|
|
|
|
|
usenan => 0, |
|
125
|
|
|
|
|
|
|
packtype => 'q*', |
|
126
|
|
|
|
|
|
|
defaultbadval => 'LONG_MIN', # this is far from optimal |
|
127
|
|
|
|
|
|
|
# but LLONG_MIN/LLONG_MAX are probably |
|
128
|
|
|
|
|
|
|
# nonportable |
|
129
|
|
|
|
|
|
|
# on the other hand 2^63 should be the |
|
130
|
|
|
|
|
|
|
# value of llong_max which we should be |
|
131
|
|
|
|
|
|
|
# able to compute at runtime ?! |
|
132
|
|
|
|
|
|
|
real=>1, |
|
133
|
|
|
|
|
|
|
integer=>1, |
|
134
|
|
|
|
|
|
|
unsigned=>0, |
|
135
|
|
|
|
|
|
|
}, |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# IMPORTANT: |
|
138
|
|
|
|
|
|
|
# PDL_F *must* be the first non-integer type in this list |
|
139
|
|
|
|
|
|
|
# as there are many places in the code (.c/.xs/.pm/.pd) |
|
140
|
|
|
|
|
|
|
# with tests like this: |
|
141
|
|
|
|
|
|
|
# if (ndarraytype < PDL_F) { ... } |
|
142
|
|
|
|
|
|
|
{ |
|
143
|
|
|
|
|
|
|
identifier => 'F', |
|
144
|
|
|
|
|
|
|
pdlctype => 'PDL_Float', |
|
145
|
|
|
|
|
|
|
realctype => 'float', |
|
146
|
|
|
|
|
|
|
ppforcetype => 'float', |
|
147
|
|
|
|
|
|
|
usenan => 1, |
|
148
|
|
|
|
|
|
|
packtype => 'f*', |
|
149
|
|
|
|
|
|
|
defaultbadval => '-FLT_MAX', |
|
150
|
|
|
|
|
|
|
real=>1, |
|
151
|
|
|
|
|
|
|
complexversion=> 'G', |
|
152
|
|
|
|
|
|
|
integer=>0, |
|
153
|
|
|
|
|
|
|
unsigned=>0, |
|
154
|
|
|
|
|
|
|
isnan=>'isnan(%1$s)', |
|
155
|
|
|
|
|
|
|
isfinite=>'isfinite(%1$s)', |
|
156
|
|
|
|
|
|
|
floatsuffix=>'f', |
|
157
|
|
|
|
|
|
|
}, |
|
158
|
|
|
|
|
|
|
{ |
|
159
|
|
|
|
|
|
|
identifier => 'D', |
|
160
|
|
|
|
|
|
|
pdlctype => 'PDL_Double', |
|
161
|
|
|
|
|
|
|
realctype => 'double', |
|
162
|
|
|
|
|
|
|
ppforcetype => 'double', |
|
163
|
|
|
|
|
|
|
usenan => 1, |
|
164
|
|
|
|
|
|
|
packtype => 'd*', |
|
165
|
|
|
|
|
|
|
defaultbadval => '-DBL_MAX', |
|
166
|
|
|
|
|
|
|
real=>1, |
|
167
|
|
|
|
|
|
|
complexversion=> 'C', |
|
168
|
|
|
|
|
|
|
integer=>0, |
|
169
|
|
|
|
|
|
|
unsigned=>0, |
|
170
|
|
|
|
|
|
|
isnan=>'isnan(%1$s)', |
|
171
|
|
|
|
|
|
|
isfinite=>'isfinite(%1$s)', |
|
172
|
|
|
|
|
|
|
floatsuffix=>'', |
|
173
|
|
|
|
|
|
|
}, |
|
174
|
|
|
|
|
|
|
# the complex types need to be in the same order as their real |
|
175
|
|
|
|
|
|
|
# counterparts, because the "real" ppforcetype relies on a fixed interval |
|
176
|
|
|
|
|
|
|
# between real and complex versions |
|
177
|
|
|
|
|
|
|
# they also need to occur at the end of the types, as a < PDL_CF |
|
178
|
|
|
|
|
|
|
# comparison is done at C level to see if a type is real, analogous to |
|
179
|
|
|
|
|
|
|
# the < PDL_F above |
|
180
|
|
|
|
|
|
|
{ |
|
181
|
|
|
|
|
|
|
identifier => 'CF', |
|
182
|
|
|
|
|
|
|
onecharident => 'G', # only needed if different from identifier |
|
183
|
|
|
|
|
|
|
pdlctype => 'PDL_CFloat', |
|
184
|
|
|
|
|
|
|
realctype => 'complex float', |
|
185
|
|
|
|
|
|
|
ppforcetype => 'cfloat', |
|
186
|
|
|
|
|
|
|
usenan => 1, |
|
187
|
|
|
|
|
|
|
packtype => '(ff)*', |
|
188
|
|
|
|
|
|
|
defaultbadval => '(-FLT_MAX - I*FLT_MAX)', |
|
189
|
|
|
|
|
|
|
real=>0, |
|
190
|
|
|
|
|
|
|
realversion=>'F', |
|
191
|
|
|
|
|
|
|
integer=>0, |
|
192
|
|
|
|
|
|
|
unsigned=>0, |
|
193
|
|
|
|
|
|
|
isnan=>'(isnan(crealf(%1$s)) || isnan(cimagf(%1$s)))', |
|
194
|
|
|
|
|
|
|
isfinite=>'(isfinite(crealf(%1$s)) && isfinite(cimagf(%1$s)))', |
|
195
|
|
|
|
|
|
|
floatsuffix=>'f', |
|
196
|
|
|
|
|
|
|
}, |
|
197
|
|
|
|
|
|
|
{ |
|
198
|
|
|
|
|
|
|
identifier => 'CD', |
|
199
|
|
|
|
|
|
|
onecharident => 'C', # only needed if different from identifier |
|
200
|
|
|
|
|
|
|
pdlctype => 'PDL_CDouble', |
|
201
|
|
|
|
|
|
|
realctype => 'complex double', |
|
202
|
|
|
|
|
|
|
ppforcetype => 'cdouble', |
|
203
|
|
|
|
|
|
|
usenan => 1, |
|
204
|
|
|
|
|
|
|
packtype => '(dd)*', |
|
205
|
|
|
|
|
|
|
defaultbadval => '(-DBL_MAX - I*DBL_MAX)', |
|
206
|
|
|
|
|
|
|
real=>0, |
|
207
|
|
|
|
|
|
|
realversion=>'D', |
|
208
|
|
|
|
|
|
|
integer=>0, |
|
209
|
|
|
|
|
|
|
unsigned=>0, |
|
210
|
|
|
|
|
|
|
isnan=>'(isnan(creal(%1$s)) || isnan(cimag(%1$s)))', |
|
211
|
|
|
|
|
|
|
isfinite=>'(isfinite(creal(%1$s)) && isfinite(cimag(%1$s)))', |
|
212
|
|
|
|
|
|
|
floatsuffix=>'', |
|
213
|
|
|
|
|
|
|
}, |
|
214
|
|
|
|
|
|
|
); |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub checktypehas { |
|
217
|
|
|
|
|
|
|
my ($key,@types) = @_; |
|
218
|
|
|
|
|
|
|
for my $type (@types) { |
|
219
|
|
|
|
|
|
|
die "type is not a HASH ref" unless ref $type eq 'HASH'; |
|
220
|
|
|
|
|
|
|
die "type hash doesn't have a key '$key'" unless exists $type->{$key}; |
|
221
|
|
|
|
|
|
|
} |
|
222
|
|
|
|
|
|
|
} |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub gentypevars { |
|
225
|
|
|
|
|
|
|
my @types = @_; |
|
226
|
|
|
|
|
|
|
checktypehas 'identifier', @types; |
|
227
|
|
|
|
|
|
|
my @ret = map {"\$PDL_$_->{identifier}"} @types; |
|
228
|
|
|
|
|
|
|
return wantarray ? @ret : $ret[0]; |
|
229
|
|
|
|
|
|
|
} |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub genexports { |
|
232
|
|
|
|
|
|
|
my @types = @_; |
|
233
|
|
|
|
|
|
|
return join ' ', gentypevars @types; |
|
234
|
|
|
|
|
|
|
} |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub gentypenames { |
|
237
|
|
|
|
|
|
|
my @types = @_; |
|
238
|
|
|
|
|
|
|
checktypehas 'identifier', @types; |
|
239
|
|
|
|
|
|
|
my @ret = map {"PDL_$_->{identifier}"} @types; |
|
240
|
|
|
|
|
|
|
return wantarray ? @ret : $ret[0]; |
|
241
|
|
|
|
|
|
|
} |
|
242
|
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub genpacktypes { |
|
244
|
|
|
|
|
|
|
my @types = @_; |
|
245
|
|
|
|
|
|
|
checktypehas 'packtype', @types; |
|
246
|
|
|
|
|
|
|
my @ret = map {"$_->{packtype}"} @types; |
|
247
|
|
|
|
|
|
|
return wantarray ? @ret : $ret[0]; |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub convertfunc { |
|
251
|
|
|
|
|
|
|
my ($type) = @_; |
|
252
|
|
|
|
|
|
|
return $type->{'convertfunc'} if exists $type->{'convertfunc'}; |
|
253
|
|
|
|
|
|
|
checktypehas 'pdlctype', $type; |
|
254
|
|
|
|
|
|
|
my $cfunc = $type->{pdlctype}; |
|
255
|
|
|
|
|
|
|
$cfunc =~ s/PDL_//; |
|
256
|
|
|
|
|
|
|
return lc $cfunc; |
|
257
|
|
|
|
|
|
|
} |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub gentypehashentry ($$) { |
|
260
|
|
|
|
|
|
|
my ($type,$num) = @_; |
|
261
|
|
|
|
|
|
|
checktypehas $_, $type |
|
262
|
|
|
|
|
|
|
for qw/pdlctype defaultbadval/, @TYPE_VERBATIM; |
|
263
|
|
|
|
|
|
|
my $convertfunc = convertfunc($type); |
|
264
|
|
|
|
|
|
|
(my $shortctype = $type->{pdlctype}) =~ s/PDL_//; |
|
265
|
|
|
|
|
|
|
my $ppsym = $type->{onecharident} || $type->{identifier}; |
|
266
|
|
|
|
|
|
|
+{ |
|
267
|
|
|
|
|
|
|
ctype => $type->{pdlctype}, |
|
268
|
|
|
|
|
|
|
ppsym => $ppsym, |
|
269
|
|
|
|
|
|
|
convertfunc => $convertfunc, |
|
270
|
|
|
|
|
|
|
sym => &gentypenames($type), |
|
271
|
|
|
|
|
|
|
numval => $num, |
|
272
|
|
|
|
|
|
|
ioname => $convertfunc, |
|
273
|
|
|
|
|
|
|
defbval => $type->{defaultbadval}, |
|
274
|
|
|
|
|
|
|
shortctype => $shortctype, |
|
275
|
|
|
|
|
|
|
realversion => $type->{realversion} || $ppsym, |
|
276
|
|
|
|
|
|
|
complexversion => $type->{complexversion} || (!$type->{real} ? $ppsym : 'G'), |
|
277
|
|
|
|
|
|
|
(map +($_ => $type->{$_}), @TYPE_VERBATIM, qw(isnan isfinite floatsuffix)), |
|
278
|
|
|
|
|
|
|
}; |
|
279
|
|
|
|
|
|
|
} |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub gentypehashcode { |
|
282
|
|
|
|
|
|
|
my @types = @_; |
|
283
|
|
|
|
|
|
|
use Data::Dumper; |
|
284
|
|
|
|
|
|
|
local $Data::Dumper::Terse = 1; |
|
285
|
|
|
|
|
|
|
local $Data::Dumper::Indent = 1; |
|
286
|
|
|
|
|
|
|
local $Data::Dumper::Sortkeys = 1; |
|
287
|
|
|
|
|
|
|
local $Data::Dumper::Pad = "\t\t"; |
|
288
|
|
|
|
|
|
|
my $i = 0; |
|
289
|
|
|
|
|
|
|
my $perlcode = ''; |
|
290
|
|
|
|
|
|
|
$perlcode .= "our %typehash = (\n"; |
|
291
|
|
|
|
|
|
|
for my $type (@types) { |
|
292
|
|
|
|
|
|
|
$perlcode .= "\t".gentypenames($type)." =>\n"; |
|
293
|
|
|
|
|
|
|
$perlcode .= Data::Dumper::Dumper(gentypehashentry($type, $i++)); |
|
294
|
|
|
|
|
|
|
$perlcode .= "\t\t,\n"; |
|
295
|
|
|
|
|
|
|
} |
|
296
|
|
|
|
|
|
|
$perlcode .= "); # end typehash definition\n"; |
|
297
|
|
|
|
|
|
|
return $perlcode; |
|
298
|
|
|
|
|
|
|
} |
|
299
|
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
# List explicitly here the variables you want Configure to |
|
301
|
|
|
|
|
|
|
# generate. Metaconfig only looks for shell variables, so you |
|
302
|
|
|
|
|
|
|
# have to mention them as if they were shell variables, not |
|
303
|
|
|
|
|
|
|
# %Config entries. Thus you write |
|
304
|
|
|
|
|
|
|
# $startperl |
|
305
|
|
|
|
|
|
|
# to ensure Configure will look for $Config{startperl}. |
|
306
|
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# This forces PL files to create target in same directory as PL file. |
|
308
|
|
|
|
|
|
|
# This is so that make depend always knows where to find PL derivatives. |
|
309
|
|
|
|
|
|
|
chdir(dirname($0)); |
|
310
|
|
|
|
|
|
|
my $file; |
|
311
|
|
|
|
|
|
|
($file = basename($0)) =~ s/\.PL$//; |
|
312
|
|
|
|
|
|
|
$file =~ s/\.pl$// |
|
313
|
|
|
|
|
|
|
if ($Config{'osname'} eq 'VMS' or |
|
314
|
|
|
|
|
|
|
$Config{'osname'} eq 'OS2'); # "case-forgiving" |
|
315
|
|
|
|
|
|
|
open OUT,">$file" or die "Can't create $file: $!"; |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
print "Extracting $file\n"; |
|
318
|
|
|
|
|
|
|
chmod 0644, $file; |
|
319
|
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# in the following we generate the type dependent |
|
321
|
|
|
|
|
|
|
# parts of Types.pm |
|
322
|
|
|
|
|
|
|
# all the required info is extracted from the @types |
|
323
|
|
|
|
|
|
|
# array defined above |
|
324
|
|
|
|
|
|
|
# the guts how this is done is encapsulated in the subroutines |
|
325
|
|
|
|
|
|
|
# that follow the definition of @types |
|
326
|
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# set up some variables that we will use below |
|
328
|
|
|
|
|
|
|
my $typeexports = genexports @types; |
|
329
|
|
|
|
|
|
|
my $ntypesm1 = @types - 1; # number of types - 1 |
|
330
|
|
|
|
|
|
|
my $typevars = join ', ',gentypevars @types; |
|
331
|
|
|
|
|
|
|
my $packtypes = join ' ', genpacktypes @types; |
|
332
|
|
|
|
|
|
|
my $typenames = join ' ', gentypenames @types; |
|
333
|
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
print OUT sprintf qq{#line %d "%s"\n}, __LINE__ + 2, __FILE__; |
|
335
|
|
|
|
|
|
|
print OUT <<'!NO!SUBS!'; |
|
336
|
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
### Generated from Types.pm.PL automatically - do not modify! ### |
|
338
|
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
package PDL::Types; |
|
340
|
1
|
|
|
1
|
|
138011
|
use strict; |
|
|
1
|
|
|
|
|
12
|
|
|
|
1
|
|
|
|
|
30
|
|
|
341
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
67
|
|
|
342
|
|
|
|
|
|
|
require Exporter; |
|
343
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
1714
|
|
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
!NO!SUBS! |
|
346
|
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
print OUT qq{ |
|
348
|
|
|
|
|
|
|
our \@EXPORT = qw( $typeexports |
|
349
|
|
|
|
|
|
|
\@pack \%typehash ); |
|
350
|
|
|
|
|
|
|
}; |
|
351
|
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
print OUT <<'!NO!SUBS!'; |
|
353
|
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
our @EXPORT_OK = (@EXPORT, |
|
355
|
|
|
|
|
|
|
qw/types typesrtkeys mapfld typefld |
|
356
|
|
|
|
|
|
|
ppdefs ppdefs_complex ppdefs_all |
|
357
|
|
|
|
|
|
|
/ |
|
358
|
|
|
|
|
|
|
); |
|
359
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( |
|
360
|
|
|
|
|
|
|
All=>[@EXPORT,@EXPORT_OK], |
|
361
|
|
|
|
|
|
|
); |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
our @ISA = qw( Exporter ); |
|
364
|
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
!NO!SUBS! |
|
366
|
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
print OUT qq{ |
|
368
|
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# Data types/sizes (bytes) [must be in order of complexity] |
|
370
|
|
|
|
|
|
|
# Enum |
|
371
|
|
|
|
|
|
|
our ( $typevars ) = (0..$ntypesm1); |
|
372
|
|
|
|
|
|
|
# Corresponding pack types |
|
373
|
|
|
|
|
|
|
our \@pack= qw/$packtypes/; |
|
374
|
|
|
|
|
|
|
our \@names= qw/$typenames/; |
|
375
|
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
}; |
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
# generate the typehash output |
|
379
|
|
|
|
|
|
|
print OUT gentypehashcode @types; |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
print OUT <<'!NO!SUBS!'; |
|
382
|
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# Cross-reference by common names |
|
384
|
|
|
|
|
|
|
my @HASHES = sort {$a->{numval} <=> $b->{numval}} values %typehash; |
|
385
|
|
|
|
|
|
|
my @RTKEYS = map $_->{sym}, @HASHES; |
|
386
|
|
|
|
|
|
|
our %typenames; |
|
387
|
|
|
|
|
|
|
for my $h (@HASHES) { |
|
388
|
|
|
|
|
|
|
my $n = $h->{numval}; |
|
389
|
|
|
|
|
|
|
$typenames{$_} = $n for $n, @$h{qw(sym ioname ctype ppforcetype ppsym identifier)}; |
|
390
|
|
|
|
|
|
|
} |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head1 NAME |
|
393
|
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
PDL::Types - define fundamental PDL Datatypes |
|
395
|
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
397
|
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
use PDL::Types; |
|
399
|
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
$pdl = ushort( 2.0, 3.0 ); |
|
401
|
|
|
|
|
|
|
print "The actual c type used to store ushort's is '" . |
|
402
|
|
|
|
|
|
|
$pdl->type->realctype() . "'\n"; |
|
403
|
|
|
|
|
|
|
The actual c type used to store ushort's is 'unsigned short' |
|
404
|
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
406
|
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
Internal module - holds all the PDL Type info. The type info can be |
|
408
|
|
|
|
|
|
|
accessed easily using the C<PDL::Type> object returned by |
|
409
|
|
|
|
|
|
|
the L<type|PDL::Core/type> method. |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
Skip to the end of this document to find out how to change |
|
412
|
|
|
|
|
|
|
the set of types supported by PDL. |
|
413
|
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head1 FUNCTIONS |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
A number of functions are available for module writers |
|
417
|
|
|
|
|
|
|
to get/process type information. These are used in various |
|
418
|
|
|
|
|
|
|
places (e.g. C<PDL::PP>, C<PDL::Core>) to generate the |
|
419
|
|
|
|
|
|
|
appropriate type loops, etc. |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=head2 typesrtkeys |
|
422
|
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=for ref |
|
424
|
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
Returns an array of keys of typehash sorted in order of type complexity |
|
426
|
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=for example |
|
428
|
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
pdl> @typelist = PDL::Types::typesrtkeys; |
|
430
|
|
|
|
|
|
|
pdl> print @typelist; |
|
431
|
|
|
|
|
|
|
PDL_B PDL_S PDL_US PDL_L PDL_IND PDL_LL PDL_F PDL_D |
|
432
|
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=cut |
|
434
|
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub typesrtkeys { @RTKEYS } |
|
436
|
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=head2 ppdefs |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=for ref |
|
440
|
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Returns an array of pp symbols for all real types. This informs the |
|
442
|
|
|
|
|
|
|
default C<GenericTypes> for C<pp_def> functions, making support for |
|
443
|
|
|
|
|
|
|
complex types require an "opt-in". |
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=for example |
|
446
|
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
pdl> print PDL::Types::ppdefs |
|
448
|
|
|
|
|
|
|
B S U L N Q F D |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=cut |
|
451
|
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
my @PPDEFS = map $_->{ppsym}, grep $_->{real}, @HASHES; |
|
453
|
|
|
|
|
|
|
sub ppdefs { @PPDEFS } |
|
454
|
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head2 ppdefs_complex |
|
456
|
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=for ref |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
Returns an array of pp symbols for all complex types. |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=for example |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
pdl> print PDL::Types::ppdefs_complex |
|
464
|
|
|
|
|
|
|
G C |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=cut |
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
my @PPDEFS_CPLX = map $_->{ppsym}, grep !$_->{real}, @HASHES; |
|
469
|
|
|
|
|
|
|
sub ppdefs_complex { @PPDEFS_CPLX } |
|
470
|
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
=head2 ppdefs_all |
|
472
|
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=for ref |
|
474
|
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
Returns an array of pp symbols for all types including complex. |
|
476
|
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=for example |
|
478
|
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
pdl> print PDL::Types::ppdefs_all |
|
480
|
|
|
|
|
|
|
B S U L N Q F D G C |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=cut |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
my @PPDEFS_ALL = map $_->{ppsym}, @HASHES; |
|
485
|
|
|
|
|
|
|
sub ppdefs_all { @PPDEFS_ALL } |
|
486
|
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=head2 typefld |
|
488
|
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=for ref |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
Returns specified field (C<$fld>) for specified type (C<$type>) |
|
492
|
|
|
|
|
|
|
by querying type hash |
|
493
|
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=for usage |
|
495
|
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
PDL::Types::typefld($type,$fld); |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=for example |
|
499
|
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
pdl> print PDL::Types::typefld('PDL_IND',realctype) |
|
501
|
|
|
|
|
|
|
long |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=cut |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub typefld { |
|
506
|
|
|
|
|
|
|
my ($type,$fld) = @_; |
|
507
|
|
|
|
|
|
|
croak "unknown type $type" unless exists $typehash{$type}; |
|
508
|
|
|
|
|
|
|
croak "unknown field $fld in type $type" |
|
509
|
|
|
|
|
|
|
unless exists $typehash{$type}->{$fld}; |
|
510
|
|
|
|
|
|
|
return $typehash{$type}->{$fld}; |
|
511
|
|
|
|
|
|
|
} |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head2 mapfld |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Map a given source field to the corresponding target field by |
|
516
|
|
|
|
|
|
|
querying the type hash. This gives you a way to say, "Find the type |
|
517
|
|
|
|
|
|
|
whose C<$in_key> is equal to C<$value>, and return that type's value |
|
518
|
|
|
|
|
|
|
for C<$out_key>. For example: |
|
519
|
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# Does byte type use nan? |
|
521
|
|
|
|
|
|
|
$uses_nan = PDL::Types::mapfld(byte => 'ppforcetype', 'usenan'); |
|
522
|
|
|
|
|
|
|
# Equivalent: |
|
523
|
|
|
|
|
|
|
$uses_nan = byte->usenan; |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
# What is the actual C type for the value that we call 'long'? |
|
526
|
|
|
|
|
|
|
$type_name = PDL::Types::mapfld(long => 'convertfunc', 'realctype'); |
|
527
|
|
|
|
|
|
|
# Equivalent: |
|
528
|
|
|
|
|
|
|
$type_name = long->realctype; |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
As you can see, the equivalent examples are much shorter and legible, so you |
|
531
|
|
|
|
|
|
|
should only use mapfld if you were given the type index (in which case the |
|
532
|
|
|
|
|
|
|
actual type is not immediately obvious): |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
$type_index = 4; |
|
535
|
|
|
|
|
|
|
$type_name = PDL::Types::mapfld($type_index => numval, 'realctype'); |
|
536
|
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=cut |
|
538
|
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub mapfld { |
|
540
|
|
|
|
|
|
|
my ($type,$src,$trg) = @_; |
|
541
|
|
|
|
|
|
|
my @keys = grep {$typehash{$_}->{$src} eq $type} typesrtkeys; |
|
542
|
|
|
|
|
|
|
return @keys > 0 ? $typehash{$keys[0]}->{$trg} : undef; |
|
543
|
|
|
|
|
|
|
} |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
=head2 typesynonyms |
|
546
|
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
=for ref |
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
return type related synonym definitions to be included in pdl.h . |
|
550
|
|
|
|
|
|
|
This routine must be updated to include new types as required. |
|
551
|
|
|
|
|
|
|
Mostly the automatic updating should take care of the vital |
|
552
|
|
|
|
|
|
|
things. |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=cut |
|
555
|
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub typesynonyms { |
|
557
|
|
|
|
|
|
|
my $add = join "\n", |
|
558
|
|
|
|
|
|
|
map {"#define PDL_".typefld($_,'ppsym')." ".typefld($_,'sym')} |
|
559
|
|
|
|
|
|
|
grep {"PDL_".typefld($_,'ppsym') ne typefld($_,'sym')} typesrtkeys; |
|
560
|
|
|
|
|
|
|
print "adding...\n$add\n"; |
|
561
|
|
|
|
|
|
|
return "$add\n"; |
|
562
|
|
|
|
|
|
|
} |
|
563
|
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
=head2 datatypes_header |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=for ref |
|
567
|
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
return C header text for F<pdl.h> and F<pdlsimple.h>. |
|
569
|
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=cut |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
sub datatypes_header { |
|
573
|
|
|
|
|
|
|
require Config; |
|
574
|
|
|
|
|
|
|
warn "Using new 64bit index support\n" if $Config::Config{'ivsize'}==8; |
|
575
|
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
my $enum = join ', ', 'PDL_INVALID=-1', map $_->{sym}, @HASHES; |
|
577
|
|
|
|
|
|
|
my $typedefs = join '', map "typedef $_->{realctype} $_->{ctype};\n", @HASHES; |
|
578
|
|
|
|
|
|
|
$typedefs .= "typedef struct {\n pdl_datatypes type;\n union {\n"; |
|
579
|
|
|
|
|
|
|
$typedefs .= join '', map " $_->{ctype} $_->{ppsym};\n", @HASHES; |
|
580
|
|
|
|
|
|
|
$typedefs .= " } value;\n} PDL_Anyval;\n"; |
|
581
|
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
my $indx_type = typefld('PDL_IND','realctype'); |
|
583
|
|
|
|
|
|
|
$typedefs .= '#define IND_FLAG '; |
|
584
|
|
|
|
|
|
|
if ($indx_type eq 'long'){ |
|
585
|
|
|
|
|
|
|
$typedefs .= qq|"ld"|; |
|
586
|
|
|
|
|
|
|
} elsif ($indx_type eq 'long long'){ |
|
587
|
|
|
|
|
|
|
$typedefs .= qq|"lld"|; |
|
588
|
|
|
|
|
|
|
} else { |
|
589
|
|
|
|
|
|
|
$typedefs .= qq|"d"|; |
|
590
|
|
|
|
|
|
|
} |
|
591
|
|
|
|
|
|
|
$typedefs .= "\n"; |
|
592
|
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
<<EOD . "\n".typesynonyms()."\n"; |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
/*****************************************************************************/ |
|
596
|
|
|
|
|
|
|
/*** This section of .h file generated automatically by ***/ |
|
597
|
|
|
|
|
|
|
/*** PDL::Types::datatypes_header() - don't edit manually ***/ |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
/* Data types/sizes [must be in order of complexity] */ |
|
600
|
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
typedef enum { $enum } pdl_datatypes; |
|
602
|
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
/* Define the pdl data types */ |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
$typedefs |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
/*****************************************************************************/ |
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
EOD |
|
610
|
|
|
|
|
|
|
} |
|
611
|
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=head1 PDL::Type OBJECTS |
|
613
|
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
This module declares one class - C<PDL::Type> - objects of this class |
|
615
|
|
|
|
|
|
|
are returned by the L<type|PDL::Core/type> method of an ndarray. It has |
|
616
|
|
|
|
|
|
|
several methods, listed below, which provide an easy way to access |
|
617
|
|
|
|
|
|
|
type information: |
|
618
|
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
Additionally, comparison and stringification are overloaded so that |
|
620
|
|
|
|
|
|
|
you can compare and print type objects, e.g. |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
$nofloat = 1 if $pdl->type < float; |
|
623
|
|
|
|
|
|
|
die "must be double" if $type != double; |
|
624
|
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
For further examples check again the |
|
626
|
|
|
|
|
|
|
L<type|PDL::Core/type> method. |
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
=over 4 |
|
629
|
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
=item enum |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
Returns the number representing this datatype (see L<get_datatype|PDL::Core/PDL::get_datatype>). |
|
633
|
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
=item symbol |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
Returns one of 'PDL_B', 'PDL_S', 'PDL_US', 'PDL_L', 'PDL_IND', 'PDL_LL', |
|
637
|
|
|
|
|
|
|
'PDL_F' or 'PDL_D'. |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=item ctype |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Returns the macro used to represent this type in C code (eg 'PDL_Long'). |
|
642
|
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=item ppsym |
|
644
|
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
The letter used to represent this type in PP code (eg 'U' for L<ushort|PDL::Core/ushort>). |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=item realctype |
|
648
|
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
The actual C type used to store this type. |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=item shortctype |
|
652
|
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
The value returned by C<ctype> without the 'PDL_' prefix. |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=item badvalue |
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
The special numerical value used to represent bad values for this type. |
|
658
|
|
|
|
|
|
|
See L<badvalue routine in PDL::Bad|PDL::Bad/badvalue> for more details. |
|
659
|
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=item isnan |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
Given a string representing a C value, will return a C expression for |
|
663
|
|
|
|
|
|
|
this type that indicates whether that value is NaN (for complex values, |
|
664
|
0
|
|
|
0
|
1
|
0
|
if I<either> is finite). |
|
665
|
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=item isfinite |
|
667
|
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
Given a string representing a C value, will return a C expression for |
|
669
|
|
|
|
|
|
|
this type that indicates whether that value is finite (for complex values, |
|
670
|
|
|
|
|
|
|
if I<both> are finite). |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=item floatsuffix |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
The string appended to floating-point functions for this floating-point |
|
675
|
|
|
|
|
|
|
type. Dies if called on non-floating-point type. |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=cut |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
=item orig_badvalue |
|
680
|
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
The default special numerical value used to represent bad values for this |
|
682
|
0
|
|
|
0
|
1
|
0
|
type. (You can change the value that represents bad values for each type |
|
683
|
|
|
|
|
|
|
during runtime.) See the |
|
684
|
|
|
|
|
|
|
L<orig_badvalue routine in PDL::Bad|PDL::Bad/orig_badvalue> for more details. |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=back |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=cut |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
my @CACHED_TYPES = map bless([$_->{numval}, $_], 'PDL::Type'), @HASHES; |
|
691
|
|
|
|
|
|
|
# return all known types as type objects |
|
692
|
|
|
|
|
|
|
sub types { @CACHED_TYPES } |
|
693
|
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
{ |
|
695
|
|
|
|
|
|
|
package PDL::Type; |
|
696
|
|
|
|
|
|
|
use Carp; |
|
697
|
|
|
|
|
|
|
sub new { |
|
698
|
0
|
|
|
0
|
1
|
0
|
my ($type,$val) = @_; |
|
699
|
|
|
|
|
|
|
return $val if "PDL::Type" eq ref $val; |
|
700
|
|
|
|
|
|
|
if(ref $val and $val->isa('PDL')) { |
|
701
|
|
|
|
|
|
|
PDL::Core::barf("Can't make a type out of non-scalar ndarray $val!") |
|
702
|
|
|
|
|
|
|
if $val->getndims != 0; |
|
703
|
|
|
|
|
|
|
$val = $val->at; |
|
704
|
|
|
|
|
|
|
} |
|
705
|
|
|
|
|
|
|
confess "Can't make a type out of non-scalar $val (". |
|
706
|
|
|
|
|
|
|
(ref $val).")!" if ref $val; |
|
707
|
|
|
|
|
|
|
confess "Unknown type string '$val' (should be one of ". |
|
708
|
|
|
|
|
|
|
join(",",map $PDL::Types::typehash{$_}->{ioname}, @names). |
|
709
|
|
|
|
|
|
|
")\n" |
|
710
|
|
|
|
|
|
|
if !defined $PDL::Types::typenames{$val}; |
|
711
|
|
|
|
|
|
|
$CACHED_TYPES[$PDL::Types::typenames{$val}]; |
|
712
|
|
|
|
|
|
|
} |
|
713
|
|
|
|
|
|
|
|
|
714
|
0
|
|
|
0
|
1
|
0
|
sub enum { $_[0][0] } |
|
715
|
|
|
|
|
|
|
*symbol = \&sym; |
|
716
|
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
sub realversion { |
|
718
|
|
|
|
|
|
|
$CACHED_TYPES[$PDL::Types::typenames{ $_[0][1]{realversion} }]; |
|
719
|
|
|
|
|
|
|
} |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
sub complexversion { |
|
722
|
|
|
|
|
|
|
$CACHED_TYPES[$PDL::Types::typenames{ $_[0][1]{complexversion} }]; |
|
723
|
|
|
|
|
|
|
} |
|
724
|
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
sub isnan { sprintf $_[0][1]{isnan}, $_[1] } |
|
726
|
|
|
|
|
|
|
sub isfinite { sprintf $_[0][1]{isfinite}, $_[1] } |
|
727
|
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
sub floatsuffix { $_[0][1]{floatsuffix} // 'floatsuffix called on non-float type' } |
|
729
|
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
!NO!SUBS! |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
foreach my $name ( qw( ctype ppsym convertfunc shortctype |
|
733
|
|
|
|
|
|
|
sym numval ioname defbval |
|
734
|
|
|
|
|
|
|
), @TYPE_VERBATIM ) { |
|
735
|
0
|
|
|
0
|
1
|
0
|
print OUT << "EOS"; |
|
736
|
0
|
0
|
|
|
|
0
|
sub $name { \$_[0][1]{$name}; } |
|
737
|
|
|
|
|
|
|
EOS |
|
738
|
0
|
0
|
|
|
|
0
|
} |
|
739
|
0
|
|
|
|
|
0
|
|
|
740
|
|
|
|
|
|
|
print OUT <<'!NO!SUBS!'; |
|
741
|
|
|
|
|
|
|
sub badvalue { |
|
742
|
|
|
|
|
|
|
PDL::_badvalue_int( $_[1], $_[0][0] ); |
|
743
|
|
|
|
|
|
|
} |
|
744
|
|
|
|
|
|
|
sub orig_badvalue { |
|
745
|
|
|
|
|
|
|
PDL::_default_badvalue_int($_[0][0]); |
|
746
|
|
|
|
|
|
|
} |
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
# make life a bit easier |
|
749
|
|
|
|
|
|
|
use overload ( |
|
750
|
|
|
|
|
|
|
'""' => sub { lc $_[0]->shortctype }, |
|
751
|
|
|
|
|
|
|
"eq" => sub { my ($self, $other, $swap) = @_; ("$self" eq $other); }, |
|
752
|
|
|
|
|
|
|
"cmp" => sub { my ($self, $other, $swap) = @_; |
|
753
|
|
|
|
|
|
|
$swap ? $other cmp "$self" : "$self" cmp $other; |
|
754
|
|
|
|
|
|
|
}, |
|
755
|
|
|
|
|
|
|
"<=>" => sub { $_[2] ? $_[1][0] <=> $_[0][0] : $_[0][0] <=> $_[1][0] }, |
|
756
|
|
|
|
|
|
|
); |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
} # package: PDL::Type |
|
759
|
|
|
|
|
|
|
# Return |
|
760
|
|
|
|
|
|
|
1; |
|
761
|
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
__END__ |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=head1 Adding/removing types |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
You can change the types that PDL knows about by editing entries in |
|
767
|
|
|
|
|
|
|
the definition of the variable C<@types> that appears close to the |
|
768
|
|
|
|
|
|
|
top of the file F<Types.pm.PL> (i.e. the file from which this module |
|
769
|
0
|
|
|
0
|
1
|
0
|
was generated). |
|
770
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
771
|
0
|
0
|
|
|
|
0
|
=head2 Format of a type entry |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
Each entry in the C<@types> array is a hash reference. Here is an example |
|
774
|
|
|
|
|
|
|
taken from the actual code that defines the C<ushort> type: |
|
775
|
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
{ |
|
777
|
|
|
|
|
|
|
identifier => 'US', |
|
778
|
|
|
|
|
|
|
onecharident => 'U', # only needed if different from identifier |
|
779
|
|
|
|
|
|
|
pdlctype => 'PDL_Ushort', |
|
780
|
|
|
|
|
|
|
realctype => 'unsigned short', |
|
781
|
|
|
|
|
|
|
ppforcetype => 'ushort', |
|
782
|
|
|
|
|
|
|
usenan => 0, |
|
783
|
|
|
|
|
|
|
packtype => 'S*', |
|
784
|
|
|
|
|
|
|
defaultbadval => 'USHRT_MAX', |
|
785
|
|
|
|
|
|
|
real=>1, |
|
786
|
|
|
|
|
|
|
integer=>1, |
|
787
|
0
|
|
|
|
|
0
|
unsigned=>1, |
|
788
|
0
|
|
|
0
|
1
|
0
|
}, |
|
|
0
|
|
|
|
|
0
|
|
|
789
|
0
|
|
|
|
|
0
|
|
|
790
|
0
|
|
|
|
|
0
|
Before we start to explain the fields please take this important |
|
791
|
|
|
|
|
|
|
message on board: |
|
792
|
|
|
|
|
|
|
I<entries must be listed in order of increasing complexity>. This |
|
793
|
|
|
|
|
|
|
is critical to ensure that PDL's type conversion works correctly. |
|
794
|
|
|
|
|
|
|
Basically, a less complex type will be converted to a more complex |
|
795
|
|
|
|
|
|
|
type as required. |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
=head2 Fields in a type entry |
|
798
|
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
Each type entry has a number of required and optional entry. |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
A list of all the entries: |
|
802
|
0
|
|
|
0
|
1
|
0
|
|
|
803
|
0
|
0
|
|
|
|
0
|
=over |
|
804
|
|
|
|
|
|
|
|
|
805
|
0
|
|
|
|
|
0
|
=item * |
|
806
|
0
|
|
|
|
|
0
|
|
|
807
|
0
|
|
|
|
|
0
|
identifier |
|
808
|
0
|
|
|
|
|
0
|
|
|
809
|
0
|
|
|
|
|
0
|
I<Required>. A short sequence of upercase letters that identifies this |
|
810
|
|
|
|
|
|
|
type uniquely. More than three characters is probably overkill. |
|
811
|
0
|
|
|
|
|
0
|
|
|
812
|
0
|
|
|
|
|
0
|
|
|
813
|
0
|
0
|
|
|
|
0
|
=item * |
|
|
|
0
|
|
|
|
|
|
|
814
|
0
|
|
|
|
|
0
|
|
|
815
|
|
|
|
|
|
|
onecharident |
|
816
|
0
|
|
|
|
|
0
|
|
|
817
|
|
|
|
|
|
|
I<Optional>. Only required if the C<identifier> has more than one character. |
|
818
|
0
|
|
|
|
|
0
|
This should be a unique uppercase character that will be used to reference |
|
819
|
|
|
|
|
|
|
this type in PP macro expressions of the C<TBSULFD> type. If you don't |
|
820
|
0
|
|
|
|
|
0
|
know what I am talking about read the PP manpage or ask on the mailing list. |
|
821
|
|
|
|
|
|
|
|
|
822
|
0
|
|
|
|
|
0
|
=item * |
|
823
|
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
pdlctype |
|
825
|
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
I<Required>. The C<typedefed> name that will be used to access this type |
|
827
|
|
|
|
|
|
|
from C code. |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item * |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
realctype |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
I<Required>. The C compiler type that is used to implement this type. |
|
834
|
|
|
|
|
|
|
For portability reasons this one might be platform dependent. |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
=item * |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
ppforcetype |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
I<Required>. The type name used in PP signatures to refer to this type. |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
=item * |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
usenan |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
I<Required>. Flag that signals if this type has to deal with NaN issues. |
|
847
|
|
|
|
|
|
|
Generally only required for floating point types. |
|
848
|
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
=item * |
|
850
|
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
packtype |
|
852
|
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
I<Required>. The Perl pack type used to pack Perl values into the machine representation for this type. For details see C<perldoc -f pack>. |
|
854
|
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=item * |
|
856
|
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
integer |
|
858
|
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
I<Required>. Boolean - is this an integer type? |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item * |
|
862
|
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
unsigned |
|
864
|
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
I<Required>. Boolean - is this an unsigned type? |
|
866
|
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=item * |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
real |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
I<Required>. Boolean - is this a real (not complex) type? |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
=item * |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
realversion |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
String - the real version of this type (e.g. cdouble -> 'D'). |
|
878
|
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=item * |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
complexversion |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
String - the complex version of this type (e.g. double -> 'C'). |
|
884
|
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=back |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
Also have a look at the entries at the top of F<Types.pm.PL>. |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
The syntax is not written into stone yet and might change as the |
|
890
|
|
|
|
|
|
|
concept matures. |
|
891
|
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
=head2 Other things you need to do |
|
893
|
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
You need to check modules that do I/O (generally in the F<IO> |
|
895
|
|
|
|
|
|
|
part of the directory tree). In the future we might add fields to |
|
896
|
|
|
|
|
|
|
type entries to automate this. This requires changes to those IO |
|
897
|
|
|
|
|
|
|
modules first though. |
|
898
|
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
You should also make sure that any type macros in PP files |
|
900
|
|
|
|
|
|
|
(i.e. C<$TBSULFD...>) are updated to reflect the new type. PDL::PP::Dump |
|
901
|
|
|
|
|
|
|
has a mode to check for type macros requiring updating. Do something like |
|
902
|
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
find . -name \*.pd -exec perl -Mblib=. -M'PDL::PP::Dump=typecheck' {} \; |
|
904
|
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
from the PDL root directory I<after> updating F<Types.pm.PL> to check |
|
906
|
|
|
|
|
|
|
for such places. |
|
907
|
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
=cut |
|
909
|
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
!NO!SUBS! |