Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Perlito5 - parser: new module Perlito5::Grammar::Sigil

  • Loading branch information...
commit 1d5cf89b8532c8fea313a3645a30156a13e3b03f 1 parent 933767d
@fglock authored
View
10 TODO-perlito5
@@ -43,8 +43,6 @@ TODO list for Perlito5
the several "end_tables" in Expression.pm are duplicating the function of
$Precedence in Precedence.pm - Expression.pm should use $Precedence directly.
--- ' $# ' should be a syntax error (parses as $#{undef} )
-
-- fix the prototype for 'stat(*)' (see t/test.pl in the perl test suite)
-- compile-time eval() is not bound to the "program" environment, but to the "compiler" environment instead
@@ -67,8 +65,6 @@ TODO list for Perlito5
-- deref inside double quotes:
$ node perlito5.js -Bjs -e ' my $x = "123"; my $y = \$x; print "[$$y]\n" '
[$[object Object]]
--- bug: ' $$x [$y] '
- parses as ${$x}->[$y];
$ node perlito5.js -MO=Deparse -e ' " $v->{x} $$v{x} " '
(' ' . $v . '->{x} $' . $v{'x'} . ' ');
@@ -130,9 +126,15 @@ TODO list for Perlito5
t5/01-perlito/12-context.t fails because:
" return (4, 5) " instead of " return 4, 5 "
+-- bug: ' $$x [$y] '
+ emits as ${$x}->[$y];
+
* Javascript backend
+-- bug: ' $$x [$y] '
+ emits like ${$x}->[$y];
+
-- bug: scalar assignment context:
$ node perlito5.js -Isrc5/lib -e ' @v = (4,7,9); $v = @v; print $v '
479
View
9 src5/lib/Perlito5/Expression.pm
@@ -564,6 +564,15 @@ token term_sigil {
)
]
}
+ | <before '$'> <term_sigil>
+ { $MATCH->{capture} = [ 'term',
+ Perlito5::AST::Apply->new(
+ 'arguments' => [ $MATCH->{term_sigil}{capture}[1] ],
+ 'code' => 'prefix:<' . Perlito5::Match::flat($MATCH->{var_sigil_or_pseudo}) . '>',
+ 'namespace' => ''
+ )
+ ]
+ }
]
| <term_special_var>
{ $MATCH->{capture} = $MATCH->{term_special_var}->{capture} }
View
1  src5/lib/Perlito5/Grammar.pm
@@ -3,6 +3,7 @@ package Perlito5::Grammar;
use Perlito5::Expression;
use Perlito5::Grammar::Control;
use Perlito5::Grammar::String;
+use Perlito5::Grammar::Sigil;
use Perlito5::Grammar::Use;
use Perlito5::Grammar::Block;
use Perlito5::Grammar::Space;
View
238 src5/lib/Perlito5/Grammar/Sigil.pm
@@ -0,0 +1,238 @@
+use v5;
+
+package Perlito5::Grammar::Sigil;
+
+use Perlito5::Precedence;
+
+Perlito5::Precedence::add_term( '$' => sub { Perlito5::Grammar::Sigil->term_sigil($_[0], $_[1]) } );
+Perlito5::Precedence::add_term( '@' => sub { Perlito5::Grammar::Sigil->term_sigil($_[0], $_[1]) } );
+Perlito5::Precedence::add_term( '%' => sub { Perlito5::Grammar::Sigil->term_sigil($_[0], $_[1]) } );
+Perlito5::Precedence::add_term( '&' => sub { Perlito5::Grammar::Sigil->term_sigil($_[0], $_[1]) } );
+Perlito5::Precedence::add_term( '*' => sub { Perlito5::Grammar::Sigil->term_sigil($_[0], $_[1]) } );
+
+
+# the special variables list
+# obtained with:
+# $ perldoc -u perlvar | perl -ne ' /^\s*$/ && next; if (/^=item\s+([^\n]+)/) { push @item, $1; print "@item - $_" } else { if (@item) { push @xx, [@item]; print "push\n"; @item = () } }; END {use Data::Dumper; print Dumper \@xx} '
+
+# $ perldoc -u perlvar | perl -ne ' /^\s*$/ && next; if (/^=item\s+([^\n]+)/) { push @item, $1; print "@item - $_" } else { if (@item) { push @xx, grep { /^[\@\$\%][^a-zA-Z0-9]$/ } @item; print "push\n"; @item = () } }; END {use Data::Dumper; print "$_ => 1,\n" for @xx} '
+
+my %special_var = (
+ '$_' => 1,
+ '$&' => 1,
+ '$`' => 1,
+ '$\'' => 1,
+ '$+' => 1,
+ '@+' => 1,
+ '%+' => 1,
+ '$.' => 1,
+ '$/' => 1,
+ '$|' => 1,
+ '$,' => 1,
+ '$\\' => 1,
+ '$"' => 1,
+ '$;' => 1,
+ '$%' => 1,
+ '$=' => 1,
+ '$-' => 1,
+ '@-' => 1,
+ '%-' => 1,
+ '$~' => 1,
+ '$^' => 1,
+ '$:' => 1,
+ '$?' => 1,
+ '$!' => 1,
+ '%!' => 1,
+ '$@' => 1,
+ '$$' => 1,
+ '$<' => 1,
+ '$>' => 1,
+ '$(' => 1,
+ '$)' => 1,
+ '$[' => 1,
+ '$]' => 1,
+ '@_' => 1,
+ # '$#' => 1, # "$# is no longer supported"
+ '$*' => 1,
+
+ '$#+' => 1, # $# + @+
+ '$#-' => 1, # $# + @-
+ '$#_' => 1, # $# + @_
+);
+
+sub term_special_var {
+ my $self = $_[0];
+ my $str = $_[1];
+ my $pos = $_[2];
+ my $len = 0;
+
+ # TODO:
+ #
+ # this is ok:
+ # ' $ {!} ', ' @ {+} ', ' $#{+} '
+ # ' @{ x ->[10] } '
+ # ' ${v {int} -> {t}} '
+ #
+ # syntax errors:
+ # ' $# {+} ', ' $ #{+} ', ' @ { + } '
+ # ' @x->[10] '
+ #
+ # this is never a function call:
+ # ' ${main::x} '
+ #
+
+ my $s = substr( $str, $pos, 3 );
+ if ( $s eq '$#[' ) {
+ # special case: $# is not valid, but @# is ok
+ $len = 2;
+ }
+ elsif ( exists $special_var{$s} ) {
+ $len = 3;
+ }
+ else {
+ $s = substr( $str, $pos, 2 );
+ if ( exists $special_var{$s} ) {
+ $len = 2;
+ }
+ }
+ if ( $len ) {
+ my $c0 = substr( $str, $pos + $len - 1, 1 );
+ my $c1 = substr( $str, $pos + $len, 1 );
+ if (
+ ( $c0 eq '$' || $c0 eq '@' || $c0 eq '%' || $c0 eq '*' || $c0 eq '&' )
+ &&
+ ( $c1 eq '$' || $c1 eq '@' || $c1 eq '%' || $c1 eq '*' || $c1 eq '&'
+ || ( $c1 ge 'a' && $c1 le 'z' )
+ || ( $c1 ge 'A' && $c1 le 'Z' )
+ || ( $c1 ge '0' && $c1 le '9' )
+ )
+ )
+ {
+ # TODO - this needs more testing
+ # looks like a prefix operator, not a special var
+ }
+ else {
+ return {
+ str => $str,
+ from => $pos,
+ to => $pos + $len,
+ capture => [ 'term',
+ Perlito5::AST::Var->new(
+ sigil => substr($s, 0, $len - 1),
+ namespace => '',
+ name => substr($s, $len - 1, 1)
+ )
+ ]
+ };
+ }
+ }
+ return 0;
+}
+
+token var_sigil_or_pseudo { '$#' | \$ |\% |\@ |\& | \* };
+
+token term_sigil {
+ <var_sigil_or_pseudo> <.Perlito5::Grammar::Space.opt_ws>
+ [ '{' <.Perlito5::Grammar::Space.opt_ws>
+ [
+ | <Perlito5::Grammar.optional_namespace_before_ident> <Perlito5::Grammar.var_name>
+ <.Perlito5::Grammar::Space.opt_ws>
+
+ {
+ # we are parsing: ${var} ${var{index}}
+ # create the 'Var' object
+ $MATCH->{capture} = Perlito5::AST::Var->new(
+ sigil => Perlito5::Match::flat($MATCH->{var_sigil_or_pseudo}),
+ namespace => Perlito5::Match::flat($MATCH->{"Perlito5::Grammar.optional_namespace_before_ident"}),
+ name => Perlito5::Match::flat($MATCH->{"Perlito5::Grammar.var_name"}),
+ );
+ # hijack some string interpolation code to parse the subscript
+ $MATCH = Perlito5::Grammar::String->double_quoted_var_with_subscript($MATCH);
+ $MATCH->{capture} = [ 'term', $MATCH->{capture} ];
+ }
+ <.Perlito5::Grammar::Space.opt_ws>
+ '}'
+
+
+ | '^' <Perlito5::Grammar.var_name> '}'
+ { $MATCH->{capture} = [ 'term',
+ Perlito5::AST::Var->new(
+ sigil => Perlito5::Match::flat($MATCH->{var_sigil_or_pseudo}),
+ namespace => 'main',
+ name => '^' . Perlito5::Match::flat($MATCH->{"Perlito5::Grammar.var_name"}),
+ )
+ ]
+ }
+ | <Perlito5::Expression.curly_parse> '}'
+ { $MATCH->{capture} = [ 'term',
+ Perlito5::AST::Apply->new(
+ 'arguments' => [ Perlito5::Match::flat($MATCH->{"Perlito5::Expression.curly_parse"}) ],
+ 'code' => 'prefix:<' . Perlito5::Match::flat($MATCH->{var_sigil_or_pseudo}) . '>',
+ 'namespace' => ''
+ )
+ ]
+ }
+ ]
+ | '^' <Perlito5::Grammar.word>
+ { $MATCH->{capture} = [ 'term',
+ Perlito5::AST::Var->new(
+ sigil => Perlito5::Match::flat($MATCH->{var_sigil_or_pseudo}),
+ namespace => 'main',
+ name => '^' . Perlito5::Match::flat($MATCH->{"Perlito5::Grammar.word"}),
+ )
+ ]
+ }
+ | <Perlito5::Grammar.optional_namespace_before_ident> <Perlito5::Grammar.var_name>
+ { $MATCH->{capture} = [ 'term',
+ Perlito5::AST::Var->new(
+ sigil => Perlito5::Match::flat($MATCH->{var_sigil_or_pseudo}),
+ namespace => Perlito5::Match::flat($MATCH->{"Perlito5::Grammar.optional_namespace_before_ident"}),
+ name => Perlito5::Match::flat($MATCH->{"Perlito5::Grammar.var_name"}),
+ )
+ ]
+ }
+ | <before '$'> <term_sigil>
+ { $MATCH->{capture} = [ 'term',
+ Perlito5::AST::Apply->new(
+ 'arguments' => [ $MATCH->{term_sigil}{capture}[1] ],
+ 'code' => 'prefix:<' . Perlito5::Match::flat($MATCH->{var_sigil_or_pseudo}) . '>',
+ 'namespace' => ''
+ )
+ ]
+ }
+ ]
+ | <term_special_var>
+ { $MATCH->{capture} = $MATCH->{term_special_var}->{capture} }
+};
+
+
+1;
+
+=begin
+
+=head1 NAME
+
+Perlito5::Grammar::Sigil - Parser module for Perlito
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This module parses source code for Perl 5 statements and generates Perlito5 AST.
+
+=head1 AUTHORS
+
+Flavio Soibelmann Glock <fglock@gmail.com>.
+The Pugs Team E<lt>perl6-compiler@perl.orgE<gt>.
+
+=head1 COPYRIGHT
+
+Copyright 2010, 2011, 2012 by Flavio Soibelmann Glock and others.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=end
+
View
23 src5/lib/Perlito5/Precedence.pm
@@ -53,13 +53,6 @@ my %Parsed_op = (
my @Term_chars = (7, 6, 5, 4, 3, 2, 1);
my %Term = (
- # 1 char
- '$' => sub { Perlito5::Expression->term_sigil($_[0], $_[1]) },
- '@' => sub { Perlito5::Expression->term_sigil($_[0], $_[1]) },
- '%' => sub { Perlito5::Expression->term_sigil($_[0], $_[1]) },
- '&' => sub { Perlito5::Expression->term_sigil($_[0], $_[1]) },
- '*' => sub { Perlito5::Expression->term_sigil($_[0], $_[1]) },
-
'.' => sub { Perlito5::Expression->term_digit($_[0], $_[1]) },
'0' => sub { Perlito5::Expression->term_digit($_[0], $_[1]) },
'1' => sub { Perlito5::Expression->term_digit($_[0], $_[1]) },
@@ -72,23 +65,22 @@ my %Term = (
'8' => sub { Perlito5::Expression->term_digit($_[0], $_[1]) },
'9' => sub { Perlito5::Expression->term_digit($_[0], $_[1]) },
- # 2 chars
'my' => sub { Perlito5::Expression->term_declarator($_[0], $_[1]) },
'do' => sub { Perlito5::Expression->term_do($_[0], $_[1]) },
- # 3 chars
+
'our' => sub { Perlito5::Expression->term_declarator($_[0], $_[1]) },
'sub' => sub { Perlito5::Expression->term_anon_sub($_[0], $_[1]) },
'map' => sub { Perlito5::Expression->term_map_or_sort($_[0], $_[1]) },
- # 4 chars
+
'eval' => sub { Perlito5::Expression->term_eval($_[0], $_[1]) },
'sort' => sub { Perlito5::Expression->term_map_or_sort($_[0], $_[1]) },
'grep' => sub { Perlito5::Expression->term_map_or_sort($_[0], $_[1]) },
- # 5 chars
+
'state' => sub { Perlito5::Expression->term_declarator($_[0], $_[1]) },
'local' => sub { Perlito5::Expression->term_declarator($_[0], $_[1]) },
- # 6 chars
+
'return' => sub { Perlito5::Expression->term_return($_[0], $_[1]) },
- # 7 chars
+
'package' => sub { Perlito5::Expression->term_package($_[0], $_[1]) },
);
@@ -247,11 +239,6 @@ add_op( 'postfix', 'methcall_no_params', $prec, );
add_op( 'postfix', 'block', $prec, );
add_op( 'postfix', 'hash', $prec, );
-add_op( 'prefix', $_, $prec)
- for qw(
- $ $# & * @ %
- );
-
$prec = $prec - 1;
add_op( 'prefix', '++', $prec );
add_op( 'prefix', '--', $prec );
Please sign in to comment.
Something went wrong with that request. Please try again.