view release on metacpan or  search on metacpan

src/Perlito5/Grammar/Scope.pm  view on Meta::CPAN

package Perlito5::Grammar::Scope;

use Perlito5::AST;
use strict;

sub new {
    return { block => [] };
}

sub new_base_scope {
    return { block => [] }
}

sub create_new_compile_time_scope {
    # start new compile-time lexical scope
    push @Perlito5::BASE_SCOPE, {
        block       => [],
        hint_scalar => $^H,
        hint_hash   => {%^H},
    };
    # warn "ENTER $Perlito5::PKG_NAME \n";
    # print STDERR "create_new_compile_time_scope [ $^H ]\n";
}

sub end_compile_time_scope {
    # warn "EXIT\n";
    my $scope = pop @Perlito5::BASE_SCOPE;
    $^H = $scope->{hint_scalar};
    %^H = %{ $scope->{hint_hash} || {} };
    # print STDERR "end_compile_time_scope [ $^H ]\n";
}

sub compile_time_glob_set {
    # set a GLOB at compile-time
    my ($glob, $value, $namespace) = @_;
    if ( !ref($glob) ) {
        if ( $glob !~ /::/ ) {
            $glob = $namespace . '::' . $glob;
        }
        # mark the variable as "seen"
        my @parts = split "::", $glob;
        my $name = pop @parts;
        Perlito5::AST::Var->new( name => $name, namespace => join("::", @parts), sigil => "*", _decl => "global" );

        if (ref($value) eq 'SCALAR') {
            $Perlito5::VARS{'$' . $glob} = 1;
        }
        if (ref($value) eq 'HASH') {
            $Perlito5::VARS{'%' . $glob} = 1;
        }
        if (ref($value) eq 'ARRAY') {
            $Perlito5::VARS{'@' . $glob} = 1;
        }
    }
    *{$glob} = $value;
}

sub lookup_variable {
    # search for a variable declaration in the compile-time scope
    my $var = shift;
    my $scope = shift() // 0;

    return $var if $var->{namespace};       # global variable
    return $var if $var->{_decl};           # predeclared variable

    my $look = lookup_variable_inner($var, $scope);
    return $look if $look;

    return if ref($var) ne 'Perlito5::AST::Var';

    if ( $var->is_special_var() ) {
        # special variable
        $var->{_decl} = 'global';
        $var->{_namespace} = 'main';
        return $var;
    }

    if ( $var->{sigil} eq '$' && ( $var->{name} eq 'a' || $var->{name} eq 'b' ) ) {
        if ( !$var->{_real_sigil} ) {
            # special variables $a and $b
            $var->{_decl} = 'global';
            $var->{_namespace} = $Perlito5::PKG_NAME;
            return $var;
        }
    }
    return;
}