Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Perlito5 - perl5: "use" is compile-time (the emitted code contains al…

…l modules used)
  • Loading branch information...
commit b4f4a35270ef6bbdb9aea3b0f231ae00275a9a92 1 parent b44f592
@fglock authored
Showing with 10,223 additions and 10,795 deletions.
  1. +6 −6 README-perlito5
  2. +3 −1 TODO-perlito5
  3. +8 −2 html/perlito5.js
  4. +0 −251 lib5/Perlito5/AST.pm
  5. +0 −32 lib5/Perlito5/Dumper.pm
  6. +0 −239 lib5/Perlito5/Emitter/Token.pm
  7. +0 −209 lib5/Perlito5/Eval.pm
  8. +0 −1,594 lib5/Perlito5/Expression.pm
  9. +0 −1,360 lib5/Perlito5/Grammar.pm
  10. +0 −150 lib5/Perlito5/Grammar/Bareword.pm
  11. +0 −233 lib5/Perlito5/Grammar/Block.pm
  12. +0 −769 lib5/Perlito5/Grammar/Control.pm
  13. +0 −932 lib5/Perlito5/Grammar/Regex.pm
  14. +0 −310 lib5/Perlito5/Grammar/Space.pm
  15. +0 −1,237 lib5/Perlito5/Grammar/String.pm
  16. +0 −293 lib5/Perlito5/Grammar/Use.pm
  17. +0 −12 lib5/Perlito5/Javascript/CORE.pm
  18. +0 −1,282 lib5/Perlito5/Javascript/Emitter.pm
  19. +0 −12 lib5/Perlito5/Javascript/IO.pm
  20. +0 −12 lib5/Perlito5/Javascript/Runtime.pm
  21. +0 −45 lib5/Perlito5/Macro.pm
  22. +0 −13 lib5/Perlito5/Match.pm
  23. +0 −423 lib5/Perlito5/Perl5/Emitter.pm
  24. +0 −49 lib5/Perlito5/Perl5/Runtime.pm
  25. +0 −509 lib5/Perlito5/Perl6/Emitter.pm
  26. +0 −57 lib5/Perlito5/Perl6/Runtime.pm
  27. +0 −389 lib5/Perlito5/Precedence.pm
  28. +0 −16 lib5/Perlito5/Runtime.pm
  29. +0 −147 lib5/Perlito5/Test.pm
  30. +0 −14 lib5/Perlito5/bytes.pm
  31. +0 −14 lib5/Perlito5/strict.pm
  32. +0 −14 lib5/Perlito5/utf8.pm
  33. +0 −14 lib5/Perlito5/warnings.pm
  34. +10,181 −41 perlito5.pl
  35. +4 −12 src5/lib/Perlito5/Perl5/Emitter.pm
  36. +14 −17 src5/lib/Perlito5/Perl5/Runtime.pm
  37. +2 −5 src5/lib/Perlito5/Perl6/Emitter.pm
  38. +4 −12 src5/util/perlito5.pl
  39. +1 −1  util-js/make-perlito5-js.sh
  40. +0 −67 util-perl5/bootstrap-perlito5-perl5.sh
