# Copyright 2008, 2009, 2010, 2011, 2012, 2015 Kevin Ryde
# This file is part of constant-defer.
#
# constant-defer is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# constant-defer is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with constant-defer. If not, see .
package constant::defer;
use strict;
use vars '$VERSION';
$VERSION = 6;
sub import {
my $class = shift;
$class->_create_for_package (scalar(caller), @_);
}
sub _create_for_package {
my $class = shift;
my $target_package = shift;
while (@_) {
my $name = shift;
if (ref $name eq 'HASH') {
unshift @_, %$name;
next;
}
unless (@_) {
require Carp;
Carp::croak ("Missing value sub for $name");
}
my $subr = shift;
### $constant::defer::DEBUG_LAST_SUBR = $subr;
my ($fullname, $basename);
if ($name =~ /::([^:]*)$/s) {
$fullname = $name;
$basename = $1;
} else {
$basename = $name;
$fullname = "${target_package}::$name";
}
## print "constant::defer $arg -- $fullname $basename $old\n";
$class->_validate_name ($basename);
$class->_create_fullname ($fullname, $subr);
}
}
sub _create_fullname {
my ($class, $fullname, $subr) = @_;
my $run = sub {
unshift @_, $fullname, $subr;
goto &_run;
};
my $func = sub () {
unshift @_, \$run;
goto $run;
};
no strict 'refs';
*$fullname = $func;
### $constant::defer::DEBUG_LAST_RUNNER = $run;
}
sub _run {
my $fullname = shift;
my $subr = shift;
my $run_ref = shift;
### print "_run() $fullname $subr\n";
my @ret = &$subr(@_);
if (@ret == 1) {
# constant.pm has an optimization to make a constant by storing a scalar
# value directly into the %{Foo::Bar::} hash if there's no typeglob for
# the name yet. But that doesn't apply here, there's always a glob from
# having converted a function.
#
# The function created only has name __ANON__ in its coderef GV (as
# fetched by Sub::Identify for instance). This is the same as most
# function creating modules, including Memoize.pm. Plain constant.pm
# likewise, except when it uses the scalar ref in symbol table
# optimization, in that case a later upgrade to a function gets a name.
#
my $value = $ret[0];
$subr = sub () { $value };
} elsif (@ret == 0) {
$subr = \&_nothing;
} else {
$subr = sub () { @ret };
}
$$run_ref = $subr;
{ no strict 'refs';
local $^W = 0; # no warnings 'redefine';
eval { *$fullname = $subr } or die $@;
}
goto $subr;
}
# not as strict as constant.pm
sub _validate_name {
my ($class, $name) = @_;
if ($name =~ m{[()] # no parens like CODE(0x1234) if miscounted args
|^[0-9] # no starting with a number
|^$ # not empty
}x) {
require Carp;
Carp::croak ("Constant name '$name' is invalid");
}
}
sub _nothing () { } ## no critic (ProhibitSubroutinePrototypes)
1;
__END__
=for stopwords bareword stringizing inline there'd fakery subclassing Ryde multi-value inlined coderef subrs subr
=head1 NAME
constant::defer -- constant subs with deferred value calculation
=for test_synopsis my ($some,$thing,$an,$other);
=head1 SYNOPSIS
use constant::defer FOO => sub { return $some + $thing; },
BAR => sub { return $an * $other; };
use constant::defer MYOBJ => sub { require My::Class;
return My::Class->new_thing; }
=head1 DESCRIPTION
C creates a subroutine which on the first call runs given
code to calculate its value, and on any subsequent calls just returns that
value, like a constant. The value code is discarded once run, allowing it
to be garbage collected.
Deferring a calculation is good if it might take a lot of work or produce a
big result but is only needed sometimes or only well into a program run. If
it's never needed then the value code never runs.
A deferred constant is generally not inlined or folded (see
L) since it's not a single scalar value. In the
current implementation a deferred constant becomes a plain constant after
the first use, so may inline etc in code compiled after that (see
L below).
See F in the constant-defer source code for a complete
sample program.
=head2 Uses
Here are some typical uses.
=over 4
=item *
A big value or slow calculation only sometimes needed,
use constant::defer SLOWVALUE => sub {
long calculation ...;
return $result;
};
if ($option) {
print "s=", SLOWVALUE, "\n";
}
=item *
A shared object instance created when needed then re-used,
use constant::defer FORMATTER =>
sub { return My::Formatter->new };
if ($something) {
FORMATTER()->format ...
}
=item *
The value code might load requisite modules too, again deferring that until
actually needed,
use constant::defer big => sub {
require Some::Big::Module;
return Some::Big::Module->create_something(...);
};
=item *
Once-only setup code can be created with no return value. The code is
garbage collected after the first run and becomes a do-nothing. Remember to
have an empty or C return value so as not to keep the last expression
result alive forever.
use constant::defer MY_INIT => sub {
many lines of setup code ...;
return;
};
sub new {
MY_INIT();
...
}
=back
=head1 IMPORTS
There are no functions as such, everything works through the C