File Coverage

blib/lib/MarpaX/Languages/C/AST/Scope.pm

Criterion	Covered	Total	%
statement	68	110	61.8
branch	12	42	28.5
condition	2	15	13.3
subroutine	15	22	68.1
pod	17	17	100.0
total	114	206	55.3

use strict;
use warnings FATAL => 'all';

package MarpaX::Languages::C::AST::Scope;
use MarpaX::Languages::C::AST::Util qw/whoami/;

# ABSTRACT: Scope management when translating a C source to an AST

use Log::Any qw/$log/;
use Carp qw/croak/;

our $VERSION = '0.45'; # VERSION


sub new {
  my ($class) = @_;

  my $self  = {
      _nscope => 0,
      _typedefPerScope => [ {} ],
      _enumAnyScope => {},
      _delay => [],
      _enterScopeCallback => [],
      _exitScopeCallback => [],
  };
  bless($self, $class);

  return $self;
}


sub typedefPerScope {
  my ($self) = @_;

  return $self->{_typedefPerScope};
}


sub enumAnyScope {
  my ($self) = @_;

  return $self->{_enumAnyScope};
}


sub parseEnterScope {
  my ($self) = @_;

  # $self->condExitScope();

  if ($log->is_debug) {
      $log->debugf('[%s] Duplicating scope %d to %d', whoami(__PACKAGE__), $self->{_nscope}, $self->{_nscope} + 1);
  }
  #
  # calling Clone::clone is overhead for us:
  # - user data associated to a typedef is assumed to never be modified: copying the $data itself (i.e. usually a reference) is enough
  # - We just want to make sure this is a new hash, the values inside the hash can remain identical
  #
  # Doing \%{$...} is just to make sure this is a new hash instance, with keys pointing to the same values as the origin
  #
  push(@{$self->{_typedefPerScope}}, \%{$self->{_typedefPerScope}->[$self->{_nscope}]});
  push(@{$self->{_delay}}, 0);
  $self->{_nscope}++;

  if (@{$self->{_enterScopeCallback}}) {
      my ($ref, @args) = @{$self->{_enterScopeCallback}};
      &$ref(@args);
  }

}


sub parseDelay {
  my $self = shift;
  if (@_) {
    my $value = shift;
    if ($log->is_debug) {
        $log->debugf('[%s] Setting delay flag to %d at scope %d', whoami(__PACKAGE__), $value, $self->{_nscope});
    }
    $self->{_delay}->[-1] = $value;
  }
  return $self->{_delay}->[-1];
}


sub parseScopeLevel {
  my ($self) = @_;

  return $self->{_nscope};
}


sub parseEnterScopeCallback {
  my ($self, $ref, @args) = @_;

  $self->{_enterScopeCallback} = [ $ref, @args ];
}


sub parseExitScopeCallback {
  my ($self, $ref, @args) = @_;

  $self->{_exitScopeCallback} = [ $ref, @args ];
}


sub parseExitScope {
  my ($self, $now) = @_;
  $now //= 0;

  if ($now) {
    $self->doExitScope();
  } else {
    $self->parseDelay(1);
  }
}


sub parseReenterScope {
  my ($self) = @_;

  if ($log->is_debug) {
      $log->debugf('[%s] Reenter scope at scope %d', whoami(__PACKAGE__), $self->{_nscope});
  }
  $self->parseDelay(0);

}


sub condExitScope {
  my ($self) = @_;

  if ($self->parseDelay) {
    $self->doExitScope();
  }
}


sub doExitScope {
  my ($self) = @_;

  if ($log->is_debug) {
      $log->debugf('[%s] Removing scope %d', whoami(__PACKAGE__), $self->{_nscope});
  }
  pop(@{$self->{_typedefPerScope}});
  pop(@{$self->{_delay}});
  $self->{_nscope}--;

  if (@{$self->{_exitScopeCallback}}) {
      my ($ref, @args) = @{$self->{_exitScopeCallback}};
      &$ref(@args);
  }

  if ($self->{_nscope} > 0) {
    #
    # If the parent scope was marked delayed, we close it as well:
    #
    if ($self->parseDelay) {
      if ($log->is_debug) {
        $log->debugf('[%s] Parent scope has delay flag on', whoami(__PACKAGE__));
      }
      $self->doExitScope;
    } else {
      $self->parseDelay(0);
    }
  }
}


sub parseEnterTypedef {
  my ($self, $token, $data) = @_;

  $data //= 1;

  $self->{_typedefPerScope}->[$self->{_nscope}]->{$token} = $data;

  if ($log->is_debug) {
      $log->debugf('[%s] "%s" typedef entered at scope %d', whoami(__PACKAGE__), $token, $self->{_nscope});
  }
}


sub parseEnterEnum {
  my ($self, $token, $data) = @_;

  $data //= 1;

  $self->{_enumAnyScope}->{$token} = $data;
  if ($log->is_debug) {
      $log->debugf('[%s] "%s" enum entered at scope %d', whoami(__PACKAGE__), $token, $self->{_nscope});
  }
  #
  # Enum wins from now on and forever
  #
  foreach (0..$#{$self->{_typedefPerScope}}) {
      $self->parseObscureTypedef($token, $_);
  }
}


sub parseObscureTypedef {
  my ($self, $token, $scope) = @_;

  $scope //= $self->{_nscope};
  $self->{_typedefPerScope}->[$scope]->{$token} = undef;

  if ($log->is_debug) {
      $log->debugf('[%s] "%s" eventual typedef obscured at scope %d', whoami(__PACKAGE__), $token, $scope);
  }
}


sub parseIsTypedef {
  my ($self, $token) = @_;

  my $scope = $self->{_nscope};
  my $rc = (exists($self->{_typedefPerScope}->[$scope]->{$token}) && defined($self->{_typedefPerScope}->[$scope]->{$token})) ? 1 : 0;

  if ($log->is_debug) {
      $log->debugf('[%s] "%s" at scope %d is a typedef? %s', whoami(__PACKAGE__), $token, $scope, $rc ? 'yes' : 'no');
  }

  return($rc);
}


sub parseIsEnum {
  my ($self, $token) = @_;

  my $rc = (exists($self->{_enumAnyScope}->{$token}) && $self->{_enumAnyScope}->{$token}) ? 1 : 0;

  if ($log->is_debug) {
      $log->debugf('[%s] "%s" is an enum at scope %d? %s', whoami(__PACKAGE__), $token, $self->{_nscope}, $rc ? 'yes' : 'no');
  }

  return($rc);
}

1;

__END__