View
12 README-perlito5
@@ -1,7 +1,7 @@
Running the tests using "node.js":
# this command will compile "perlito5.js"
- perl -Ilib5 perlito5.pl -I./src5/lib -Cjs src5/util/perlito5.pl > perlito5.js
+ perl perlito5.pl -I./src5/lib -Cjs src5/util/perlito5.pl > perlito5.js
# this will run a single test script
node perlito5.js -Isrc5/lib t5/01-perlito/01-sanity.t
@@ -14,7 +14,7 @@ Compile the compiler to Javascript into perlito5.js:
-- using perl and perlito5.pl:
- perl -Ilib5 perlito5.pl -I./src5/lib -Cjs src5/util/perlito5.pl > perlito5.js
+ perl perlito5.pl -I./src5/lib -Cjs src5/util/perlito5.pl > perlito5.js
-- using node.js and perlito5.js:
@@ -22,9 +22,9 @@ Compile the compiler to Javascript into perlito5.js:
Compile the compiler to Perl5 using perl:
- perl util-perl5/bootstrap-perlito5-perl5.sh
+ perl perlito5.pl -I./src5/lib -Cperl5 src5/util/perlito5.pl > perlito5-new.pl
-Compiler perlito5-in-browser using perl:
+Compile perlito5-in-browser using perl:
perl util-js/make-perlito5-js.sh
@@ -32,7 +32,7 @@ Compiler perlito5-in-browser using perl:
Running the tests using "perl":
# this will run all tests
- prove -r -e 'perl -Ilib5 perlito5.pl -I./src5/lib ' t5
+ prove -r -e 'perl perlito5.pl -I./src5/lib ' t5
@@ -42,7 +42,7 @@ Running the tests using perl6:
# TODO - this is not implemented yet
. util-perl6/setup-perlito5-perl6.sh
- find t5/01-perlito/*.t | perl -ne ' print "*** $_"; chomp; print ` perl -Ilib5 perlito5.pl -I./src5/lib -Cperl6 $_ > tmp.p6 && perl6 tmp.p6 ` '
+ find t5/01-perlito/*.t | perl -ne ' print "*** $_"; chomp; print ` perl perlito5.pl -I./src5/lib -Cperl6 $_ > tmp.p6 && perl6 tmp.p6 ` '
View
4 TODO-perlito5
@@ -35,6 +35,8 @@ TODO list for Perlito5
* Parser
+-- no __END__
+
-- "sub _" should be in package "main"
-- "given" statement not implemented
@@ -201,7 +203,7 @@ TODO list for Perlito5
-- use the same error messages and warnings as 'perl'
-- no warnings 'redefine';
--- __END__, __LINE__, __DATA__, __FILE__
+-- __LINE__, __DATA__, __FILE__
-- INIT{}, END{}
look at the implementation in perlito6-in-Go
View
10 html/perlito5.js
@@ -1559,7 +1559,7 @@ var p5100 = p5pkg['main'];
// our p5pkg["Perlito5::Javascript"]["Hash_op_to_num"]
(p5pkg["Perlito5::Javascript"]["Hash_op_to_num"] = p5a_to_h(p5list_to_a(p5map(p5pkg["Perlito5::Javascript"], function (p5want) {
return ((p5context([p5pkg["Perlito5::Javascript"]["v__"], 1], p5want)));
- }, ['length', 'index', 'ord', 'oct', 'infix:<->', 'infix:<+>', 'infix:<*>', 'infix:</>', 'infix:<%>']))));
+ }, ['length', 'index', 'ord', 'oct', 'infix:<->', 'infix:<+>', 'infix:<*>', 'infix:</>', 'infix:<%>', 'infix:<**>']))));
var Hash_safe_char = {};
(Hash_safe_char = p5a_to_h([' ', 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]));
p5make_sub("Perlito5::Javascript", "escape_string", function (List__, p5want) {
@@ -2000,7 +2000,7 @@ var p5100 = p5pkg['main'];
p5pkg["Perlito5::Javascript::LexicalBlock"].push([List_str, p5list_to_a(p5call(((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] || ((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_[p5idx(((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] || ((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_,0)], "emit_javascript_init", [], 1))], null);
};
};
- if ( ((p5bool(p5call(v_last_statement, "isa", ['Perlito5::AST::Apply'], 0)) && (p5str(p5call(v_last_statement, "code", [], 0)) == 'return')) && p5bool((v_self || (v_self = new p5HashRef({})))._hash_['top_level'])) ) {
+ if ( (((p5bool(p5call(v_last_statement, "isa", ['Perlito5::AST::Apply'], 0)) && (p5str(p5call(v_last_statement, "code", [], 0)) == 'return')) && p5bool((v_self || (v_self = new p5HashRef({})))._hash_['top_level'])) && p5bool(((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] || ((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_)) ) {
(v_last_statement = (((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] || ((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_[p5idx(((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] || ((v_last_statement || (v_last_statement = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_,0)]));
};
if ( p5bool(p5call(v_last_statement, "isa", ['Perlito5::AST::If'], 0)) ) {
@@ -2636,6 +2636,12 @@ var p5100 = p5pkg['main'];
return (p5context([('p5cmp(' + p5pkg["Perlito5::AST::Apply"].join([', ', p5list_to_a(p5map(p5pkg["Perlito5::AST::Apply"], function (p5want) {
return (p5pkg["Perlito5::Javascript"].to_num([p5pkg["Perlito5::AST::Apply"]["v__"]], p5want));
}, p5list_to_a(((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] || ((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_)))], 0) + ')')], p5want));
+ }, 'infix:<**>', function (List__, p5want) {
+ var v_self = null;
+ (v_self = (List__[p5idx(List__,0)]));
+ return (p5context([('Math.pow(' + p5pkg["Perlito5::AST::Apply"].join([', ', p5list_to_a(p5map(p5pkg["Perlito5::AST::Apply"], function (p5want) {
+ return (p5pkg["Perlito5::Javascript"].to_num([p5pkg["Perlito5::AST::Apply"]["v__"]], p5want));
+}, p5list_to_a(((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] || ((v_self || (v_self = new p5HashRef({})))._hash_['arguments'] = new p5ArrayRef([])))._array_)))], 0) + ')')], p5want));
}, 'prefix:<!>', function (List__, p5want) {
var v_self = null;
(v_self = (p5pkg["Perlito5::AST::Apply"].shift([List__])));
View
251 lib5/Perlito5/AST.pm
@@ -1,251 +0,0 @@
-# Do not edit this file - Generated by Perlito5 9.0
-use v5.10;
-use Perlito5::Perl5::Runtime;
-package main;
-undef();
-package Perlito5::AST::CompUnit;
-sub Perlito5::AST::CompUnit::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::CompUnit::name {
- $_[0]->{ 'name'}
-};
-sub Perlito5::AST::CompUnit::body {
- $_[0]->{ 'body'}
-};
-package Perlito5::AST::Val::Int;
-sub Perlito5::AST::Val::Int::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Val::Int::int {
- $_[0]->{ 'int'}
-};
-package Perlito5::AST::Val::Num;
-sub Perlito5::AST::Val::Num::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Val::Num::num {
- $_[0]->{ 'num'}
-};
-package Perlito5::AST::Val::Buf;
-sub Perlito5::AST::Val::Buf::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Val::Buf::buf {
- $_[0]->{ 'buf'}
-};
-package Perlito5::AST::Lit::Block;
-sub Perlito5::AST::Lit::Block::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Lit::Block::sig {
- $_[0]->{ 'sig'}
-};
-sub Perlito5::AST::Lit::Block::stmts {
- $_[0]->{ 'stmts'}
-};
-package Perlito5::AST::Index;
-sub Perlito5::AST::Index::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Index::obj {
- $_[0]->{ 'obj'}
-};
-sub Perlito5::AST::Index::index_exp {
- $_[0]->{ 'index_exp'}
-};
-package Perlito5::AST::Lookup;
-sub Perlito5::AST::Lookup::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Lookup::obj {
- $_[0]->{ 'obj'}
-};
-sub Perlito5::AST::Lookup::index_exp {
- $_[0]->{ 'index_exp'}
-};
-sub Perlito5::AST::Lookup::autoquote {
- ((my $self) = shift());
- ((my $index) = shift());
- if (($index->isa('Perlito5::AST::Apply') && $index->{'bareword'})) {
- return (Perlito5::AST::Val::Buf->new('buf', ((($index->{'namespace'} ? ($index->{'namespace'} . '::') : '')) . $index->{'code'})))
- };
- $index
-};
-package Perlito5::AST::Var;
-sub Perlito5::AST::Var::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Var::sigil {
- $_[0]->{ 'sigil'}
-};
-sub Perlito5::AST::Var::namespace {
- $_[0]->{ 'namespace'}
-};
-sub Perlito5::AST::Var::name {
- $_[0]->{ 'name'}
-};
-sub Perlito5::AST::Var::plain_name {
- ((my $self) = shift());
- if ($self->namespace()) {
- return (($self->namespace() . '::' . $self->name()))
- };
- return ($self->name())
-};
-package Perlito5::AST::Proto;
-sub Perlito5::AST::Proto::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Proto::name {
- $_[0]->{ 'name'}
-};
-package Perlito5::AST::Call;
-sub Perlito5::AST::Call::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Call::invocant {
- $_[0]->{ 'invocant'}
-};
-sub Perlito5::AST::Call::method {
- $_[0]->{ 'method'}
-};
-sub Perlito5::AST::Call::arguments {
- $_[0]->{ 'arguments'}
-};
-package Perlito5::AST::Apply;
-sub Perlito5::AST::Apply::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Apply::code {
- $_[0]->{ 'code'}
-};
-sub Perlito5::AST::Apply::arguments {
- $_[0]->{ 'arguments'}
-};
-sub Perlito5::AST::Apply::namespace {
- $_[0]->{ 'namespace'}
-};
-package Perlito5::AST::If;
-sub Perlito5::AST::If::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::If::cond {
- $_[0]->{ 'cond'}
-};
-sub Perlito5::AST::If::body {
- $_[0]->{ 'body'}
-};
-sub Perlito5::AST::If::otherwise {
- $_[0]->{ 'otherwise'}
-};
-package Perlito5::AST::When;
-sub Perlito5::AST::When::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::When::cond {
- $_[0]->{ 'cond'}
-};
-sub Perlito5::AST::When::body {
- $_[0]->{ 'body'}
-};
-package Perlito5::AST::While;
-sub Perlito5::AST::While::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::While::init {
- $_[0]->{ 'init'}
-};
-sub Perlito5::AST::While::cond {
- $_[0]->{ 'cond'}
-};
-sub Perlito5::AST::While::continue {
- $_[0]->{ 'continue'}
-};
-sub Perlito5::AST::While::body {
- $_[0]->{ 'body'}
-};
-package Perlito5::AST::For;
-sub Perlito5::AST::For::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::For::cond {
- $_[0]->{ 'cond'}
-};
-sub Perlito5::AST::For::continue {
- $_[0]->{ 'continue'}
-};
-sub Perlito5::AST::For::body {
- $_[0]->{ 'body'}
-};
-package Perlito5::AST::Decl;
-sub Perlito5::AST::Decl::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Decl::decl {
- $_[0]->{ 'decl'}
-};
-sub Perlito5::AST::Decl::type {
- $_[0]->{ 'type'}
-};
-sub Perlito5::AST::Decl::var {
- $_[0]->{ 'var'}
-};
-package Perlito5::AST::Sig;
-sub Perlito5::AST::Sig::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Sig::positional {
- $_[0]->{ 'positional'}
-};
-package Perlito5::AST::Sub;
-sub Perlito5::AST::Sub::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Sub::name {
- $_[0]->{ 'name'}
-};
-sub Perlito5::AST::Sub::sig {
- $_[0]->{ 'sig'}
-};
-sub Perlito5::AST::Sub::block {
- $_[0]->{ 'block'}
-};
-package Perlito5::AST::Do;
-sub Perlito5::AST::Do::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Do::block {
- $_[0]->{ 'block'}
-};
-package Perlito5::AST::Use;
-sub Perlito5::AST::Use::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Perlito5::AST::Use::mod {
- $_[0]->{ 'mod'}
-};
-sub Perlito5::AST::Use::code {
- $_[0]->{ 'code'}
-};
-
-1;
View
32 lib5/Perlito5/Dumper.pm
@@ -1,32 +0,0 @@
-# Do not edit this file - Generated by Perlito5 9.0
-use v5.10;
-use Perlito5::Perl5::Runtime;
-package main;
-package Perlito5::Dumper;
-sub Perlito5::Dumper::Dumper {
- ((my $obj) = $_[0]);
- ((my $level) = ($_[1] || 0));
- if (!(defined($obj))) {
- return ('undef')
- };
- ((my $ref) = ref($obj));
- ((my $tab) = join("", ' ' x $level));
- ((my $tab1) = ($tab . ' '));
- if (($ref eq 'ARRAY')) {
- return (('[' . chr(10) . join('', map(($tab1 . Dumper($_, ($level + 1)) . ',' . chr(10)), @{$obj})) . $tab . ']'))
- }
- else {
- if (($ref eq 'HASH')) {
- return (('{' . chr(10) . join('', map(($tab1 . (chr(39) . $_ . chr(39) . ' => ') . Dumper($obj->{$_}, ($level + 1)) . ',' . chr(10)), sort(keys(%{$obj})))) . $tab . '}'))
- }
- else {
- if ($ref) {
- return (('bless({' . chr(10) . join('', map(($tab1 . (chr(39) . $_ . chr(39) . ' => ') . Dumper($obj->{$_}, ($level + 1)) . ',' . chr(10)), sort(keys(%{$obj})))) . $tab . ('}, ' . chr(39) . $ref . chr(39) . ')')))
- }
- }
- };
- return ((chr(39) . $obj . chr(39)))
-};
-1;
-
-1;
View
239 lib5/Perlito5/Emitter/Token.pm
@@ -1,239 +0,0 @@
-# Do not edit this file - Generated by Perlito5 9.0
-use v5.10;
-use Perlito5::Perl5::Runtime;
-package main;
-undef();
-package Rul;
-sub Rul::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::constant {
- ((my $str) = shift());
- ((my $len) = length($str));
- if (($str eq chr(92))) {
- ($str = chr(92) . chr(92))
- };
- if (($str eq chr(39))) {
- ($str = chr(92) . chr(39))
- };
- if ($len) {
- ('( ' . chr(39) . $str . chr(39) . ' eq substr( $str, $MATCH->{to}, ' . $len . ') ' . '&& ( $MATCH->{to} = ' . $len . ' + $MATCH->{to} )' . ')')
- }
- else {
- return ('1')
- }
-};
-package Rul::Quantifier;
-sub Rul::Quantifier::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Quantifier::term {
- $_[0]->{ 'term'}
-};
-sub Rul::Quantifier::quant {
- $_[0]->{ 'quant'}
-};
-sub Rul::Quantifier::greedy {
- $_[0]->{ 'greedy'}
-};
-sub Rul::Quantifier::emit_perl5 {
- ((my $self) = $_[0]);
- if ((($self->{'quant'} eq '') && ($self->{'greedy'} eq ''))) {
- return ($self->{'term'}->emit_perl5())
- };
- if ((($self->{'quant'} eq '+') && ($self->{'greedy'} eq ''))) {
- $self->{'term'}->set_captures_to_array();
- return (('(do { ' . 'my $last_match_null = 0; ' . 'my $m = $MATCH; ' . 'my $to = $MATCH->{to}; ' . 'my $count = 0; ' . 'while (' . $self->{'term'}->emit_perl5() . ' && ($last_match_null < 2)) ' . '{ ' . 'if ($to == $MATCH->{to}) { ' . '$last_match_null = $last_match_null + 1; ' . '} ' . 'else { ' . '$last_match_null = 0; ' . '}; ' . '$m = $MATCH; ' . '$to = $MATCH->{to}; ' . '$count = $count + 1; ' . '}; ' . '$MATCH = $m; ' . '$MATCH->{to} = $to; ' . '$count > 0; ' . '})'))
- };
- if ((($self->{'quant'} eq '*') && ($self->{'greedy'} eq ''))) {
- $self->{'term'}->set_captures_to_array();
- return (('(do { ' . 'my $last_match_null = 0; ' . 'my $m = $MATCH; ' . 'my $to = $MATCH->{to}; ' . 'while (' . $self->{'term'}->emit_perl5() . ' && ($last_match_null < 2)) ' . '{ ' . 'if ($to == $MATCH->{to}) { ' . '$last_match_null = $last_match_null + 1; ' . '} ' . 'else { ' . '$last_match_null = 0; ' . '}; ' . '$m = $MATCH; ' . '$to = $MATCH->{to}; ' . '}; ' . '$MATCH = $m; ' . '$MATCH->{to} = $to; ' . '1 ' . '})'))
- };
- if ((($self->{'quant'} eq '?') && ($self->{'greedy'} eq ''))) {
- $self->{'term'}->set_captures_to_array();
- return (('(do { ' . 'my $m = $MATCH; ' . 'if (!(do {' . $self->{'term'}->emit_perl5() . '})) ' . '{ ' . '$MATCH = $m; ' . '}; ' . '1 ' . '})'))
- };
- warn('Rul::Quantifier: not implemented');
- $self->{'term'}->emit_perl5()
-};
-sub Rul::Quantifier::set_captures_to_array {
- ((my $self) = $_[0]);
- $self->{'term'}->set_captures_to_array()
-};
-package Rul::Or;
-sub Rul::Or::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Or::or_list {
- $_[0]->{ 'or_list'}
-};
-sub Rul::Or::emit_perl5 {
- ((my $self) = $_[0]);
- ('(do { ' . 'my $pos1 = $MATCH->{to}; (do { ' . join('}) || (do { $MATCH->{to} = $pos1; ', map($_->emit_perl5(), @{$self->{'or_list'}})) . '}) })')
-};
-sub Rul::Or::set_captures_to_array {
- ((my $self) = $_[0]);
- map($_->set_captures_to_array(), @{$self->{'or_list'}})
-};
-package Rul::Concat;
-sub Rul::Concat::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Concat::concat {
- $_[0]->{ 'concat'}
-};
-sub Rul::Concat::emit_perl5 {
- ((my $self) = $_[0]);
- ('(' . join(' && ', map($_->emit_perl5(), @{$self->{'concat'}})) . ')')
-};
-sub Rul::Concat::set_captures_to_array {
- ((my $self) = $_[0]);
- map($_->set_captures_to_array(), @{$self->{'concat'}})
-};
-package Rul::Perlito5::AST::Subrule;
-sub Rul::Perlito5::AST::Subrule::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Perlito5::AST::Subrule::metasyntax {
- $_[0]->{ 'metasyntax'}
-};
-sub Rul::Perlito5::AST::Subrule::captures {
- $_[0]->{ 'captures'}
-};
-sub Rul::Perlito5::AST::Subrule::emit_perl5 {
- ((my $self) = $_[0]);
- ((my $s) = $self->{'metasyntax'});
- ($s =~ s!\.!->!g);
- ((my $meth) = (((1 + index($self->{'metasyntax'}, '.'))) ? $s : (('$grammar->' . $self->{'metasyntax'}))));
- (my $code);
- if (($self->{'captures'} == 1)) {
- ($code = ('if ($m2) { $MATCH->{to} = $m2->{to}; $MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '} = $m2; 1 } else { 0 }; '))
- }
- else {
- if (($self->{'captures'} > 1)) {
- ($code = ('if ($m2) { ' . '$MATCH->{to} = $m2->{to}; ' . 'if (exists $MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '}) { ' . 'push @{ $MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '} }, $m2; ' . '} ' . 'else { ' . '$MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '} = [ $m2 ]; ' . '}; ' . '1 ' . '} else { 0 }; '))
- }
- else {
- ($code = 'if ($m2) { $MATCH->{to} = $m2->{to}; 1 } else { 0 }; ')
- }
- };
- ('(do { ' . 'my $m2 = ' . $meth . '($str, $MATCH->{to}); ' . $code . '})')
-};
-sub Rul::Perlito5::AST::Subrule::set_captures_to_array {
- ((my $self) = $_[0]);
- if (($self->{'captures'} > 0)) {
- ($self->{'captures'} = ($self->{'captures'} + 1))
- }
-};
-package Rul::Constant;
-sub Rul::Constant::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Constant::constant {
- $_[0]->{ 'constant'}
-};
-sub Rul::Constant::emit_perl5 {
- ((my $self) = $_[0]);
- ((my $str) = $self->{'constant'});
- Rul::constant($str)
-};
-sub Rul::Constant::set_captures_to_array {
- ((my $self) = $_[0])
-};
-package Rul::Perlito5::AST::Dot;
-sub Rul::Perlito5::AST::Dot::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Perlito5::AST::Dot::emit_perl5 {
- ((my $self) = $_[0]);
- ('( ' . chr(39) . chr(39) . ' ne substr( $str, $MATCH->{to}, 1 ) ' . '&& ($MATCH->{to} = 1 + $MATCH->{to})' . ')')
-};
-sub Rul::Perlito5::AST::Dot::set_captures_to_array {
- ((my $self) = $_[0])
-};
-package Rul::SpecialChar;
-sub Rul::SpecialChar::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::SpecialChar::char {
- $_[0]->{ 'char'}
-};
-sub Rul::SpecialChar::emit_perl5 {
- ((my $self) = $_[0]);
- ((my $char) = $self->{'char'});
- if (($char eq 'n')) {
- return (Rul::Perlito5::AST::Subrule->new('metasyntax', 'is_newline', 'captures', 0)->emit_perl5())
- };
- if (($char eq 'N')) {
- return (Rul::Perlito5::AST::Subrule->new('metasyntax', 'not_newline', 'captures', 0)->emit_perl5())
- };
- if (($char eq 'd')) {
- return (Rul::Perlito5::AST::Subrule->new('metasyntax', 'digit', 'captures', 0)->emit_perl5())
- };
- if (($char eq 's')) {
- return (Rul::Perlito5::AST::Subrule->new('metasyntax', 'space', 'captures', 0)->emit_perl5())
- };
- if (($char eq 't')) {
- return (Rul::constant(chr(9)))
- };
- return (Rul::constant($char))
-};
-sub Rul::SpecialChar::set_captures_to_array {
- ((my $self) = $_[0])
-};
-package Rul::Block;
-sub Rul::Block::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Block::closure {
- $_[0]->{ 'closure'}
-};
-sub Rul::Block::emit_perl5 {
- ((my $self) = $_[0]);
- ('(do { ' . $self->{'closure'} . '; 1 })')
-};
-sub Rul::Block::set_captures_to_array {
- ((my $self) = $_[0])
-};
-package Rul::Before;
-sub Rul::Before::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::Before::rule_exp {
- $_[0]->{ 'rule_exp'}
-};
-sub Rul::Before::emit_perl5 {
- ((my $self) = $_[0]);
- ('(do { ' . 'my $tmp = $MATCH; ' . '$MATCH = { ' . chr(39) . 'str' . chr(39) . ' => $str, ' . chr(39) . 'from' . chr(39) . ' => $tmp->{to}, ' . chr(39) . 'to' . chr(39) . ' => $tmp->{to} }; ' . 'my $res = ' . $self->{'rule_exp'}->emit_perl5() . '; ' . '$MATCH = $res ? $tmp : 0; ' . '})')
-};
-sub Rul::Before::set_captures_to_array {
- ((my $self) = $_[0])
-};
-package Rul::NotBefore;
-sub Rul::NotBefore::new {
- ((my $class) = shift());
- bless({@_}, $class)
-};
-sub Rul::NotBefore::rule_exp {
- $_[0]->{ 'rule_exp'}
-};
-sub Rul::NotBefore::emit_perl5 {
- ((my $self) = $_[0]);
- ('(do { ' . 'my $tmp = $MATCH; ' . '$MATCH = { ' . chr(39) . 'str' . chr(39) . ' => $str, ' . chr(39) . 'from' . chr(39) . ' => $tmp->{to}, ' . chr(39) . 'to' . chr(39) . ' => $tmp->{to} }; ' . 'my $res = ' . $self->{'rule_exp'}->emit_perl5() . '; ' . '$MATCH = $res ? 0 : $tmp; ' . '})')
-};
-sub Rul::NotBefore::set_captures_to_array {
- ((my $self) = $_[0])
-};
-1;
-
-1;
View
209 lib5/Perlito5/Eval.pm
@@ -1,209 +0,0 @@
-# Do not edit this file - Generated by Perlito5 9.0
-use v5.10;
-use Perlito5::Perl5::Runtime;
-package main;
-undef();
-package Perlito5::AST::CompUnit;
-sub Perlito5::AST::CompUnit::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $env1) = [{}, @{$env}]);
- for my $stmt (@{$self->{'body'}}) {
- $stmt->eval($env1)
- }
-};
-package Perlito5::AST::Val::Int;
-sub Perlito5::AST::Val::Int::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- (0 + $self->{'int'})
-};
-package Perlito5::AST::Val::Num;
-sub Perlito5::AST::Val::Num::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- (0 + $self->{'num'})
-};
-package Perlito5::AST::Val::Buf;
-sub Perlito5::AST::Val::Buf::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- $self->{ 'buf'}
-};
-package Perlito5::AST::Lit::Block;
-sub Perlito5::AST::Lit::Block::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $env1) = [{}, @{$env}]);
- for my $stmt (@{$self->{'stmts'}}) {
- $stmt->eval($env1)
- }
-};
-package Perlito5::AST::Index;
-sub Perlito5::AST::Index::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ($self->{'obj'}->eval($env))->[$self->{'index_exp'}->eval($env)]
-};
-package Perlito5::AST::Lookup;
-sub Perlito5::AST::Lookup::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ($self->{'obj'}->eval($env))->{ $self->{'index_exp'}->eval($env)}
-};
-package Perlito5::AST::Var;
-sub Perlito5::AST::Var::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $ns) = '');
- if ($self->{'namespace'}) {
- ($ns = ($self->{'namespace'} . '::'))
- }
- else {
- if (((($self->{'sigil'} eq '@')) && (($self->{'name'} eq 'ARGV')))) {
- return (@ARGV)
- }
- };
- ((my $name) = ($self->{'sigil'} . $ns . $self->{'name'}));
- for my $e (@{$env}) {
- if (exists($e->{$name})) {
- return ($e->{$name})
- }
- };
- warn('Interpreter runtime error: variable ' . chr(39), $name, chr(39) . ' not found')
-};
-package Perlito5::AST::Proto;
-sub Perlito5::AST::Proto::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ('' . $self->{'name'})
-};
-package Perlito5::AST::Call;
-sub Perlito5::AST::Call::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- warn('Interpreter TODO: Perlito5::AST::Call');
- ((my $invocant) = $self->{'invocant'}->eval($env));
- if (($invocant eq 'self')) {
- ($invocant = '$self')
- };
- warn('Interpreter runtime error: method ' . chr(39), $self->{'method'}, '()' . chr(39) . ' not found')
-};
-package Perlito5::AST::Apply;
-sub Perlito5::AST::Apply::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $ns) = '');
- if ($self->{'namespace'}) {
- ($ns = ($self->{'namespace'} . '::'))
- };
- ((my $code) = ($ns . $self->{'code'}));
- for my $e (@{$env}) {
- if (exists($e->{$code})) {
- return (($e->{$code}->($env, @{$self->{'arguments'}})))
- }
- };
- warn('Interpreter runtime error: subroutine ' . chr(39), $code, '()' . chr(39) . ' not found')
-};
-package Perlito5::AST::If;
-sub Perlito5::AST::If::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $cond) = $self->{'cond'});
- if ($cond->eval($env)) {
- ((my $env1) = [{}, @{$env}]);
- for my $stmt (@{($self->{'body'})->stmts()}) {
- $stmt->eval($env1)
- }
- }
- else {
- ((my $env1) = [{}, @{$env}]);
- for my $stmt (@{($self->{'otherwise'})->stmts()}) {
- $stmt->eval($env1)
- }
- };
- return (undef())
-};
-package Perlito5::AST::For;
-sub Perlito5::AST::For::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $cond) = $self->{'cond'});
- ((my $topic_name) = $self->{'body'}->sig()->plain_name());
- ((my $env1) = [{}, @{$env}]);
- for my $topic (@{$cond->eval($env)}) {
- ($env1->[0] = {$topic_name, $topic});
- for my $stmt (@{($self->{'body'})->stmts()}) {
- $stmt->eval($env1)
- }
- };
- return (undef())
-};
-package When;
-sub When::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- die('TODO - When')
-};
-package Perlito5::AST::While;
-sub Perlito5::AST::While::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- die('TODO - Perlito5::AST::While')
-};
-package Perlito5::AST::Decl;
-sub Perlito5::AST::Decl::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $decl) = $self->{'decl'});
- ((my $name) = $self->{'var'}->plain_name());
- if (!((exists($env->[0])->{$name}))) {
- (($env->[0])->{$name} = undef())
- };
- return (undef())
-};
-package Perlito5::AST::Sub;
-sub Perlito5::AST::Sub::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- (my @param_name);
- ((my $sub) = sub {
- ((my $env) = shift());
- ((my $args) = shift());
- (my %context);
- ((my $n) = 0);
- ($context{'@_'} = $args);
- for my $name (@param_name) {
- ($context{$name} = ($args->[$n])->eval($env));
- ($n = ($n + 1))
- };
- ((my $env1) = [%context, @{$env}]);
- (my $r);
- for my $stmt (@{$self->{'block'}}) {
- ($r = $stmt->eval($env1))
- };
- return ($r)
-});
- if ($self->{'name'}) {
- (($env->[0])->{$self->{'name'}} = $sub)
- };
- return ($sub)
-};
-package Perlito5::AST::Do;
-sub Perlito5::AST::Do::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- ((my $env1) = [{}, @{$env}]);
- for my $stmt (@{$self->{'block'}}) {
- $stmt->eval($env1)
- }
-};
-package Perlito5::AST::Use;
-sub Perlito5::AST::Use::eval {
- ((my $self) = $_[0]);
- ((my $env) = $_[1]);
- warn('Interpreter TODO: Perlito5::AST::Use');
- ('use ' . $self->{'mod'})
-};
-
-1;
View
1,594 lib5/Perlito5/Expression.pm
@@ -1,1594 +0,0 @@
-# Do not edit this file - Generated by Perlito5 9.0
-use v5.10;
-use Perlito5::Perl5::Runtime;
-package main;
-package Perlito5::Expression;
-use Perlito5::Precedence;
-use Perlito5::Grammar::Bareword;
-sub Perlito5::Expression::expand_list {
- ((my $param_list) = shift());
- if (((ref($param_list) eq 'Perlito5::AST::Apply') && ($param_list->code() eq 'list:<,>'))) {
- ((my $args) = []);
- for my $v (@{$param_list->arguments()}) {
- if (defined($v)) {
- push(@{$args}, $v )
- }
- };
- return ($args)
- }
- else {
- if (($param_list eq '*undef*')) {
- return ([])
- }
- else {
- return ([$param_list])
- }
- }
-};
-sub Perlito5::Expression::block_or_hash {
- ((my $o) = shift());
- if (defined($o->sig())) {
- return ($o)
- };
- ((my $stmts) = $o->stmts());
- if ((!((defined($stmts))) || (scalar(@{$stmts}) == 0))) {
- return (Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', []))
- };
- if ((scalar(@{$stmts}) != 1)) {
- return ($o)
- };
- ((my $stmt) = $stmts->[0]);
- if ((ref($stmt) eq 'Perlito5::AST::Var')) {
- return (Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', [$stmt]))
- };
- if ((ref($stmt) ne 'Perlito5::AST::Apply')) {
- return ($o)
- };
- if (($stmt->code() eq 'infix:<=>>')) {
- return (Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', [$stmt]))
- };
- if (($stmt->code() ne 'list:<,>')) {
- return ($o)
- };
- for my $item (@{$stmt->arguments()}) {
- if (((ref($item) eq 'Perlito5::AST::Apply') && ($item->code() eq 'infix:<=>>'))) {
- return (Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', expand_list($stmt)))
- }
- };
- return ($o)
-};
-sub Perlito5::Expression::pop_term {
- ((my $num_stack) = shift());
- ((my $v) = pop(@{$num_stack}));
- if ((ref($v) eq 'ARRAY')) {
- if (($v->[1] eq 'methcall_no_params')) {
- ($v = Perlito5::AST::Call->new('invocant', undef(), 'method', $v->[2], 'arguments', []));
- return ($v)
- };
- if (($v->[1] eq 'funcall_no_params')) {
- ($v = Perlito5::AST::Apply->new('code', $v->[3], 'namespace', $v->[2], 'arguments', [], 'bareword', 1));
- return ($v)
- };
- if (($v->[1] eq 'methcall')) {
- ((my $param_list) = expand_list(($v->[3])->{'exp'}));
- ($v = Perlito5::AST::Call->new('invocant', undef(), 'method', $v->[2], 'arguments', $param_list));
- return ($v)
- };
- if (($v->[1] eq 'funcall')) {
- ((my $param_list) = expand_list(($v->[4])->{'exp'}));
- ($v = Perlito5::AST::Apply->new('code', $v->[3], 'arguments', $param_list, 'namespace', $v->[2]));
- return ($v)
- };
- if (($v->[1] eq '( )')) {
- ((my $param_list) = expand_list($v->[2]));
- ($v = Perlito5::AST::Apply->new('code', 'circumfix:<( )>', 'arguments', $param_list, 'namespace', ''));
- return ($v)
- };
- if (($v->[1] eq '[ ]')) {
- ((my $param_list) = expand_list($v->[2]));
- ($v = Perlito5::AST::Apply->new('code', 'circumfix:<[ ]>', 'arguments', $param_list, 'namespace', ''));
- return ($v)
- };
- if (($v->[1] eq 'block')) {
- ($v = Perlito5::AST::Lit::Block->new('stmts', $v->[2], 'sig', $v->[3]));
- ($v = block_or_hash($v));
- return ($v)
- };
- if (($v->[1] eq '.( )')) {
- ($v = Perlito5::AST::Call->new('invocant', undef(), 'method', 'postcircumfix:<( )>', 'arguments', $v->[2]));
- return ($v)
- };
- if (($v->[1] eq '.[ ]')) {
- ($v = Perlito5::AST::Index->new('obj', undef(), 'index_exp', $v->[2]));
- return ($v)
- };
- if (($v->[1] eq '.{ }')) {
- ($v = Perlito5::AST::Lookup->new('obj', undef(), 'index_exp', $v->[2]));
- return ($v)
- };
- if (((ref($v->[1]) eq 'ARRAY') && (scalar($v->[1]) == 2))) {
- ($v = Perlito5::AST::Apply->new('code', 'pair', 'arguments', $v->[1], 'namespace', ''));
- return ($v)
- };
- return ($v->[1])
- };
- return ($v)
-};
-sub Perlito5::Expression::reduce_postfix {
- ((my $op) = shift());
- ((my $value) = shift());
- ((my $v) = $op);
- if (($v->[1] eq 'methcall_no_params')) {
- ($v = Perlito5::AST::Call->new('invocant', $value, 'method', $v->[2], 'arguments', []));
- return ($v)
- };
- if (($v->[1] eq 'funcall_no_params')) {
- die('unexpected function call')
- };
- if (($v->[1] eq 'methcall')) {
- ((my $param_list) = expand_list($v->[3]->{'exp'}));
- ($v = Perlito5::AST::Call->new('invocant', $value, 'method', $v->[2], 'arguments', $param_list));
- return ($v)
- };
- if (($v->[1] eq 'funcall')) {
- die('unexpected function call')
- };
- if (($v->[1] eq '( )')) {
- ((my $param_list) = expand_list($v->[2]));
- if (((ref($value) eq 'Perlito5::AST::Apply') && !((defined($value->arguments()))))) {
- ($value->{'arguments'} = $param_list);
- return ($value)
- };
- if (((ref($value) eq 'Perlito5::AST::Call') && !((defined($value->arguments()))))) {
- ($value->{'arguments'} = $param_list);
- return ($value)
- };
- ($v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<( )>', 'arguments', $param_list));
- return ($v)
- };
- if (($v->[1] eq '[ ]')) {
- ($v = Perlito5::AST::Index->new('obj', $value, 'index_exp', $v->[2]));
- return ($v)
- };
- if (($v->[1] eq 'block')) {
- ($v = Perlito5::AST::Lookup->new('obj', $value, 'index_exp', ($v->[2])->[0]));
- return ($v)
- };
- if (($v->[1] eq '.( )')) {
- ((my $param_list) = expand_list($v->[2]));
- ($v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<( )>', 'arguments', $param_list));
- return ($v)
- };
- if (($v->[1] eq '.[ ]')) {
- ($v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<[ ]>', 'arguments', $v->[2]));
- return ($v)
- };
- if (($v->[1] eq '.{ }')) {
- ($v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<{ }>', 'arguments', $v->[2]));
- return ($v)
- };
- push(@{$op}, $value );
- return ($op)
-};
-((my $reduce_to_ast) = sub {
- ((my $op_stack) = shift());
- ((my $num_stack) = shift());
- ((my $last_op) = shift(@{$op_stack}));
- if (($last_op->[0] eq 'prefix')) {
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('prefix:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack)]) )
- }
- else {
- if (($last_op->[0] eq 'postfix')) {
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('postfix:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack)]) )
- }
- else {
- if (($last_op->[0] eq 'postfix_or_term')) {
- push(@{$num_stack}, reduce_postfix($last_op, pop_term($num_stack)) )
- }
- else {
- if (Perlito5::Precedence::is_assoc_type('list', $last_op->[1])) {
- (my $arg);
- if ((scalar(@{$num_stack}) < 2)) {
- ((my $v2) = pop_term($num_stack));
- if (((ref($v2) eq 'Perlito5::AST::Apply') && ($v2->code() eq (('list:<' . $last_op->[1] . '>'))))) {
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', $v2->namespace(), 'code', $v2->code(), 'arguments', [@{$v2->arguments()}, undef()]) )
- }
- else {
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('list:<' . $last_op->[1] . '>'), 'arguments', [$v2, undef()]) )
- };
- return ()
- }
- else {
- ((my $v2) = pop_term($num_stack));
- ($arg = [pop_term($num_stack), $v2])
- };
- if ((((ref($arg->[0]) eq 'Perlito5::AST::Apply') && ($last_op->[0] eq 'infix')) && (($arg->[0]->code() eq ('list:<' . $last_op->[1] . '>'))))) {
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ($arg->[0])->code(), 'arguments', [@{($arg->[0])->arguments()}, $arg->[1]]) );
- return ()
- };
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('list:<' . $last_op->[1] . '>'), 'arguments', $arg) )
- }
- else {
- if (Perlito5::Precedence::is_assoc_type('chain', $last_op->[1])) {
- if ((scalar(@{$num_stack}) < 2)) {
- die(('Missing value after operator ' . $last_op->[1]))
- };
- ((my $v2) = pop_term($num_stack));
- ((my $arg) = [pop_term($num_stack), $v2]);
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('infix:<' . $last_op->[1] . '>'), 'arguments', $arg) )
- }
- else {
- if (($last_op->[0] eq 'ternary')) {
- if ((scalar(@{$num_stack}) < 2)) {
- die('Missing value after ternary operator')
- };
- ((my $v2) = pop_term($num_stack));
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('ternary:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack), $last_op->[2], $v2]) )
- }
- else {
- if ((scalar(@{$num_stack}) < 2)) {
- die(('missing value after operator ' . chr(39) . $last_op->[1] . chr(39)))
- };
- ((my $v2) = pop_term($num_stack));
- push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('infix:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack), $v2]) )
- }
- }
- }
- }
- }
- }
-});
-sub Perlito5::Expression::term_arrow {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- ((((('->' eq substr($str, $MATCH->{'to'}, 2)) && (($MATCH->{'to'} = (2 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $pos1) = $MATCH->{'to'});
- ((((((do {
- (((((('(' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->paren_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'paren_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', '.( )', Perlito5::Match::flat($MATCH->{'paren_parse'})]);
- 1
-})))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- ((((((('[' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->square_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'square_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && (((']' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', '.[ ]', Perlito5::Match::flat($MATCH->{'square_parse'})]);
- 1
-}))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- ((((((('{' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->curly_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'curly_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', '.{ }', Perlito5::Match::flat($MATCH->{'curly_parse'})]);
- 1
-}))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- ((((((('$' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar->ident($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.ident'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $pos1) = $MATCH->{'to'});
- (((do {
- (((((('(' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->paren_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'paren_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', 'methcall', Perlito5::AST::Var->new('sigil', '$', 'namespace', '', 'name', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.ident'})), {'exp', Perlito5::Match::flat($MATCH->{'paren_parse'}), 'terminated', 0}]);
- 1
-})))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((do {
- ($MATCH->{'capture'} = ['postfix_or_term', 'methcall_no_params', Perlito5::AST::Var->new('sigil', '$', 'namespace', '', 'name', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.ident'}))]);
- 1
-})))
-})))
-}))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((((do {
- ((my $m2) = Perlito5::Grammar->full_ident($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.full_ident'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $pos1) = $MATCH->{'to'});
- (((do {
- (((((('(' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->paren_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'paren_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', 'methcall', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'}), {'exp', Perlito5::Match::flat($MATCH->{'paren_parse'}), 'terminated', 0}]);
- 1
-})))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((do {
- ($MATCH->{'capture'} = ['postfix_or_term', 'methcall_no_params', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'})]);
- 1
-})))
-})))
-}))))
-})))
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-((my %special_var) = ('$_', 1, '$&', 1, '$`', 1, '$' . chr(39), 1, '$+', 1, '@+', 1, '%+', 1, '$.', 1, '$/', 1, '$|', 1, '$,', 1, '$' . chr(92), 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));
-sub Perlito5::Expression::term_special_var {
- ((my $self) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $len) = 0);
- ((my $s) = substr($str, $pos, 3));
- if (($s eq '$#[')) {
- ($len = 2)
- }
- else {
- if (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'))))))) {
-
- }
- 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)
-};
-sub Perlito5::Expression::var_sigil_or_pseudo {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- (((((((do {
- (('$#' eq substr($str, $MATCH->{'to'}, 2)) && (($MATCH->{'to'} = (2 + $MATCH->{'to'}))))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('$' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('%' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('@' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('&' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('*' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))))
-})))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_sigil {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- (((do {
- ((((do {
- ((my $m2) = $grammar->var_sigil_or_pseudo($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'var_sigil_or_pseudo'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $pos1) = $MATCH->{'to'});
- ((((do {
- ((((('{' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $pos1) = $MATCH->{'to'});
- ((((do {
- (((((((do {
- ((my $m2) = Perlito5::Grammar->optional_namespace_before_ident($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.optional_namespace_before_ident'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ((my $m2) = Perlito5::Grammar->var_name($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.var_name'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($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'})));
- ($MATCH = Perlito5::Grammar::String->double_quoted_var_with_subscript($MATCH));
- ($MATCH->{'capture'} = ['term', $MATCH->{'capture'}]);
-;
- 1
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- ((((((('^' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar->var_name($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.var_name'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($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'})))]);
- 1
-}))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((((do {
- ((my $m2) = $grammar->curly_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'curly_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::AST::Apply->new('arguments', [Perlito5::Match::flat($MATCH->{'curly_parse'})], 'code', ('prefix:<' . Perlito5::Match::flat($MATCH->{'var_sigil_or_pseudo'}) . '>'), 'namespace', '')]);
- 1
-}))))
-})))
-})))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((((('^' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar->word($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.word'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($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'})))]);
- 1
-}))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((((do {
- ((my $m2) = Perlito5::Grammar->optional_namespace_before_ident($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.optional_namespace_before_ident'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ((my $m2) = Perlito5::Grammar->var_name($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.var_name'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($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'}))]);
- 1
-}))))
-})))
-})))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- ((((do {
- ((my $m2) = $grammar->term_special_var($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'term_special_var'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ($MATCH->{'capture'} = $MATCH->{'term_special_var'}->{'capture'});
- 1
-}))))
-})))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_digit {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- (((do {
- (((do {
- ((my $m2) = Perlito5::Grammar->val_num($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.val_num'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.val_num'})]);
- 1
-})))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- ((((do {
- ((my $m2) = Perlito5::Grammar->val_int($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.val_int'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.val_int'})]);
- 1
-}))))
-})))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_ternary {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((('?' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->ternary5_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'ternary5_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && (((':' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['op', '? :', Perlito5::Match::flat($MATCH->{'ternary5_parse'})]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_paren {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((('(' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->paren_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'paren_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', '( )', Perlito5::Match::flat($MATCH->{'paren_parse'})]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_square {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((('[' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = $grammar->square_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'square_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && (((']' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', '[ ]', Perlito5::Match::flat($MATCH->{'square_parse'})]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_curly {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((((('{' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
- ((my $m) = $MATCH);
- if (!(((do {
- ((my $m2) = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-})))) {
- ($MATCH = $m)
- };
- 1
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar->exp_stmts($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.exp_stmts'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m) = $MATCH);
- if (!(((do {
- ((my $m2) = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-})))) {
- ($MATCH = $m)
- };
- 1
-}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'})))))) && ((do {
- ($MATCH->{'capture'} = ['postfix_or_term', 'block', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.exp_stmts'})]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::declarator {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- (((((do {
- (('my' eq substr($str, $MATCH->{'to'}, 2)) && (($MATCH->{'to'} = (2 + $MATCH->{'to'}))))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('state' eq substr($str, $MATCH->{'to'}, 5)) && (($MATCH->{'to'} = (5 + $MATCH->{'to'}))))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('our' eq substr($str, $MATCH->{'to'}, 3)) && (($MATCH->{'to'} = (3 + $MATCH->{'to'}))))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('local' eq substr($str, $MATCH->{'to'}, 5)) && (($MATCH->{'to'} = (5 + $MATCH->{'to'}))))))
-})))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_declarator {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((((do {
- ((my $m2) = $grammar->declarator($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'declarator'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar->opt_type($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.opt_type'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar->var_ident($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.var_ident'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::AST::Decl->new('decl', Perlito5::Match::flat($MATCH->{'declarator'}), 'type', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.opt_type'}), 'var', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.var_ident'}))]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_return {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((('return' eq substr($str, $MATCH->{'to'}, 6)) && (($MATCH->{'to'} = (6 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = $grammar->list_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'list_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $args) = Perlito5::Match::flat($MATCH->{'list_parse'})->{'exp'});
- ($MATCH->{'capture'} = ['term', Perlito5::AST::Apply->new('code', 'return', 'arguments', (($args eq '*undef*') ? [] : [$args]), 'namespace', '')]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_anon_sub {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((('sub' eq substr($str, $MATCH->{'to'}, 3)) && (($MATCH->{'to'} = (3 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar->anon_sub_def($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.anon_sub_def'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.anon_sub_def'})]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_do {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- ((((((('do' eq substr($str, $MATCH->{'to'}, 2)) && (($MATCH->{'to'} = (2 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $tmp) = $MATCH);
- ($MATCH = {'str', $str, 'from', $tmp->{'to'}, 'to', $tmp->{'to'}});
- ((my $res) = ((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (('{' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))
-}))
-})));
- ($MATCH = ($res ? $tmp : 0))
-}))) && ((do {
- ((my $m2) = $grammar->statement_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'statement_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::AST::Do->new('block', Perlito5::Match::flat($MATCH->{'statement_parse'}))]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_package {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((('package' eq substr($str, $MATCH->{'to'}, 7)) && (($MATCH->{'to'} = (7 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = Perlito5::Grammar->full_ident($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'Perlito5::Grammar.full_ident'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $name) = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'}));
- ($Perlito5::PKG_NAME = $name);
- ($MATCH->{'capture'} = ['term', Perlito5::AST::Apply->new('code', 'package', 'arguments', [], 'namespace', $name)]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_eval {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- ((((((('eval' eq substr($str, $MATCH->{'to'}, 4)) && (($MATCH->{'to'} = (4 + $MATCH->{'to'}))))) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $tmp) = $MATCH);
- ($MATCH = {'str', $str, 'from', $tmp->{'to'}, 'to', $tmp->{'to'}});
- ((my $res) = ((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (('{' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))
-}))
-})));
- ($MATCH = ($res ? $tmp : 0))
-}))) && ((do {
- ((my $m2) = $grammar->term_curly($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'term_curly'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::AST::Apply->new('code', 'eval', 'arguments', [Perlito5::AST::Do->new('block', Perlito5::AST::Lit::Block->new('stmts', Perlito5::Match::flat($MATCH->{'term_curly'})->[2]))], 'namespace', '')]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::map_or_sort {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((((do {
- (('map' eq substr($str, $MATCH->{'to'}, 3)) && (($MATCH->{'to'} = (3 + $MATCH->{'to'}))))
-})) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('sort' eq substr($str, $MATCH->{'to'}, 4)) && (($MATCH->{'to'} = (4 + $MATCH->{'to'}))))))
-}))) || ((do {
- ($MATCH->{'to'} = $pos1);
- (((('grep' eq substr($str, $MATCH->{'to'}, 4)) && (($MATCH->{'to'} = (4 + $MATCH->{'to'}))))))
-})))
-}))));
- ($tmp ? $MATCH : 0)
-};
-sub Perlito5::Expression::term_map_or_sort {
- ((my $grammar) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $MATCH) = {'str', $str, 'from', $pos, 'to', $pos});
- ((my $tmp) = (((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (((((((do {
- ((my $m2) = $grammar->map_or_sort($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'map_or_sort'} = $m2);
- 1
- }
- else {
- 0
- }
-})) && ((do {
- ((my $m2) = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $tmp) = $MATCH);
- ($MATCH = {'str', $str, 'from', $tmp->{'to'}, 'to', $tmp->{'to'}});
- ((my $res) = ((do {
- ((my $pos1) = $MATCH->{'to'});
- ((do {
- (('{' eq substr($str, $MATCH->{'to'}, 1)) && (($MATCH->{'to'} = (1 + $MATCH->{'to'}))))
-}))
-})));
- ($MATCH = ($res ? $tmp : 0))
-}))) && ((do {
- ((my $m2) = $grammar->term_curly($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'term_curly'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ((my $m2) = $grammar->list_parse($str, $MATCH->{'to'}));
- if ($m2) {
- ($MATCH->{'to'} = $m2->{'to'});
- ($MATCH->{'list_parse'} = $m2);
- 1
- }
- else {
- 0
- }
-}))) && ((do {
- ($MATCH->{'capture'} = ['term', Perlito5::AST::Apply->new('code', Perlito5::Match::flat($MATCH->{'map_or_sort'}), 'arguments', [Perlito5::AST::Lit::Block->new('stmts', $MATCH->{'term_curly'}->{'capture'}->[2]), @{expand_list($MATCH->{'list_parse'}->{'capture'}->{'exp'})}], 'namespace', '')]);
- 1
-})))
-}))
-}))));
- ($tmp ? $MATCH : 0)
-};
-((my $Argument_end_token) = {':', 1, ']', 1, ')', 1, '}', 1, ';', 1, ',', 1, '<', 1, '>', 1, '=', 1, '&', 1, '|', 1, '^', 1, '?', 1, 'or', 1, 'if', 1, '=>', 1, 'lt', 1, 'le', 1, 'gt', 1, 'ge', 1, '<=', 1, '>=', 1, '==', 1, '!=', 1, 'ne', 1, 'eq', 1, '..', 1, '~~', 1, '&&', 1, '||', 1, '+=', 1, '-=', 1, '*=', 1, '/=', 1, 'x=', 1, '|=', 1, '&=', 1, '.=', 1, '^=', 1, '%=', 1, '//', 1, 'for', 1, 'and', 1, 'xor', 1, '...', 1, '<=>', 1, 'cmp', 1, '<<=', 1, '>>=', 1, '||=', 1, '&&=', 1, '//=', 1, '**=', 1, 'when', 1, 'while', 1, 'unless', 1, 'foreach', 1});
-((my $Argument_end_token_chars) = [7, 6, 5, 4, 3, 2, 1]);
-((my $List_end_token) = {':', 1, ']', 1, ')', 1, '}', 1, ';', 1, 'or', 1, 'if', 1, 'for', 1, 'and', 1, 'xor', 1, 'else', 1, 'when', 1, 'while', 1, 'elsif', 1, 'unless', 1, 'foreach', 1});
-((my $List_end_token_chars) = [7, 6, 5, 4, 3, 2, 1]);
-((my $Expr_end_token) = {']', 1, ')', 1, '}', 1, ';', 1, 'if', 1, 'for', 1, 'else', 1, 'when', 1, 'while', 1, 'elsif', 1, 'unless', 1, 'foreach', 1});
-((my $Expr_end_token_chars) = [7, 6, 5, 4, 3, 2, 1]);
-sub Perlito5::Expression::op_parse_spc {
- ((my $self) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- ((my $last_is_term) = $_[3]);
- ((my $m) = Perlito5::Precedence->op_parse($str, $pos, $last_is_term));
- if (!($m)) {
- return ($m)
- };
- ((my $spc) = Perlito5::Grammar::Space->ws($str, $m->{'to'}));
- if ($spc) {
- ($m->{'to'} = $spc->{'to'})
- };
- return ($m)
-};
-sub Perlito5::Expression::argument_parse {
- ((my $self) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- (my $expr);
- ((my $last_pos) = $pos);
- ((my $is_first_token) = 1);
- ((my $lexer_stack) = []);
- ((my $terminated) = 0);
- ((my $last_token_was_space) = 1);
- ((my $get_token) = sub {
- ((my $last_is_term) = $_[0]);
- (my $v);
- if (scalar(@{$lexer_stack})) {
- ($v = pop(@{$lexer_stack}));
- if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Precedence::is_fixity_type('prefix', $v->[1]))))) {
- ($v->[0] = 'end')
- }
- }
- else {
- ((my $m) = Perlito5::Expression->op_parse_spc($str, $last_pos, $last_is_term));
- if (!($m)) {
- return (['end', '*end*'])
- };
- ($v = $m->{'capture'});
- if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Precedence::is_fixity_type('prefix', $v->[1]))))) {
- ($v->[0] = 'end')
- };
- if (($v->[0] ne 'end')) {
- ($last_pos = $m->{'to'})
- }
- };
- ($last_token_was_space = (($v->[0] eq 'space')));
- ($is_first_token = 0);
- return ($v)
-});
- ((my $prec) = Perlito5::Precedence->new('get_token', $get_token, 'reduce', $reduce_to_ast, 'end_token', $Argument_end_token, 'end_token_chars', $Argument_end_token_chars));
- ((my $res) = $prec->precedence_parse());
- if ((scalar(@{$res}) == 0)) {
- return ({'str', $str, 'from', $pos, 'to', $last_pos, 'capture', {'exp', '*undef*', 'terminated', undef()}})
- };
- ((my $result) = pop_term($res));
- return ({'str', $str, 'from', $pos, 'to', $last_pos, 'capture', {'exp', $result, 'terminated', $terminated}})
-};
-sub Perlito5::Expression::list_parse {
- ((my $self) = $_[0]);
- ((my $str) = $_[1]);
- ((my $pos) = $_[2]);
- (my $expr);
- ((my $last_pos) = $pos);
- ((my $is_first_token) = 1);
- ((my $lexer_stack) = []);
- ((my $terminated) = 0);
- ((my $last_token_was_space) = 1);
- ((my $get_token) = sub {
- ((my $last_is_term) = $_[0]);
- (my $v);
- if (scalar(@{$lexer_stack})) {
- ($v = pop(@{$lexer_stack}));
- if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Precedence::is_fixity_type('prefix', $v->[1]))))) {
- ($v->[0] = 'end')
- }
- }
- else {
- ((my $m) = Perlito5::Expression->op_parse_spc($str, $last_pos, $last_is_term));
- if (!($m)) {
- return (['end', '*end*'])
- };
- ($v = $m->{'capture'});
- if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Precedence::is_fixity_type('prefix', $v->[1]))))) {
- ($v->[0] = 'end')
- };
- if (($v->[0] ne 'end')) {
- ($last_pos = $m->{'to'})
- }
- };
- ($last_token_was_space = (($v->[0] eq 'space')));
- ($is_first_token = 0);
- return ($v)
-});
- ((my $prec) = Perlito5::Precedence->new('get_token', $get_token, 'reduce', $reduce_to_ast, 'end_token', $List_end_token, 'end_token_chars', $List_end_token_chars