Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Sub::Lexical

by broquaint (Abbot)
on May 15, 2002 at 19:34 UTC ( #166825=sourcecode: print w/ replies, xml ) Need Help??

Category: Miscellaneous
Author/Contact Info /msg broquaint
Description: Now available on CPAN - Sub::Lexical

See the POD for info about the module.

Basically I'm just throwing this out to see if anyone can find any use for this since it's really just syntactic sugar. There's still a couple of bugs but they should go if I ever bother putting it somewhere important like CPAN or the Code Section on Perl Monks. Hey wait a second ... And if anyone actually wants to play about with it a bit further I can provide them with an actual package (tests and all!)

Any improvements/suggestions/condemnations welcome

package Sub::Lexical;

$VERSION = 0.7;

use strict;

use Regexp::Common;
use Carp qw(croak cluck);

use constant DEBUG    => 0;

sub new {
    my $class   = shift;
    croak('Sub::Lexical constructor must be called as a class method')
        if $class ne 'Sub::Lexical';

    cluck("arguments passed to new() aren't in pair form")
        if @_ % 2 != 0;

    ## don't stuff list in if it don't fit
    my $self    = { @_ % 2 == 0 ? @_ : () };

    bless($self, $class);
}

my $brackets_re     = $RE{balanced}{-parens => '{}'};
my $paren_re        = $RE{balanced}{-parens => '()'};

my $sub_name_re     = qr{[_a-zA-Z](?:[\w_]+)?};
my $sub_proto_re    = qr{\([\$%\\@&\s]*\)};
my $sub_attrib_re   = qr{(?:\s*:\s*$sub_name_re\s*(?:$paren_re)?)*}o;

                      # my sub foobar (proto) : attrib { "code" }
my $sub_match_re    = qr/
                            my
                            \s+
                            sub
                            \s+
                            ($sub_name_re)
                            \s*
                            (
                                ${sub_proto_re}  ?
                                ${sub_attrib_re} ?
                            ) ?
                            \s*
                            (
                                $brackets_re
                            ) ?
                            \s*
                            ; ?
                        /xo;

## core functions which may expect a function e.g goto &foo
my $core_funcs    = join '|', qw(do defined eval goto grep map sort un
+def);
## things that *can't* come before a bareword
my $ops_before    = qr/(?<! \$ | % | @ | ' | " ) |
                       (?>! q. | -> ) |
                       (?>! q[ ]\w | qq. ) |
                       (?>! qq[ ]\w )/x;


sub lexfilter {
    my $self = shift;
    croak('filter_code() must be called as an object method')
        unless $self->isa('Sub::Lexical');

    my $code = shift;
    study $code;

    while(my($subname, $subextra, $subcode) = $code =~ /$sub_match_re/
+) {
        push @{$self->{info}}, {
            name    => $subname,
            extra   => $subextra,
            code    => $subcode
        };

        my $lexname = "\$LEXSUB_${subname}";
        ## 'my sub name {}' => 'my $name; $name = sub {};'
        $code =~ s<$sub_match_re>
                  <my \$LEXSUB_$1; \$LEXSUB_$1 = sub $2 $3;>g;

        ## '&name()' => '$name->()'
        $code =~ s<
                    &?               # optional &
                    $subname         # 'subname'
                    \s*              # 0+ whitespace
                    (                # group $1
                        $paren_re    # balanced parens
                    )                # optional group $1
                 >{"$lexname->" . ($1 || '()')}exg;

        ## 'goto &name' => 'goto &$name'
        $code =~ s<($core_funcs) \s* &$subname\b>
                  <$1 &$lexname>xg;

        ## '&name' => '$name->(@_)'
        $code =~ s{ (?<!\\) &$subname\b}
                  {$lexname->(\@_)}xg;

        ## '\&name' => '$name'
        $code =~ s<\\ \s* &($sub_name_re)\b>
                  <\$LEXSUB_$1>xg;
           $subname \b ($bracket_re) >{};
        }

        ## 'name' => '$name->()'
        $code =~ s{(?: ^ | (?<! LEXSUB_) ( (?: $ops_before | \s+) \s* 
+) )
                   $subname \b }
                  {$1$lexname->()}xmg;
    }

    return $code;
}

use Filter::Simple;

FILTER_ONLY code => sub {
    my $f = Sub::Lexical->new();
    $_ = $f->filter_code($_);
};

q(package activated);

__END__

=pod

=head1 NAME

Sub::Lexical - implement lexically scoped subroutines

=head1 SYNOPSIS

use Sub::Lexical;

    sub foo {
        my @vals = @_;

        my sub bar {
            my $arg = shift;
            print "\$arg is $arg\n";
            print "\$vals are @vals\n";
        }

        bar("just a string");

        my sub quux (@) {
            print "quux got args [@_]\n";
        }

        takesub(\&quux, qw(ichi ni san shi));
    }

    sub takesub {
        print "executing given sub\n\t"; shift->(@_[1..$#_])

    }

    foo(qw(a bunch of args));

=head1 DESCRIPTION

Using this module will give your code the illusion of having lexically
scoped subroutines. This is because where ever a sub is lexically
declared it will really just turn into a C<my()>ed scalar pointing to
a coderef.

However the lexically scoped subs seem to work as one might expect
them to. They can see other lexically scoped variables and subs, and
will fall out of scope like they should. You can pass them around like
coderefs, give them attributes and prototypes too if you're feeling
particularly brave

=head1 SEE ALSO

perlsub, Regex::Common, Filter::Simple

=head1 THANKS

Damian Conway and PerlMonks for giving me the skills and resources to
write this

=head1 AUTHOR

by Dan Brook

=head1 COPYRIGHT

Copyright (c) 2002, Dan Brook. All Rights Reserved. This module is
free software. It may be used, redistributed and/or modified under the
same terms as Perl itself.

=cut

Comment on Sub::Lexical
Download Code
Re: Sub::Lexical
by particle (Vicar) on May 15, 2002 at 19:58 UTC
    i haven't been able to get Filter::Simple to build on win32, so i can't test your code right now. that's a shame, because this looks like fun code to test.

    i do suspect you'll have a little difficulty with functions like DATA or END. i don't think surrounding double-underbars are the best identifiers, they already mean something. of course, users naming functions like those i mentioned are probably up to no good, anyway.

    ~Particle *accelerates*

Symbol ? Re: Sub::Lexical
by Corion (Pope) on May 15, 2002 at 20:52 UTC

    I haven't really played with it, but maybe Symbol (even in the core distribution) could be of help here - it generates anonymous globs, although not in the namespace you'd propably like (which ruins the 'Lexical' part of the module I guess):

    perl -MSymbol -e "print ${gensym()} for 1 .. 10"

    Most likely, you'll have to come up with a good identifier scheme, maybe by mucking around with variable names with spaces in them or simply dieing, if a variable with your chosen prefix is used.

    Also, I'm not really sure if all that the module promises is true, as I believe that things get nasty if you nest subs two levels deep (or deeper) - that's one thing I miss from Pascal.

    perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ; # The $d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider ($c = $d->accept())->get_request(); $c->send_response( new #in the HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' # web
      maybe Symbol (even in the core distribution) could be of help here
      I'll try incorporating that at some point to see how it fares, it will certainly save on the variable munging trickery.
      Update: on second thoughts, this won't save variable name munging at all as I still have to create a lexical variable to assign to the glob etc etc If only I could create my own temporary lexical scopes to declare them in, hmmm ...
      I believe that things get nasty if you nest subs two levels deep (or deeper) - that's one thing I miss from Pascal.
      Nope, that's the beauty of lexical subs - you can nest to your hearts content!
      use Sub::Lexical; ## can't nest package level subs sub foo { my $foovar = "in foo here\n"; my sub bar { my $barvar = "in bar here\n"; print "\$foovar = $foovar"; my sub baz { my $bazvar = "in baz here\n"; print "\$barvar = $barvar"; my sub quux { my $quuxvar = "in quux here\n"; print "\$bazvar = $bazvar"; my sub ooh_this_is_deep { my $ooh_this_is_deepvar = "in deep here\n"; print "\$otidv = $ooh_this_is_deepvar"; } ooh_this_is_deep(); } # ooh_this_is_deep falls outta scope here quux(); } # quux falls outta scope here baz(); } # baz falls outta scope here bar(); } # bar falls outta scope here foo(); __output__ $foovar = in foo here $barvar = in bar here $bazvar = in baz here $otidv = in deep here
      The problem with nesting subs is explored here and this module fixes that issue to a degree by hiding by the nested subs as anonymous subs tied to lexicals variables, so you're not really nesting subs at all (but who's the wiser ? ;-)
      HTH

      _________
      broquaint

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://166825]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (11)
As of 2014-09-17 21:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (100 votes), past polls