← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Thu Dec 15 15:23:56 2022
Reported on Thu Dec 15 15:27:03 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard/Dict.pm
StatementsExecuted 851 statements in 3.47ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
24111.09ms32.4msTypes::Standard::Dict::::__ANON__[:161]Types::Standard::Dict::__ANON__[:161]
411279µs8.38msTypes::Standard::Dict::::__constraint_generatorTypes::Standard::Dict::__constraint_generator
411265µs5.30msTypes::Standard::Dict::::__inline_generatorTypes::Standard::Dict::__inline_generator
722139µs39µsTypes::Standard::Dict::::__ANON__[:40]Types::Standard::Dict::__ANON__[:40]
11138µs312µsTypes::Standard::Dict::::__coercion_generatorTypes::Standard::Dict::__coercion_generator
11135µs52µsTypes::Standard::Dict::::BEGIN@7Types::Standard::Dict::BEGIN@7
82129µs29µsTypes::Standard::Dict::::pair_iteratorTypes::Standard::Dict::pair_iterator
11124µs24µsTypes::Standard::Dict::::BEGIN@5Types::Standard::Dict::BEGIN@5
11110µs20µsTypes::Standard::Dict::::BEGIN@32Types::Standard::Dict::BEGIN@32
1115µs7µsTypes::Standard::Dict::::BEGIN@6Types::Standard::Dict::BEGIN@6
1114µs4µsTypes::Standard::Dict::::BEGIN@16Types::Standard::Dict::BEGIN@16
1112µs2µsTypes::Standard::Dict::::BEGIN@9Types::Standard::Dict::BEGIN@9
1111µs1µsTypes::Standard::Dict::::BEGIN@17Types::Standard::Dict::BEGIN@17
0000s0sTypes::Standard::Dict::::__ANON__[:339]Types::Standard::Dict::__ANON__[:339]
0000s0sTypes::Standard::Dict::::__ANON__[:386]Types::Standard::Dict::__ANON__[:386]
0000s0sTypes::Standard::Dict::::__ANON__[:399]Types::Standard::Dict::__ANON__[:399]
0000s0sTypes::Standard::Dict::::__ANON__[:415]Types::Standard::Dict::__ANON__[:415]
0000s0sTypes::Standard::Dict::::__ANON__[:450]Types::Standard::Dict::__ANON__[:450]
0000s0sTypes::Standard::Dict::::__ANON__[:82]Types::Standard::Dict::__ANON__[:82]
0000s0sTypes::Standard::Dict::::__deep_explanationTypes::Standard::Dict::__deep_explanation
0000s0sTypes::Standard::Dict::::__dict_is_slurpyTypes::Standard::Dict::__dict_is_slurpy
0000s0sTypes::Standard::Dict::::__hashref_allows_keyTypes::Standard::Dict::__hashref_allows_key
0000s0sTypes::Standard::Dict::::__hashref_allows_valueTypes::Standard::Dict::__hashref_allows_value
0000s0sTypes::Standard::Dict::::_croakTypes::Standard::Dict::_croak
0000s0sTypes::Standard::Dict::::my_dict_is_slurpyTypes::Standard::Dict::my_dict_is_slurpy
0000s0sTypes::Standard::Dict::::my_hashref_allows_keyTypes::Standard::Dict::my_hashref_allows_key
0000s0sTypes::Standard::Dict::::my_hashref_allows_valueTypes::Standard::Dict::my_hashref_allows_value
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# INTERNAL MODULE: guts for Dict type from Types::Standard.
2
3package Types::Standard::Dict;
4
5232µs124µs
# spent 24µs within Types::Standard::Dict::BEGIN@5 which was called: # once (24µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 5
use 5.008001;
# spent 24µs making 1 call to Types::Standard::Dict::BEGIN@5
6217µs29µs
# spent 7µs (5+2) within Types::Standard::Dict::BEGIN@6 which was called: # once (5µs+2µs) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 6
use strict;
# spent 7µs making 1 call to Types::Standard::Dict::BEGIN@6 # spent 2µs making 1 call to strict::import
7223µs269µs
# spent 52µs (35+17) within Types::Standard::Dict::BEGIN@7 which was called: # once (35µs+17µs) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 7
use warnings;
# spent 52µs making 1 call to Types::Standard::Dict::BEGIN@7 # spent 17µs making 1 call to warnings::import
8
9
# spent 2µs within Types::Standard::Dict::BEGIN@9 which was called: # once (2µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 12
BEGIN {
1010s $Types::Standard::Dict::AUTHORITY = 'cpan:TOBYINK';
1112µs $Types::Standard::Dict::VERSION = '2.000001';
12121µs12µs}
# spent 2µs making 1 call to Types::Standard::Dict::BEGIN@9
13
1410s$Types::Standard::Dict::VERSION =~ tr/_//d;
15
16210µs14µs
# spent 4µs within Types::Standard::Dict::BEGIN@16 which was called: # once (4µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 16
use Types::Standard ();
# spent 4µs making 1 call to Types::Standard::Dict::BEGIN@16
17256µs11µs
# spent 1µs within Types::Standard::Dict::BEGIN@17 which was called: # once (1µs+0s) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 17
use Types::TypeTiny ();
# spent 1µs making 1 call to Types::Standard::Dict::BEGIN@17
18
19sub _croak ($;@) {
20 require Carp;
21 goto \&Carp::confess;
22 require Error::TypeTiny;
23 goto \&Error::TypeTiny::croak;
24}
25
2611µs14µsmy $_Slurpy = Types::Standard::Slurpy;
# spent 4µs making 1 call to Types::Standard::Slurpy
2712µs13µsmy $_optional = Types::Standard::Optional;
# spent 3µs making 1 call to Types::Standard::Optional
2811µs11µsmy $_hash = Types::Standard::HashRef;
# spent 1µs making 1 call to Types::Standard::HashRef
2912µs12µsmy $_map = Types::Standard::Map;
# spent 2µs making 1 call to Types::Standard::Map
3011µs11µsmy $_any = Types::Standard::Any;
# spent 1µs making 1 call to Types::Standard::Any
31
3221.69ms230µs
# spent 20µs (10+10) within Types::Standard::Dict::BEGIN@32 which was called: # once (10µs+10µs) by Types::Standard::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard.pm:190] at line 32
no warnings;
# spent 20µs making 1 call to Types::Standard::Dict::BEGIN@32 # spent 10µs making 1 call to warnings::unimport
33
34
# spent 29µs within Types::Standard::Dict::pair_iterator which was called 8 times, avg 4µs/call: # 4 times (16µs+0s) by Types::Standard::Dict::__constraint_generator at line 50, avg 4µs/call # 4 times (13µs+0s) by Types::Standard::Dict::__inline_generator at line 112, avg 3µs/call
sub pair_iterator {
3584µs _croak( "Expected even-sized list" ) if @_ % 2;
3689µs my @array = @_;
37
# spent 39µs within Types::Standard::Dict::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard/Dict.pm:40] which was called 72 times, avg 542ns/call: # 36 times (21µs+0s) by Types::Standard::Dict::__constraint_generator at line 55, avg 583ns/call # 36 times (18µs+0s) by Types::Standard::Dict::__inline_generator at line 116, avg 500ns/call
sub {
387217µs return unless @array;
396499µs splice( @array, 0, 2 );
40821µs };
41}
42
43
# spent 8.38ms (279µs+8.10) within Types::Standard::Dict::__constraint_generator which was called 4 times, avg 2.09ms/call: # 4 times (279µs+8.10ms) by Type::Tiny::parameterize at line 1044 of Type/Tiny.pm, avg 2.09ms/call
sub __constraint_generator {
44422µs11645µs my $slurpy =
# spent 460µs making 4 calls to Type::Tiny::is_strictly_a_type_of, avg 115µs/call # spent 150µs making 3 calls to Type::Tiny::AUTOLOAD, avg 50µs/call # spent 35µs making 4 calls to Types::TypeTiny::is_TypeTiny, avg 9µs/call
45 @_
46 && Types::TypeTiny::is_TypeTiny( $_[-1] )
47 && $_[-1]->is_strictly_a_type_of( $_Slurpy )
48 ? pop->my_unslurpy
49 : undef;
5046µs416µs my $iterator = pair_iterator @_;
# spent 16µs making 4 calls to Types::Standard::Dict::pair_iterator, avg 4µs/call
5142µs my %constraints;
52 my %is_optional;
53 my @keys;
54
55433µs3621µs while ( my ( $k, $v ) = $iterator->() ) {
# spent 21µs making 36 calls to Types::Standard::Dict::__ANON__[Types/Standard/Dict.pm:40], avg 583ns/call
563224µs $constraints{$k} = $v;
573212µs32272µs Types::TypeTiny::is_TypeTiny( $v )
# spent 272µs making 32 calls to Types::TypeTiny::is_TypeTiny, avg 8µs/call
58 or _croak(
59 "Parameter for Dict[...] with key '$k' expected to be a type constraint; got $v"
60 );
613217µs32170µs Types::TypeTiny::is_StringLike( $k )
# spent 170µs making 32 calls to Types::TypeTiny::is_StringLike, avg 5µs/call
62 or _croak( "Key for Dict[...] expected to be string; got $k" );
633210µs push @keys, $k;
643238µs324.43ms $is_optional{$k} = !!$constraints{$k}->is_strictly_a_type_of( $_optional );
# spent 4.43ms making 32 calls to Type::Tiny::is_strictly_a_type_of, avg 138µs/call
65 } #/ while ( my ( $k, $v ) = $iterator...)
66
67 return sub {
68 my $value = $_[0];
69 if ( $slurpy ) {
70 my %tmp = map +( exists( $constraints{$_} ) ? () : ( $_ => $value->{$_} ) ),
71 keys %$value;
72 return unless $slurpy->check( \%tmp );
73 }
74 else {
75 exists( $constraints{$_} ) || return for sort keys %$value;
76 }
77 for my $k ( @keys ) {
78 exists( $value->{$k} ) or ( $is_optional{$k} ? next : return );
79 $constraints{$k}->check( $value->{$k} ) or return;
80 }
81 return !!1;
82420µs };
83} #/ sub __constraint_generator
84
85
# spent 5.30ms (265µs+5.04) within Types::Standard::Dict::__inline_generator which was called 4 times, avg 1.33ms/call: # 4 times (265µs+5.04ms) by Type::Tiny::parameterize at line 1057 of Type/Tiny.pm, avg 1.33ms/call
sub __inline_generator {
86
87 # We can only inline a parameterized Dict if all the
88 # constraints inside can be inlined.
89
90416µs11489µs my $slurpy =
# spent 381µs making 4 calls to Type::Tiny::is_strictly_a_type_of, avg 95µs/call # spent 75µs making 3 calls to Type::Tiny::AUTOLOAD, avg 25µs/call # spent 33µs making 4 calls to Types::TypeTiny::is_TypeTiny, avg 8µs/call
91 @_
92 && Types::TypeTiny::is_TypeTiny( $_[-1] )
93 && $_[-1]->is_strictly_a_type_of( $_Slurpy )
94 ? pop->my_unslurpy
95 : undef;
9645µs629µs return if $slurpy && !$slurpy->can_be_inlined;
# spent 28µs making 3 calls to Type::Tiny::can_be_inlined, avg 9µs/call # spent 1µs making 3 calls to Type::Tiny::__ANON__[Type/Tiny.pm:101], avg 333ns/call
97
98 # Is slurpy a very loose type constraint?
99 # i.e. Any, Item, Defined, Ref, or HashRef
10047µs64.16ms my $slurpy_is_any = $slurpy && $_hash->is_a_type_of( $slurpy );
# spent 4.16ms making 3 calls to Type::Tiny::is_a_type_of, avg 1.39ms/call # spent 1µs making 3 calls to Type::Tiny::__ANON__[Type/Tiny.pm:101], avg 333ns/call
101
102 # Is slurpy a parameterized Map, or expressable as a parameterized Map?
103416µs21112µs my $slurpy_is_map =
# spent 95µs making 6 calls to Type::Tiny::strictly_equals, avg 16µs/call # spent 12µs making 3 calls to Type::Tiny::is_parameterized, avg 4µs/call # spent 4µs making 6 calls to Type::Tiny::parent, avg 667ns/call # spent 1µs making 3 calls to Type::Tiny::__ANON__[Type/Tiny.pm:101], avg 333ns/call # spent 0s making 3 calls to Type::Tiny::parameters, avg 0s/call
104 $slurpy
105 && $slurpy->is_parameterized
106 && (
107 ( $slurpy->parent->strictly_equals( $_map ) && $slurpy->parameters )
108 || ( $slurpy->parent->strictly_equals( $_hash )
109 && [ $_any, $slurpy->parameters->[0] ] )
110 );
111
11244µs413µs my $iterator = pair_iterator @_;
# spent 13µs making 4 calls to Types::Standard::Dict::pair_iterator, avg 3µs/call
11342µs my %constraints;
114 my @keys;
115
116426µs3618µs while ( my ( $k, $c ) = $iterator->() ) {
# spent 18µs making 36 calls to Types::Standard::Dict::__ANON__[Types/Standard/Dict.pm:40], avg 500ns/call
1173221µs32216µs return unless $c->can_be_inlined;
# spent 212µs making 30 calls to Type::Tiny::can_be_inlined, avg 7µs/call # spent 4µs making 2 calls to Type::Tiny::Enum::can_be_inlined, avg 2µs/call
1183213µs $constraints{$k} = $c;
1193215µs push @keys, $k;
120 }
121
122418µs my $regexp = join "|", map quotemeta, @keys;
123
# spent 32.4ms (1.09+31.4) within Types::Standard::Dict::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Types/Standard/Dict.pm:161] which was called 24 times, avg 1.35ms/call: # 24 times (1.09ms+31.4ms) by Type::Tiny::inline_check at line 895 of Type/Tiny.pm, avg 1.35ms/call
return sub {
1242410µs require B;
125243µs my $h = $_[1];
126 join " and ",
127 Types::Standard::HashRef->inline_check( $h ),
128 (
129 $slurpy_is_any
130 ? ()
131 : $slurpy_is_map ? do {
132 '(not grep {' . "my \$v = ($h)->{\$_};" . sprintf(
133 'not((/\\A(?:%s)\\z/) or ((%s) and (%s)))',
134 $regexp,
135 $slurpy_is_map->[0]->inline_check( '$_' ),
136 $slurpy_is_map->[1]->inline_check( '$v' ),
137 ) . "} keys \%{$h})";
138 }
139 : $slurpy ? do {
140 'do {'
141 . "my \$slurpy_tmp = +{ map /\\A(?:$regexp)\\z/ ? () : (\$_ => ($h)->{\$_}), keys \%{$h} };"
142 . $slurpy->inline_check( '$slurpy_tmp' ) . '}';
143 }
144 : "not(grep !/\\A(?:$regexp)\\z/, keys \%{$h})"
145 ),
146 (
147 map {
148158600µs208157µs my $k = B::perlstring( $_ );
# spent 123µs making 134 calls to B::perlstring, avg 918ns/call # spent 42µs making 24 calls to Types::Standard::HashRef, avg 2µs/call, recursion: max depth 1, sum of overlapping time 8µs # spent 2.63ms making 50 calls to Type::Tiny::inline_check, avg 53µs/call, recursion: max depth 3, sum of overlapping time 2.63ms
149 $constraints{$_}->is_strictly_a_type_of( $_optional )
150 ? sprintf(
151 '(!exists %s->{%s} or %s)', $h, $k,
152 $constraints{$_}->inline_check( "$h\->{$k}" )
153 )
154 : (
155 "exists($h\->{$k})",
156134433µs26823.0ms $constraints{$_}->inline_check( "$h\->{$k}" )
# spent 22.9ms making 134 calls to Type::Tiny::is_strictly_a_type_of, avg 171µs/call # spent 169µs making 16 calls to Type::Tiny::Enum::inline_check, avg 11µs/call # spent 5.53ms making 118 calls to Type::Tiny::inline_check, avg 47µs/call, recursion: max depth 3, sum of overlapping time 5.53ms
157 )
158 } @keys
159 ),
160 ;
161 }
162453µs} #/ sub __inline_generator
163
164sub __deep_explanation {
165 require B;
166 my ( $type, $value, $varname ) = @_;
167 my @params = @{ $type->parameters };
168
169 my $slurpy =
170 @params
171 && Types::TypeTiny::is_TypeTiny( $params[-1] )
172 && $params[-1]->is_strictly_a_type_of( $_Slurpy )
173 ? pop( @params )->my_unslurpy
174 : undef;
175 my $iterator = pair_iterator @params;
176 my %constraints;
177 my @keys;
178
179 while ( my ( $k, $c ) = $iterator->() ) {
180 push @keys, $k;
181 $constraints{$k} = $c;
182 }
183
184 for my $k ( @keys ) {
185 next
186 if $constraints{$k}->has_parent
187 && ( $constraints{$k}->parent == Types::Standard::Optional )
188 && ( !exists $value->{$k} );
189 next if $constraints{$k}->check( $value->{$k} );
190
191 return [
192 sprintf( '"%s" requires key %s to appear in hash', $type, B::perlstring( $k ) )
193 ]
194 unless exists $value->{$k};
195
196 return [
197 sprintf(
198 '"%s" constrains value at key %s of hash with "%s"',
199 $type,
200 B::perlstring( $k ),
201 $constraints{$k},
202 ),
203 @{
204 $constraints{$k}->validate_explain(
205 $value->{$k},
206 sprintf( '%s->{%s}', $varname, B::perlstring( $k ) ),
207 )
208 },
209 ];
210 } #/ for my $k ( @keys )
211
212 if ( $slurpy ) {
213 my %tmp = map { exists( $constraints{$_} ) ? () : ( $_ => $value->{$_} ) }
214 keys %$value;
215
216 my $explain = $slurpy->validate_explain( \%tmp, '$slurpy' );
217 return [
218 sprintf(
219 '"%s" requires the hashref of additional key/value pairs to conform to "%s"',
220 $type, $slurpy
221 ),
222 @$explain,
223 ] if $explain;
224 } #/ if ( $slurpy )
225 else {
226 for my $k ( sort keys %$value ) {
227 return [
228 sprintf(
229 '"%s" does not allow key %s to appear in hash', $type, B::perlstring( $k )
230 )
231 ]
232 unless exists $constraints{$k};
233 }
234 } #/ else [ if ( $slurpy ) ]
235
236 # This should never happen...
237 return; # uncoverable statement
238} #/ sub __deep_explanation
239
24010smy $label_counter = 0;
24110sour ( $keycheck_counter, @KEYCHECK ) = -1;
242
243
# spent 312µs (38+274) within Types::Standard::Dict::__coercion_generator which was called: # once (38µs+274µs) by Type::Tiny::__ANON__[/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Type/Tiny.pm:1073] at line 1070 of Type/Tiny.pm
sub __coercion_generator {
24412µs2217µs my $slurpy =
# spent 204µs making 1 call to Type::Tiny::is_strictly_a_type_of # spent 13µs making 1 call to Types::TypeTiny::is_TypeTiny
245 @_
246 && Types::TypeTiny::is_TypeTiny( $_[-1] )
247 && $_[-1]->is_strictly_a_type_of( $_Slurpy )
248 ? pop->my_unslurpy
249 : undef;
25011µs my ( $parent, $child, %dict ) = @_;
25112µs114µs my $C = "Type::Coercion"->new( type_constraint => $child );
# spent 14µs making 1 call to Type::Coercion::new
252
25310s my $all_inlinable = 1;
25410s my $child_coercions_exist = 0;
25511µs for my $tc ( values %dict ) {
25622µs210µs $all_inlinable = 0 if !$tc->can_be_inlined;
# spent 9µs making 1 call to Type::Tiny::can_be_inlined # spent 1µs making 1 call to Type::Tiny::Enum::can_be_inlined
25727µs20s $all_inlinable = 0 if $tc->has_coercion && !$tc->coercion->can_be_inlined;
# spent 15µs making 2 calls to Type::Tiny::has_coercion, avg 8µs/call, recursion: max depth 2, sum of overlapping time 15µs
25823µs20s $child_coercions_exist++ if $tc->has_coercion;
# spent 10µs making 2 calls to Type::Tiny::has_coercion, avg 5µs/call, recursion: max depth 2, sum of overlapping time 10µs
259 }
26011µs $all_inlinable = 0 if $slurpy && !$slurpy->can_be_inlined;
26110s $all_inlinable = 0
262 if $slurpy
263 && $slurpy->has_coercion
264 && !$slurpy->coercion->can_be_inlined;
265
26610s $child_coercions_exist++ if $slurpy && $slurpy->has_coercion;
26718µs18µs return unless $child_coercions_exist;
# spent 8µs making 1 call to Type::Coercion::AUTOLOAD
268
269 if ( $all_inlinable ) {
270 $C->add_type_coercions(
271 $parent => Types::Standard::Stringable {
272 require B;
273
274 my $keycheck = join "|", map quotemeta,
275 sort { length( $b ) <=> length( $a ) or $a cmp $b } keys %dict;
276 $keycheck = $KEYCHECK[ ++$keycheck_counter ] = qr{^($keycheck)$}ms; # regexp for legal keys
277
278 my $label = sprintf( "DICTLABEL%d", ++$label_counter );
279 my @code;
280 push @code, 'do { my ($orig, $return_orig, $tmp, %new) = ($_, 0);';
281 push @code, "$label: {";
282 if ( $slurpy ) {
283 push @code,
284 sprintf(
285 'my $slurped = +{ map +($_=~$%s::KEYCHECK[%d])?():($_=>$orig->{$_}), keys %%$orig };',
286 __PACKAGE__, $keycheck_counter
287 );
288 if ( $slurpy->has_coercion ) {
289 push @code,
290 sprintf(
291 'my $coerced = %s;',
292 $slurpy->coercion->inline_coercion( '$slurped' )
293 );
294 push @code,
295 sprintf(
296 '((%s)&&(%s))?(%%new=%%$coerced):(($return_orig = 1), last %s);',
297 $_hash->inline_check( '$coerced' ), $slurpy->inline_check( '$coerced' ),
298 $label
299 );
300 } #/ if ( $slurpy->has_coercion)
301 else {
302 push @code,
303 sprintf(
304 '(%s)?(%%new=%%$slurped):(($return_orig = 1), last %s);',
305 $slurpy->inline_check( '$slurped' ), $label
306 );
307 }
308 } #/ if ( $slurpy )
309 else {
310 push @code,
311 sprintf(
312 '($_ =~ $%s::KEYCHECK[%d])||(($return_orig = 1), last %s) for sort keys %%$orig;',
313 __PACKAGE__, $keycheck_counter, $label
314 );
315 }
316 for my $k ( keys %dict ) {
317 my $ct = $dict{$k};
318 my $ct_coerce = $ct->has_coercion;
319 my $ct_optional = $ct->is_a_type_of( $_optional );
320 my $K = B::perlstring( $k );
321
322 push @code, sprintf(
323 'if (exists $orig->{%s}) { $tmp = %s; (%s) ? ($new{%s}=$tmp) : (($return_orig=1), last %s) }',
324 $K,
325 $ct_coerce
326 ? $ct->coercion->inline_coercion( "\$orig->{$K}" )
327 : "\$orig->{$K}",
328 $ct->inline_check( '$tmp' ),
329 $K,
330 $label,
331 );
332 } #/ for my $k ( keys %dict )
333 push @code, '}';
334 push @code, '$return_orig ? $orig : \\%new';
335 push @code, '}';
336
337 #warn "CODE:: @code";
338 "@code";
339 }
340 );
341 } #/ if ( $all_inlinable )
342
343 else {
344 my %is_optional = map {
345 ;
346 $_ => !!$dict{$_}->is_strictly_a_type_of( $_optional )
347 } sort keys %dict;
348 $C->add_type_coercions(
349 $parent => sub {
350 my $value = @_ ? $_[0] : $_;
351 my %new;
352
353 if ( $slurpy ) {
354 my %slurped = map exists( $dict{$_} ) ? () : ( $_ => $value->{$_} ),
355 keys %$value;
356
357 if ( $slurpy->check( \%slurped ) ) {
358 %new = %slurped;
359 }
360 elsif ( $slurpy->has_coercion ) {
361 my $coerced = $slurpy->coerce( \%slurped );
362 $slurpy->check( $coerced ) ? ( %new = %$coerced ) : ( return $value );
363 }
364 else {
365 return $value;
366 }
367 } #/ if ( $slurpy )
368 else {
369 for my $k ( keys %$value ) {
370 return $value unless exists $dict{$k};
371 }
372 }
373
374 for my $k ( keys %dict ) {
375 next if $is_optional{$k} and not exists $value->{$k};
376
377 my $ct = $dict{$k};
378 my $x = $ct->has_coercion ? $ct->coerce( $value->{$k} ) : $value->{$k};
379
380 return $value unless $ct->check( $x );
381
382 $new{$k} = $x;
383 } #/ for my $k ( keys %dict )
384
385 return \%new;
386 },
387 );
388 } #/ else [ if ( $all_inlinable ) ]
389
390 return $C;
391} #/ sub __coercion_generator
392
393sub __dict_is_slurpy {
394 my $self = shift;
395
396 return !!0 if $self == Types::Standard::Dict();
397
398 my $dict = $self->find_parent(
399 sub { $_->has_parent && $_->parent == Types::Standard::Dict() } );
400 my $slurpy =
401 @{ $dict->parameters }
402 && Types::TypeTiny::is_TypeTiny( $dict->parameters->[-1] )
403 && $dict->parameters->[-1]->is_strictly_a_type_of( $_Slurpy )
404 ? $dict->parameters->[-1]
405 : undef;
406} #/ sub __dict_is_slurpy
407
408sub __hashref_allows_key {
409 my $self = shift;
410 my ( $key ) = @_;
411
412 return Types::Standard::is_Str( $key ) if $self == Types::Standard::Dict();
413
414 my $dict = $self->find_parent(
415 sub { $_->has_parent && $_->parent == Types::Standard::Dict() } );
416 my %params;
417 my $slurpy = $dict->my_dict_is_slurpy;
418 if ( $slurpy ) {
419 my @args = @{ $dict->parameters };
420 pop @args;
421 %params = @args;
422 $slurpy = $slurpy->my_unslurpy;
423 }
424 else {
425 %params = @{ $dict->parameters };
426 }
427
428 return !!1
429 if exists( $params{$key} );
430 return !!0
431 if !$slurpy;
432 return Types::Standard::is_Str( $key )
433 if $slurpy == Types::Standard::Any()
434 || $slurpy == Types::Standard::Item()
435 || $slurpy == Types::Standard::Defined()
436 || $slurpy == Types::Standard::Ref();
437 return $slurpy->my_hashref_allows_key( $key )
438 if $slurpy->is_a_type_of( Types::Standard::HashRef() );
439 return !!0;
440} #/ sub __hashref_allows_key
441
442sub __hashref_allows_value {
443 my $self = shift;
444 my ( $key, $value ) = @_;
445
446 return !!0 unless $self->my_hashref_allows_key( $key );
447 return !!1 if $self == Types::Standard::Dict();
448
449 my $dict = $self->find_parent(
450 sub { $_->has_parent && $_->parent == Types::Standard::Dict() } );
451 my %params;
452 my $slurpy = $dict->my_dict_is_slurpy;
453 if ( $slurpy ) {
454 my @args = @{ $dict->parameters };
455 pop @args;
456 %params = @args;
457 $slurpy = $slurpy->my_unslurpy;
458 }
459 else {
460 %params = @{ $dict->parameters };
461 }
462
463 return !!1
464 if exists( $params{$key} ) && $params{$key}->check( $value );
465 return !!0
466 if !$slurpy;
467 return !!1
468 if $slurpy == Types::Standard::Any()
469 || $slurpy == Types::Standard::Item()
470 || $slurpy == Types::Standard::Defined()
471 || $slurpy == Types::Standard::Ref();
472 return $slurpy->my_hashref_allows_value( $key, $value )
473 if $slurpy->is_a_type_of( Types::Standard::HashRef() );
474 return !!0;
475} #/ sub __hashref_allows_value
476
47714µs1;
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.