use strict; use warnings FATAL => 'all'; package MarpaX::Languages::ECMAScript::AST::Util; # ABSTRACT: ECMAScript Translation to AST - Class method utilities use Exporter 'import'; use Log::Any qw/$log/; use Data::Dumper; # Marpa follows Unicode recommendation, i.e. perl's \R, that cannot be in a character class our $NEWLINE_REGEXP = qr/(?>\x0D\x0A|\v)/; our $VERSION = '0.020'; # VERSION # CONTRIBUTORS our @EXPORT_OK = qw/whoami whowasi traceAndUnpack showLineAndCol lineAndCol lastCompleted startAndLength lastLexemeSpan/; our %EXPORT_TAGS = ('all' => [ @EXPORT_OK ]); sub _cutbase { my ($rc, $base) = @_; if (defined($base) && "$base" && index($rc, "${base}::") == $[) { substr($rc, $[, length($base) + 2, ''); } return $rc; } sub whoami { return _cutbase((caller(1))[3], @_); } sub whowasi { return _cutbase((caller(2))[3], @_); } sub traceAndUnpack { my $nameOfArgumentsp = shift; my $whowasi = whowasi(); my @string = (); my $min1 = scalar(@{$nameOfArgumentsp}); my $min2 = scalar(@_); my $min = ($min1 < $min2) ? $min1 : $min2; my $rc = {}; foreach (0..--$min) { my ($key, $value) = ($nameOfArgumentsp->[$_], $_[$_]); my $string = Data::Dumper->new([$value], [$key])->Indent(0)->Sortkeys(1)->Quotekeys(0)->Terse(0)->Dump(); $rc->{$key} = $value; # # Remove the ';' # substr($string, -1, 1, ''); push(@string, $string); } # # Skip MarpaX::Languages::ECMAScript::AST::if any # $whowasi =~ s/^MarpaX::Languages::ECMAScript::AST:://; $log->tracef('%s(%s)', $whowasi, join(', ', @string)); return($rc); } sub showLineAndCol { my ($line, $col, $source) = @_; my $pointer = ($col > 0 ? '-' x ($col-1) : '') . '^'; my $content = ''; my $prevpos = pos($source); pos($source) = undef; my $thisline = 0; my $nbnewlines = 0; my $eos = 0; while ($source =~ m/\G(.*?)($NEWLINE_REGEXP|\Z)/scmg) { if (++$thisline == $line) { $content = substr($source, $-[1], $+[1] - $-[1]); $eos = (($+[2] - $-[2]) > 0) ? 0 : 1; last; } } $content =~ s/\t/ /g; if ($content) { $nbnewlines = (substr($source, 0, pos($source)) =~ tr/\n//); if ($eos) { ++$nbnewlines; # End of string instead of $NEWLINE_REGEXP } } pos($source) = $prevpos; return "line:column $line:$col (Unicode newline count) $nbnewlines:$col (\\n count)\n\n$content\n$pointer"; } sub lineAndCol { my ($impl, $g1) = @_; $g1 //= $impl->current_g1_location(); my ($start, $length) = $impl->g1_location_to_span($g1); my ($line, $column) = $impl->line_column($start); return [ $line, $column ]; } sub startAndLength { my ($impl, $g1) = @_; $g1 //= $impl->current_g1_location(); my ($start, $length) = $impl->g1_location_to_span($g1); return [ $start, $length ]; } sub lastCompleted { my ($impl, $symbol) = @_; return $impl->substring($impl->last_completed($symbol)); } sub lastLexemeSpan { my ($impl) = @_; return $impl->g1_location_to_span($impl->current_g1_location()); } 1; __END__ =pod =encoding UTF-8 =head1 NAME MarpaX::Languages::ECMAScript::AST::Util - ECMAScript Translation to AST - Class method utilities =head1 VERSION version 0.020 =head1 SYNOPSIS use MarpaX::Languages::ECMAScript::AST::Util qw/:all/; my $whoami = whoami(); my $whowasi = whowasi(); callIt(0, '1', [2], {3 => 4}); sub callIt { my $hash = traceAndUnpack(['var1', 'var2', 'array1p', 'hash1p'], @_); } =head1 DESCRIPTION This modules implements some function utilities. =head1 EXPORTS The methods whoami(), whowasi() and traceAndUnpack() are exported on demand. =head1 SUBROUTINES/METHODS =head2 whoami($base) Returns the name of the calling routine. Optional $base prefix is removed. Typical usage is whoami(__PACKAGE__). =head2 whowasi($base) Returns the name of the parent's calling routine. Optional $base prefix is removed. Typical usage is whowasi(__PACKAGE__). =head2 traceAndUnpack($nameOfArgumentsp, @arguments) Returns a hash mapping @{$nameOfArgumentsp} to @arguments and trace it. The tracing is done using a method quite similar to Log::Any. Tracing and hash mapping stops at the end of @nameOfArguments or @arguments. =head2 showLineAndCol($line, $col, $source) Returns a string showing the request line, followed by another string that shows what is the column of interest, in the form "------^". =head2 lineAndCol($impl, $g1) Returns the output of Marpa's line_column at a given $g1 location. Default $g1 is Marpa's current_g1_location(). =head2 startAndLength($impl, $g1) Returns the output of Marpa's g1_location_to_span at a given $g1 location. Default $g1 is Marpa's current_g1_location(). =head2 lastCompleted($impl, $symbol) Returns the string corresponding the last completion of $symbol. =head2 lastLexemeSpan($impl) Returns the span ($start, $length) corresponding the last lexeme. =head1 AUTHOR Jean-Damien Durand =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2013 by Jean-Damien Durand. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut