Skip to content
Browse files

Perlito5 - parser - fix eval-string signature; caret-var fix; 3 more …

…lex.t tests pass
  • Loading branch information...
1 parent bd4c687 commit 5879509ec67735d1b577dabcfe4b930ba576f6fa @fglock committed Nov 28, 2012
Showing with 182 additions and 117 deletions.
  1. +60 −34 html/perlito5.js
  2. +40 −21 perlito5.pl
  3. +21 −0 src5/lib/Perlito5/Grammar.pm
  4. +37 −41 src5/lib/Perlito5/Grammar/Sigil.pm
  5. +4 −1 src5/lib/Perlito5/Precedence.pm
  6. +1 −1 src5/lib/Perlito5/Runtime.pm
  7. +19 −19 t5/base/lex.t
View
94 html/perlito5.js
@@ -4794,7 +4794,7 @@ var p5100 = p5pkg['main'];
(v_c1 = (p5pkg["Perlito5::Precedence"].substr([v_str, ((p5num(v_pos) + p5pkg["Perlito5::Precedence"].length([v_term], 0)) - 1), 1], 0)));
var v_c2;
(v_c2 = (p5pkg["Perlito5::Precedence"].substr([v_str, (p5num(v_pos) + p5pkg["Perlito5::Precedence"].length([v_term], 0)), 1], 0)));
- if ( !( (p5bool(p5pkg["Perlito5::Precedence"].is_ident_middle([v_c1], 0)) && p5bool(p5pkg["Perlito5::Precedence"].is_ident_middle([v_c2], 0)))) ) {
+ if ( (!( (p5bool(p5pkg["Perlito5::Precedence"].is_ident_middle([v_c1], 0)) && p5bool(p5pkg["Perlito5::Precedence"].is_ident_middle([v_c2], 0)))) && !( ((p5str(v_c1) == '<') && (p5str(v_c2) == '<')))) ) {
throw((new p5HashRef(p5a_to_h(p5list_to_a('str', v_str, 'from', v_pos, 'to', v_pos, 'capture', (new p5ArrayRef(['end', v_term])))))));
};
})();
@@ -10020,25 +10020,25 @@ var p5100 = p5pkg['main'];
};
})();
};
- if ( (p5pkg["Perlito5::Grammar::Sigil"].substr([v_str, v_p, 1], 0) == '^') ) {
- (v_m = (p5call(p5pkg["Perlito5::Grammar"], "var_name", [v_str, (p5num(v_p) + 1)], 0)));
- if ( p5bool(v_m) ) {
- (function () {
- var v_p;
+ var v_caret;
+ (v_caret = (p5call(p5pkg["Perlito5::Grammar"], "caret_char", [v_str, v_p], 0)));
+ if ( p5bool(v_caret) ) {
+ (function () {
+ var v_p;
+ (v_p = ((v_caret || (v_caret = new p5HashRef({})))._hash_.p5hget('to')));
+ var v_name;
+ (v_name = (p5pkg["Perlito5::Match"].flat([v_caret], 0)));
+ (v_m = (p5call(p5pkg["Perlito5::Grammar"], "var_name", [v_str, v_p], 0)));
+ if ( p5bool(v_m) ) {
+ (v_name = ((p5str(v_name) + p5str(p5pkg["Perlito5::Match"].flat([v_m], 0)))));
(v_p = ((v_m || (v_m = new p5HashRef({})))._hash_.p5hget('to')));
- if ( (p5pkg["Perlito5::Grammar::Sigil"].substr([v_str, v_p, 1], 0) == '}') ) {
- (function () {
- var v_name;
- (v_name = (p5pkg["Perlito5::Match"].flat([v_m], 0)));
- var v_c1;
- (v_c1 = (p5pkg["Perlito5::Grammar::Sigil"].chr([((p5pkg["Perlito5::Grammar::Sigil"].ord([p5pkg["Perlito5::Grammar::Sigil"].substr([v_name, 0, 1], 0)], 0) - p5pkg["Perlito5::Grammar::Sigil"].ord(['A'], 0)) + 1)], 0)));
- (v_m || (v_m = new p5HashRef({})))._hash_.p5hset('capture', ((new p5ArrayRef(p5list_to_a('term', p5call(p5pkg["Perlito5::AST::Apply"], "new", p5list_to_a('arguments', (new p5ArrayRef(p5list_to_a(p5call(p5pkg["Perlito5::AST::Val::Buf"], "new", ['buf', (p5str(v_c1) + p5pkg["Perlito5::Grammar::Sigil"].substr([v_name, 1], 0))], 1)))), 'code', ('prefix:<' + p5str(v_sigil) + '>'), 'namespace', ''), 1))))));
- (v_m || (v_m = new p5HashRef({})))._hash_.p5hset('to', ((p5num((v_m || (v_m = new p5HashRef({})))._hash_.p5hget('to')) + 1)));
- throw(p5context([v_m], p5want));
- })();
- };
- })();
- };
+ };
+ if ( (p5pkg["Perlito5::Grammar::Sigil"].substr([v_str, v_p, 1], 0) == '}') ) {
+ (v_caret || (v_caret = new p5HashRef({})))._hash_.p5hset('capture', ((new p5ArrayRef(p5list_to_a('term', p5call(p5pkg["Perlito5::AST::Apply"], "new", p5list_to_a('arguments', (new p5ArrayRef(p5list_to_a(p5call(p5pkg["Perlito5::AST::Val::Buf"], "new", ['buf', v_name], 1)))), 'code', ('prefix:<' + p5str(v_sigil) + '>'), 'namespace', ''), 1))))));
+ (v_caret || (v_caret = new p5HashRef({})))._hash_.p5hset('to', ((p5num(v_p) + 1)));
+ throw(p5context([v_caret], p5want));
+ };
+ })();
};
(v_m = (p5call(p5pkg["Perlito5::Expression"], "curly_parse", [v_str, v_p], 0)));
if ( p5bool(v_m) ) {
@@ -10054,21 +10054,14 @@ var p5100 = p5pkg['main'];
};
})();
};
- if ( (p5str(v_c1) == '^') ) {
+ var v_caret;
+ (v_caret = (p5call(p5pkg["Perlito5::Grammar"], "caret_char", [v_str, v_p], 0)));
+ if ( p5bool(v_caret) ) {
(function () {
- var v_p;
- (v_p = (v_q));
- (v_m = (p5call(p5pkg["Perlito5::Grammar"], "word", [v_str, v_p], 0)));
- if ( p5bool(v_m) ) {
- (function () {
- var v_name;
- (v_name = (p5pkg["Perlito5::Match"].flat([v_m], 0)));
- var v_c1;
- (v_c1 = (p5pkg["Perlito5::Grammar::Sigil"].chr([((p5pkg["Perlito5::Grammar::Sigil"].ord([p5pkg["Perlito5::Grammar::Sigil"].substr([v_name, 0, 1], 0)], 0) - p5pkg["Perlito5::Grammar::Sigil"].ord(['A'], 0)) + 1)], 0)));
- (v_m || (v_m = new p5HashRef({})))._hash_.p5hset('capture', ((new p5ArrayRef(p5list_to_a('term', p5call(p5pkg["Perlito5::AST::Apply"], "new", p5list_to_a('arguments', (new p5ArrayRef(p5list_to_a(p5call(p5pkg["Perlito5::AST::Val::Buf"], "new", ['buf', (p5str(v_c1) + p5pkg["Perlito5::Grammar::Sigil"].substr([v_name, 1], 0))], 1)))), 'code', ('prefix:<' + p5str(v_sigil) + '>'), 'namespace', ''), 1))))));
- throw(p5context([v_m], p5want));
- })();
- };
+ var v_name;
+ (v_name = (p5pkg["Perlito5::Match"].flat([v_caret], 0)));
+ (v_caret || (v_caret = new p5HashRef({})))._hash_.p5hset('capture', ((new p5ArrayRef(p5list_to_a('term', p5call(p5pkg["Perlito5::AST::Apply"], "new", p5list_to_a('arguments', (new p5ArrayRef(p5list_to_a(p5call(p5pkg["Perlito5::AST::Val::Buf"], "new", ['buf', v_name], 1)))), 'code', ('prefix:<' + p5str(v_sigil) + '>'), 'namespace', ''), 1))))));
+ throw(p5context([v_caret], p5want));
})();
};
if ( (p5str(v_c1) == '$') ) {
@@ -11356,6 +11349,39 @@ return r;
}
}
});
+ p5make_sub("Perlito5::Grammar", "caret_char", function (List__, p5want) {
+ try {
+ var v_c;
+ (v_c = (p5pkg["Perlito5::Grammar"].substr([List__.p5aget(1), List__.p5aget(2), 1], 0)));
+ var v_pos;
+ (v_pos = (List__.p5aget(2)));
+ if ( (p5str(v_c) == '^') ) {
+ (v_pos)++;
+ (v_c = (p5pkg["Perlito5::Grammar"].substr([List__.p5aget(1), v_pos, 1], 0)));
+ if ( ((p5str(v_c) < 'A') || (p5str(v_c) > 'Z')) ) {
+ throw(p5context([0], p5want));
+ };
+ (v_c = (p5pkg["Perlito5::Grammar"].chr([((p5pkg["Perlito5::Grammar"].ord([v_c], 0) - p5pkg["Perlito5::Grammar"].ord(['A'], 0)) + 1)], 0)));
+ }
+ else {
+ if ( p5bool(p5call(List__.p5aget(0), "ws", p5list_to_a(List__.p5aget(1), v_pos), 0)) ) {
+ throw(p5context([0], p5want));
+ };
+ };
+ if ( ((p5str(v_c) < String.fromCharCode(1)) || (p5str(v_c) > String.fromCharCode(26))) ) {
+ throw(p5context([0], p5want));
+ };
+ return ((new p5HashRef(p5a_to_h(p5list_to_a('str', List__.p5aget(1), 'from', List__.p5aget(2), 'to', (p5num(v_pos) + 1), 'capture', v_c)))));
+ }
+ catch(err) {
+ if ( err instanceof Error ) {
+ throw(err);
+ }
+ else {
+ return(err);
+ }
+ }
+ });
p5make_sub("Perlito5::Grammar", "full_ident", function (List__, p5want) {
var v_grammar;
(v_grammar = (List__.p5aget(0)));
@@ -13032,7 +13058,7 @@ return r;
}, p5list_to_a(p5pkg["Perlito5::Runtime"].split(p5list_to_a(':', p5or(p5pkg["main"]["Hash_ENV"].p5hget('PERL5LIB'), function () { return '' })), 1)), false, "");
(p5pkg["Perlito5"]["v_SPECIAL_VAR"] = ((new p5HashRef(p5a_to_h(p5list_to_a('$_', 'ARG', '$&', '$MATCH', '$`', '$PREMATCH', '$' + String.fromCharCode(39), '$POSTMATCH', '$+', '$LAST_PAREN_MATCH', '@+', '@LAST_MATCH_END', '%+', '%LAST_PAREN_MATCH', '@-', '@LAST_MATCH_START', '$|', 'autoflush', '$/', '$RS', '@_', '@ARG', '< $', '$EUID', '$.', '$NR', '< $< ', '$UID', '$(', '$GID', '$#', null, '$@', '$EVAL_ERROR', '$=', '$FORMAT_LINES_PER_PAGE', '$,', '$OFS', '$?', '$CHILD_ERROR', '$*', null, '$[', null, '$$', '$PID', '%-', null, '$~', '$FORMAT_NAME', '$-', '$FORMAT_LINES_LEFT', '$&', '$MATCH', '$%', '$FORMAT_PAGE_NUMBER', '$)', '$EGID', '$]', null, '$!', '$ERRNO', '$;', '$SUBSEP', '$' + String.fromCharCode(92), '$ORS', '%!', null, '$"', '$LIST_SEPARATOR', '$_', '$ARG', '$:', 'FORMAT_LINE_BREAK_CHARACTERS'))))));
(p5pkg["Perlito5"]["v_CORE_OVERRIDABLE"] = ((new p5HashRef({'say' : 1, 'break' : 1, 'given' : 1, 'when' : 1, 'default' : 1, 'state' : 1, 'lock' : 1}))));
- (p5pkg["Perlito5"]["v_CORE_PROTO"] = ((new p5HashRef(p5a_to_h(p5list_to_a('CORE::shutdown', '*$', 'CORE::chop', null, 'CORE::lstat', '*', 'CORE::rename', '$$', 'CORE::lock', String.fromCharCode(92) + '$', 'CORE::rand', ';$', 'CORE::gmtime', ';$', 'CORE::gethostbyname', '$', 'CORE::each', String.fromCharCode(92) + '[@%]', 'CORE::ref', '_', 'CORE::syswrite', '*$;$$', 'CORE::msgctl', '$$$', 'CORE::getnetbyname', '$', 'CORE::write', ';*', 'CORE::alarm', '_', 'CORE::print', null, 'CORE::getnetent', '', 'CORE::semget', '$$$', 'CORE::use', null, 'CORE::abs', '_', 'CORE::break', '', 'CORE::undef', null, 'CORE::no', null, 'CORE::eval', null, 'CORE::split', null, 'CORE::localtime', ';$', 'CORE::sort', null, 'CORE::chown', '@', 'CORE::endpwent', '', 'CORE::getpwent', '', 'CORE::pos', null, 'CORE::lcfirst', '_', 'CORE::kill', '@', 'CORE::send', '*$$;$', 'CORE::endprotoent', '', 'CORE::semctl', '$$$$', 'CORE::waitpid', '$$', 'CORE::utime', '@', 'CORE::dbmclose', String.fromCharCode(92) + '%', 'CORE::getpwnam', '$', 'CORE::substr', '$$;$$', 'CORE::listen', '*$', 'CORE::getprotoent', '', 'CORE::shmget', '$$$', 'CORE::our', null, 'CORE::readlink', '_', 'CORE::shmwrite', '$$$$', 'CORE::times', '', 'CORE::package', null, 'CORE::map', null, 'CORE::join', '$@', 'CORE::rmdir', '_', 'CORE::shmread', '$$$$', 'CORE::uc', '_', 'CORE::bless', '$;$', 'CORE::closedir', '*', 'CORE::getppid', '', 'CORE::tie', String.fromCharCode(92) + '[$@%]$;@', 'CORE::readdir', '*', 'CORE::gethostent', '', 'CORE::getlogin', '', 'CORE::last', null, 'CORE::gethostbyaddr', '$$', 'CORE::accept', '**', 'CORE::log', '_', 'CORE::tell', ';*', 'CORE::readline', ';*', 'CORE::tied', null, 'CORE::socket', '*$$$', 'CORE::umask', ';$', 'CORE::sysread', '*' + String.fromCharCode(92) + '$$;$', 'CORE::syscall', '$@', 'CORE::quotemeta', '_', 'CORE::dump', '', 'CORE::opendir', '*$', 'CORE::untie', null, 'CORE::truncate', '$$', 'CORE::select', ';*', 'CORE::sleep', ';$', 'CORE::seek', '*$$', 'CORE::read', '*' + String.fromCharCode(92) + '$$;$', 'CORE::rewinddir', '*', 'CORE::scalar', null, 'CORE::wantarray', '', 'CORE::oct', '_', 'CORE::bind', '*$', 'CORE::stat', '*', 'CORE::sqrt', '_', 'CORE::getc', ';*', 'CORE::fileno', '*', 'CORE::getpeername', '*', 'CORE::sin', '_', 'CORE::getnetbyaddr', '$$', 'CORE::grep', null, 'CORE::setservent', '$', 'CORE::sub', null, 'CORE::shmctl', '$$$', 'CORE::study', null, 'CORE::msgrcv', '$$$$$', 'CORE::setsockopt', '*$$$', 'CORE::int', '_', 'CORE::pop', ';' + String.fromCharCode(92) + '@', 'CORE::link', '$$', 'CORE::exec', null, 'CORE::setpwent', '', 'CORE::mkdir', '_;$', 'CORE::sysseek', '*$$', 'CORE::endservent', '', 'CORE::chr', '_', 'CORE::when', null, 'CORE::getpwuid', '$', 'CORE::setprotoent', '$', 'CORE::reverse', '@', 'CORE::say', null, 'CORE::goto', null, 'CORE::getgrent', '', 'CORE::endnetent', '', 'CORE::hex', '_', 'CORE::binmode', '*;$', 'CORE::formline', '$@', 'CORE::getgrnam', '$', 'CORE::ucfirst', '_', 'CORE::chdir', ';$', 'CORE::setnetent', '$', 'CORE::splice', String.fromCharCode(92) + '@;$$@', 'CORE::unlink', '@', 'CORE::time', '', 'CORE::push', String.fromCharCode(92) + '@@', 'CORE::exit', ';$', 'CORE::endgrent', '', 'CORE::unshift', String.fromCharCode(92) + '@@', 'CORE::local', null, 'CORE::my', null, 'CORE::cos', '_', 'CORE::redo', null, 'CORE::warn', '@', 'CORE::getsockname', '*', 'CORE::pipe', '**', 'CORE::sprintf', '$@', 'CORE::open', '*;$@', 'CORE::setpgrp', ';$$', 'CORE::exp', '_', 'CORE::seekdir', '*$', 'CORE::getservbyport', '$$', 'CORE::given', null, 'CORE::pack', '$@', 'CORE::msgget', '$$', 'CORE::rindex', '$$;$', 'CORE::srand', ';$', 'CORE::telldir', '*', 'CORE::connect', '*$', 'CORE::getprotobyname', '$', 'CORE::msgsnd', '$$$', 'CORE::length', '_', 'CORE::state', null, 'CORE::die', '@', 'CORE::delete', null, 'CORE::getservent', '', 'CORE::getservbyname', '$$', 'CORE::setpriority', '$$$', 'CORE::lc', '_', 'CORE::fcntl', '*$$', 'CORE::chroot', '_', 'CORE::recv', '*' + String.fromCharCode(92) + '$$$', 'CORE::dbmopen', String.fromCharCode(92) + '%$$', 'CORE::socketpair', '**$$$', 'CORE::vec', '$$$', 'CORE::system', null, 'CORE::defined', '_', 'CORE::index', '$$;$', 'CORE::caller', ';$', 'CORE::close', ';*', 'CORE::atan2', '$$', 'CORE::semop', '$$', 'CORE::unpack', '$;$', 'CORE::ord', '_', 'CORE::chmod', '@', 'CORE::prototype', null, 'CORE::getprotobynumber', '$', 'CORE::values', String.fromCharCode(92) + '[@%]', 'CORE::chomp', null, 'CORE::ioctl', '*$$', 'CORE::eof', ';*', 'CORE::crypt', '$$', 'CORE::do', null, 'CORE::flock', '*$', 'CORE::wait', '', 'CORE::sethostent', '$', 'CORE::return', null, 'CORE::getsockopt', '*$$', 'CORE::fork', '', 'CORE::require', null, 'CORE::format', null, 'CORE::readpipe', '_', 'CORE::endhostent', '', 'CORE::getpgrp', ';$', 'CORE::setgrent', '', 'CORE::keys', String.fromCharCode(92) + '[@%]', 'CORE::glob', null, 'CORE::getpriority', '$$', 'CORE::reset', ';$', 'CORE::sysopen', '*$$;$', 'CORE::continue', '', 'CORE::next', null, 'CORE::getgrgid', '$', 'CORE::default', null, 'CORE::shift', ';' + String.fromCharCode(92) + '@', 'CORE::symlink', '$$', 'CORE::exists', '$', 'CORE::printf', '$@'))))));
+ (p5pkg["Perlito5"]["v_CORE_PROTO"] = ((new p5HashRef(p5a_to_h(p5list_to_a('CORE::shutdown', '*$', 'CORE::chop', null, 'CORE::lstat', '*', 'CORE::rename', '$$', 'CORE::lock', String.fromCharCode(92) + '$', 'CORE::rand', ';$', 'CORE::gmtime', ';$', 'CORE::gethostbyname', '$', 'CORE::each', String.fromCharCode(92) + '[@%]', 'CORE::ref', '_', 'CORE::syswrite', '*$;$$', 'CORE::msgctl', '$$$', 'CORE::getnetbyname', '$', 'CORE::write', ';*', 'CORE::alarm', '_', 'CORE::print', null, 'CORE::getnetent', '', 'CORE::semget', '$$$', 'CORE::use', null, 'CORE::abs', '_', 'CORE::break', '', 'CORE::undef', null, 'CORE::no', null, 'CORE::eval', '_', 'CORE::split', null, 'CORE::localtime', ';$', 'CORE::sort', null, 'CORE::chown', '@', 'CORE::endpwent', '', 'CORE::getpwent', '', 'CORE::pos', null, 'CORE::lcfirst', '_', 'CORE::kill', '@', 'CORE::send', '*$$;$', 'CORE::endprotoent', '', 'CORE::semctl', '$$$$', 'CORE::waitpid', '$$', 'CORE::utime', '@', 'CORE::dbmclose', String.fromCharCode(92) + '%', 'CORE::getpwnam', '$', 'CORE::substr', '$$;$$', 'CORE::listen', '*$', 'CORE::getprotoent', '', 'CORE::shmget', '$$$', 'CORE::our', null, 'CORE::readlink', '_', 'CORE::shmwrite', '$$$$', 'CORE::times', '', 'CORE::package', null, 'CORE::map', null, 'CORE::join', '$@', 'CORE::rmdir', '_', 'CORE::shmread', '$$$$', 'CORE::uc', '_', 'CORE::bless', '$;$', 'CORE::closedir', '*', 'CORE::getppid', '', 'CORE::tie', String.fromCharCode(92) + '[$@%]$;@', 'CORE::readdir', '*', 'CORE::gethostent', '', 'CORE::getlogin', '', 'CORE::last', null, 'CORE::gethostbyaddr', '$$', 'CORE::accept', '**', 'CORE::log', '_', 'CORE::tell', ';*', 'CORE::readline', ';*', 'CORE::tied', null, 'CORE::socket', '*$$$', 'CORE::umask', ';$', 'CORE::sysread', '*' + String.fromCharCode(92) + '$$;$', 'CORE::syscall', '$@', 'CORE::quotemeta', '_', 'CORE::dump', '', 'CORE::opendir', '*$', 'CORE::untie', null, 'CORE::truncate', '$$', 'CORE::select', ';*', 'CORE::sleep', ';$', 'CORE::seek', '*$$', 'CORE::read', '*' + String.fromCharCode(92) + '$$;$', 'CORE::rewinddir', '*', 'CORE::scalar', null, 'CORE::wantarray', '', 'CORE::oct', '_', 'CORE::bind', '*$', 'CORE::stat', '*', 'CORE::sqrt', '_', 'CORE::getc', ';*', 'CORE::fileno', '*', 'CORE::getpeername', '*', 'CORE::sin', '_', 'CORE::getnetbyaddr', '$$', 'CORE::grep', null, 'CORE::setservent', '$', 'CORE::sub', null, 'CORE::shmctl', '$$$', 'CORE::study', null, 'CORE::msgrcv', '$$$$$', 'CORE::setsockopt', '*$$$', 'CORE::int', '_', 'CORE::pop', ';' + String.fromCharCode(92) + '@', 'CORE::link', '$$', 'CORE::exec', null, 'CORE::setpwent', '', 'CORE::mkdir', '_;$', 'CORE::sysseek', '*$$', 'CORE::endservent', '', 'CORE::chr', '_', 'CORE::when', null, 'CORE::getpwuid', '$', 'CORE::setprotoent', '$', 'CORE::reverse', '@', 'CORE::say', null, 'CORE::goto', null, 'CORE::getgrent', '', 'CORE::endnetent', '', 'CORE::hex', '_', 'CORE::binmode', '*;$', 'CORE::formline', '$@', 'CORE::getgrnam', '$', 'CORE::ucfirst', '_', 'CORE::chdir', ';$', 'CORE::setnetent', '$', 'CORE::splice', String.fromCharCode(92) + '@;$$@', 'CORE::unlink', '@', 'CORE::time', '', 'CORE::push', String.fromCharCode(92) + '@@', 'CORE::exit', ';$', 'CORE::endgrent', '', 'CORE::unshift', String.fromCharCode(92) + '@@', 'CORE::local', null, 'CORE::my', null, 'CORE::cos', '_', 'CORE::redo', null, 'CORE::warn', '@', 'CORE::getsockname', '*', 'CORE::pipe', '**', 'CORE::sprintf', '$@', 'CORE::open', '*;$@', 'CORE::setpgrp', ';$$', 'CORE::exp', '_', 'CORE::seekdir', '*$', 'CORE::getservbyport', '$$', 'CORE::given', null, 'CORE::pack', '$@', 'CORE::msgget', '$$', 'CORE::rindex', '$$;$', 'CORE::srand', ';$', 'CORE::telldir', '*', 'CORE::connect', '*$', 'CORE::getprotobyname', '$', 'CORE::msgsnd', '$$$', 'CORE::length', '_', 'CORE::state', null, 'CORE::die', '@', 'CORE::delete', null, 'CORE::getservent', '', 'CORE::getservbyname', '$$', 'CORE::setpriority', '$$$', 'CORE::lc', '_', 'CORE::fcntl', '*$$', 'CORE::chroot', '_', 'CORE::recv', '*' + String.fromCharCode(92) + '$$$', 'CORE::dbmopen', String.fromCharCode(92) + '%$$', 'CORE::socketpair', '**$$$', 'CORE::vec', '$$$', 'CORE::system', null, 'CORE::defined', '_', 'CORE::index', '$$;$', 'CORE::caller', ';$', 'CORE::close', ';*', 'CORE::atan2', '$$', 'CORE::semop', '$$', 'CORE::unpack', '$;$', 'CORE::ord', '_', 'CORE::chmod', '@', 'CORE::prototype', null, 'CORE::getprotobynumber', '$', 'CORE::values', String.fromCharCode(92) + '[@%]', 'CORE::chomp', null, 'CORE::ioctl', '*$$', 'CORE::eof', ';*', 'CORE::crypt', '$$', 'CORE::do', null, 'CORE::flock', '*$', 'CORE::wait', '', 'CORE::sethostent', '$', 'CORE::return', null, 'CORE::getsockopt', '*$$', 'CORE::fork', '', 'CORE::require', null, 'CORE::format', null, 'CORE::readpipe', '_', 'CORE::endhostent', '', 'CORE::getpgrp', ';$', 'CORE::setgrent', '', 'CORE::keys', String.fromCharCode(92) + '[@%]', 'CORE::glob', null, 'CORE::getpriority', '$$', 'CORE::reset', ';$', 'CORE::sysopen', '*$$;$', 'CORE::continue', '', 'CORE::next', null, 'CORE::getgrgid', '$', 'CORE::default', null, 'CORE::shift', ';' + String.fromCharCode(92) + '@', 'CORE::symlink', '$$', 'CORE::exists', '$', 'CORE::printf', '$@'))))));
1;
})()
;
View
61 perlito5.pl
@@ -380,7 +380,7 @@ sub Perlito5::Precedence::op_parse {
if (exists($End_token->{$term})) {
((my $c1) = substr($str, (($pos + length($term)) - 1), 1));
((my $c2) = substr($str, ($pos + length($term)), 1));
- if (!(((is_ident_middle($c1) && is_ident_middle($c2))))) {
+ if ((!(((is_ident_middle($c1) && is_ident_middle($c2)))) && !(((($c1 eq '<') && ($c2 eq '<')))))) {
return ({'str', $str, 'from', $pos, 'to', $pos, 'capture', ['end', $term]})
}
}
@@ -5314,17 +5314,19 @@ sub Perlito5::Grammar::Sigil::term_sigil {
}
}
};
- if ((substr($str, $p, 1) eq '^')) {
- ($m = Perlito5::Grammar->var_name($str, ($p + 1)));
+ ((my $caret) = Perlito5::Grammar->caret_char($str, $p));
+ if ($caret) {
+ ((my $p) = $caret->{'to'});
+ ((my $name) = Perlito5::Match::flat($caret));
+ ($m = Perlito5::Grammar->var_name($str, $p));
if ($m) {
- ((my $p) = $m->{'to'});
- if ((substr($str, $p, 1) eq '}')) {
- ((my $name) = Perlito5::Match::flat($m));
- ((my $c1) = chr(((ord(substr($name, 0, 1)) - ord('A')) + 1)));
- ($m->{'capture'} = ['term', Perlito5::AST::Apply->new('arguments', [Perlito5::AST::Val::Buf->new('buf', ($c1 . substr($name, 1)))], 'code', ('prefix:<' . $sigil . '>'), 'namespace', '')]);
- ($m->{'to'} = ($m->{'to'} + 1));
- return ($m)
- }
+ ($name = ($name . Perlito5::Match::flat($m)));
+ ($p = $m->{'to'})
+ };
+ if ((substr($str, $p, 1) eq '}')) {
+ ($caret->{'capture'} = ['term', Perlito5::AST::Apply->new('arguments', [Perlito5::AST::Val::Buf->new('buf', $name)], 'code', ('prefix:<' . $sigil . '>'), 'namespace', '')]);
+ ($caret->{'to'} = ($p + 1));
+ return ($caret)
}
};
($m = Perlito5::Expression->curly_parse($str, $p));
@@ -5337,15 +5339,11 @@ sub Perlito5::Grammar::Sigil::term_sigil {
}
}
};
- if (($c1 eq '^')) {
- ((my $p) = $q);
- ($m = Perlito5::Grammar->word($str, $p));
- if ($m) {
- ((my $name) = Perlito5::Match::flat($m));
- ((my $c1) = chr(((ord(substr($name, 0, 1)) - ord('A')) + 1)));
- ($m->{'capture'} = ['term', Perlito5::AST::Apply->new('arguments', [Perlito5::AST::Val::Buf->new('buf', ($c1 . substr($name, 1)))], 'code', ('prefix:<' . $sigil . '>'), 'namespace', '')]);
- return ($m)
- }
+ ((my $caret) = Perlito5::Grammar->caret_char($str, $p));
+ if ($caret) {
+ ((my $name) = Perlito5::Match::flat($caret));
+ ($caret->{'capture'} = ['term', Perlito5::AST::Apply->new('arguments', [Perlito5::AST::Val::Buf->new('buf', $name)], 'code', ('prefix:<' . $sigil . '>'), 'namespace', '')]);
+ return ($caret)
};
if (($c1 eq '$')) {
($m = $self->term_sigil($str, $p));
@@ -6267,6 +6265,27 @@ sub Perlito5::Grammar::ident {
};
$m
};
+sub Perlito5::Grammar::caret_char {
+ ((my $c) = substr($_[1], $_[2], 1));
+ ((my $pos) = $_[2]);
+ if (($c eq '^')) {
+ ($pos)++;
+ ($c = substr($_[1], $pos, 1));
+ if ((($c lt 'A') || ($c gt 'Z'))) {
+ return (0)
+ };
+ ($c = chr(((ord($c) - ord('A')) + 1)))
+ }
+ else {
+ if ($_[0]->ws($_[1], $pos)) {
+ return (0)
+ }
+ };
+ if ((($c lt chr(1)) || ($c gt chr(26)))) {
+ return (0)
+ };
+ return ({'str', $_[1], 'from', $_[2], 'to', ($pos + 1), 'capture', $c})
+};
sub Perlito5::Grammar::full_ident {
((my $grammar) = $_[0]);
((my $str) = $_[1]);
@@ -11950,7 +11969,7 @@ package Perlito5::Runtime;
};
($Perlito5::SPECIAL_VAR = {'$_', 'ARG', '$&', '$MATCH', '$`', '$PREMATCH', '$' . chr(39), '$POSTMATCH', '$+', '$LAST_PAREN_MATCH', '@+', '@LAST_MATCH_END', '%+', '%LAST_PAREN_MATCH', '@-', '@LAST_MATCH_START', '$|', 'autoflush', '$/', '$RS', '@_', '@ARG', '< $', '$EUID', '$.', '$NR', '< $< ', '$UID', '$(', '$GID', '$#', undef(), '$@', '$EVAL_ERROR', '$=', '$FORMAT_LINES_PER_PAGE', '$,', '$OFS', '$?', '$CHILD_ERROR', '$*', undef(), '$[', undef(), '$$', '$PID', '%-', undef(), '$~', '$FORMAT_NAME', '$-', '$FORMAT_LINES_LEFT', '$&', '$MATCH', '$%', '$FORMAT_PAGE_NUMBER', '$)', '$EGID', '$]', undef(), '$!', '$ERRNO', '$;', '$SUBSEP', '$' . chr(92), '$ORS', '%!', undef(), '$"', '$LIST_SEPARATOR', '$_', '$ARG', '$:', 'FORMAT_LINE_BREAK_CHARACTERS'});
($Perlito5::CORE_OVERRIDABLE = {'say', 1, 'break', 1, 'given', 1, 'when', 1, 'default', 1, 'state', 1, 'lock', 1});
-($Perlito5::CORE_PROTO = {'CORE::shutdown', '*$', 'CORE::chop', undef(), 'CORE::lstat', '*', 'CORE::rename', '$$', 'CORE::lock', chr(92) . '$', 'CORE::rand', ';$', 'CORE::gmtime', ';$', 'CORE::gethostbyname', '$', 'CORE::each', chr(92) . '[@%]', 'CORE::ref', '_', 'CORE::syswrite', '*$;$$', 'CORE::msgctl', '$$$', 'CORE::getnetbyname', '$', 'CORE::write', ';*', 'CORE::alarm', '_', 'CORE::print', undef(), 'CORE::getnetent', '', 'CORE::semget', '$$$', 'CORE::use', undef(), 'CORE::abs', '_', 'CORE::break', '', 'CORE::undef', undef(), 'CORE::no', undef(), 'CORE::eval', undef(), 'CORE::split', undef(), 'CORE::localtime', ';$', 'CORE::sort', undef(), 'CORE::chown', '@', 'CORE::endpwent', '', 'CORE::getpwent', '', 'CORE::pos', undef(), 'CORE::lcfirst', '_', 'CORE::kill', '@', 'CORE::send', '*$$;$', 'CORE::endprotoent', '', 'CORE::semctl', '$$$$', 'CORE::waitpid', '$$', 'CORE::utime', '@', 'CORE::dbmclose', chr(92) . '%', 'CORE::getpwnam', '$', 'CORE::substr', '$$;$$', 'CORE::listen', '*$', 'CORE::getprotoent', '', 'CORE::shmget', '$$$', 'CORE::our', undef(), 'CORE::readlink', '_', 'CORE::shmwrite', '$$$$', 'CORE::times', '', 'CORE::package', undef(), 'CORE::map', undef(), 'CORE::join', '$@', 'CORE::rmdir', '_', 'CORE::shmread', '$$$$', 'CORE::uc', '_', 'CORE::bless', '$;$', 'CORE::closedir', '*', 'CORE::getppid', '', 'CORE::tie', chr(92) . '[$@%]$;@', 'CORE::readdir', '*', 'CORE::gethostent', '', 'CORE::getlogin', '', 'CORE::last', undef(), 'CORE::gethostbyaddr', '$$', 'CORE::accept', '**', 'CORE::log', '_', 'CORE::tell', ';*', 'CORE::readline', ';*', 'CORE::tied', undef(), 'CORE::socket', '*$$$', 'CORE::umask', ';$', 'CORE::sysread', '*' . chr(92) . '$$;$', 'CORE::syscall', '$@', 'CORE::quotemeta', '_', 'CORE::dump', '', 'CORE::opendir', '*$', 'CORE::untie', undef(), 'CORE::truncate', '$$', 'CORE::select', ';*', 'CORE::sleep', ';$', 'CORE::seek', '*$$', 'CORE::read', '*' . chr(92) . '$$;$', 'CORE::rewinddir', '*', 'CORE::scalar', undef(), 'CORE::wantarray', '', 'CORE::oct', '_', 'CORE::bind', '*$', 'CORE::stat', '*', 'CORE::sqrt', '_', 'CORE::getc', ';*', 'CORE::fileno', '*', 'CORE::getpeername', '*', 'CORE::sin', '_', 'CORE::getnetbyaddr', '$$', 'CORE::grep', undef(), 'CORE::setservent', '$', 'CORE::sub', undef(), 'CORE::shmctl', '$$$', 'CORE::study', undef(), 'CORE::msgrcv', '$$$$$', 'CORE::setsockopt', '*$$$', 'CORE::int', '_', 'CORE::pop', ';' . chr(92) . '@', 'CORE::link', '$$', 'CORE::exec', undef(), 'CORE::setpwent', '', 'CORE::mkdir', '_;$', 'CORE::sysseek', '*$$', 'CORE::endservent', '', 'CORE::chr', '_', 'CORE::when', undef(), 'CORE::getpwuid', '$', 'CORE::setprotoent', '$', 'CORE::reverse', '@', 'CORE::say', undef(), 'CORE::goto', undef(), 'CORE::getgrent', '', 'CORE::endnetent', '', 'CORE::hex', '_', 'CORE::binmode', '*;$', 'CORE::formline', '$@', 'CORE::getgrnam', '$', 'CORE::ucfirst', '_', 'CORE::chdir', ';$', 'CORE::setnetent', '$', 'CORE::splice', chr(92) . '@;$$@', 'CORE::unlink', '@', 'CORE::time', '', 'CORE::push', chr(92) . '@@', 'CORE::exit', ';$', 'CORE::endgrent', '', 'CORE::unshift', chr(92) . '@@', 'CORE::local', undef(), 'CORE::my', undef(), 'CORE::cos', '_', 'CORE::redo', undef(), 'CORE::warn', '@', 'CORE::getsockname', '*', 'CORE::pipe', '**', 'CORE::sprintf', '$@', 'CORE::open', '*;$@', 'CORE::setpgrp', ';$$', 'CORE::exp', '_', 'CORE::seekdir', '*$', 'CORE::getservbyport', '$$', 'CORE::given', undef(), 'CORE::pack', '$@', 'CORE::msgget', '$$', 'CORE::rindex', '$$;$', 'CORE::srand', ';$', 'CORE::telldir', '*', 'CORE::connect', '*$', 'CORE::getprotobyname', '$', 'CORE::msgsnd', '$$$', 'CORE::length', '_', 'CORE::state', undef(), 'CORE::die', '@', 'CORE::delete', undef(), 'CORE::getservent', '', 'CORE::getservbyname', '$$', 'CORE::setpriority', '$$$', 'CORE::lc', '_', 'CORE::fcntl', '*$$', 'CORE::chroot', '_', 'CORE::recv', '*' . chr(92) . '$$$', 'CORE::dbmopen', chr(92) . '%$$', 'CORE::socketpair', '**$$$', 'CORE::vec', '$$$', 'CORE::system', undef(), 'CORE::defined', '_', 'CORE::index', '$$;$', 'CORE::caller', ';$', 'CORE::close', ';*', 'CORE::atan2', '$$', 'CORE::semop', '$$', 'CORE::unpack', '$;$', 'CORE::ord', '_', 'CORE::chmod', '@', 'CORE::prototype', undef(), 'CORE::getprotobynumber', '$', 'CORE::values', chr(92) . '[@%]', 'CORE::chomp', undef(), 'CORE::ioctl', '*$$', 'CORE::eof', ';*', 'CORE::crypt', '$$', 'CORE::do', undef(), 'CORE::flock', '*$', 'CORE::wait', '', 'CORE::sethostent', '$', 'CORE::return', undef(), 'CORE::getsockopt', '*$$', 'CORE::fork', '', 'CORE::require', undef(), 'CORE::format', undef(), 'CORE::readpipe', '_', 'CORE::endhostent', '', 'CORE::getpgrp', ';$', 'CORE::setgrent', '', 'CORE::keys', chr(92) . '[@%]', 'CORE::glob', undef(), 'CORE::getpriority', '$$', 'CORE::reset', ';$', 'CORE::sysopen', '*$$;$', 'CORE::continue', '', 'CORE::next', undef(), 'CORE::getgrgid', '$', 'CORE::default', undef(), 'CORE::shift', ';' . chr(92) . '@', 'CORE::symlink', '$$', 'CORE::exists', '$', 'CORE::printf', '$@'});
+($Perlito5::CORE_PROTO = {'CORE::shutdown', '*$', 'CORE::chop', undef(), 'CORE::lstat', '*', 'CORE::rename', '$$', 'CORE::lock', chr(92) . '$', 'CORE::rand', ';$', 'CORE::gmtime', ';$', 'CORE::gethostbyname', '$', 'CORE::each', chr(92) . '[@%]', 'CORE::ref', '_', 'CORE::syswrite', '*$;$$', 'CORE::msgctl', '$$$', 'CORE::getnetbyname', '$', 'CORE::write', ';*', 'CORE::alarm', '_', 'CORE::print', undef(), 'CORE::getnetent', '', 'CORE::semget', '$$$', 'CORE::use', undef(), 'CORE::abs', '_', 'CORE::break', '', 'CORE::undef', undef(), 'CORE::no', undef(), 'CORE::eval', '_', 'CORE::split', undef(), 'CORE::localtime', ';$', 'CORE::sort', undef(), 'CORE::chown', '@', 'CORE::endpwent', '', 'CORE::getpwent', '', 'CORE::pos', undef(), 'CORE::lcfirst', '_', 'CORE::kill', '@', 'CORE::send', '*$$;$', 'CORE::endprotoent', '', 'CORE::semctl', '$$$$', 'CORE::waitpid', '$$', 'CORE::utime', '@', 'CORE::dbmclose', chr(92) . '%', 'CORE::getpwnam', '$', 'CORE::substr', '$$;$$', 'CORE::listen', '*$', 'CORE::getprotoent', '', 'CORE::shmget', '$$$', 'CORE::our', undef(), 'CORE::readlink', '_', 'CORE::shmwrite', '$$$$', 'CORE::times', '', 'CORE::package', undef(), 'CORE::map', undef(), 'CORE::join', '$@', 'CORE::rmdir', '_', 'CORE::shmread', '$$$$', 'CORE::uc', '_', 'CORE::bless', '$;$', 'CORE::closedir', '*', 'CORE::getppid', '', 'CORE::tie', chr(92) . '[$@%]$;@', 'CORE::readdir', '*', 'CORE::gethostent', '', 'CORE::getlogin', '', 'CORE::last', undef(), 'CORE::gethostbyaddr', '$$', 'CORE::accept', '**', 'CORE::log', '_', 'CORE::tell', ';*', 'CORE::readline', ';*', 'CORE::tied', undef(), 'CORE::socket', '*$$$', 'CORE::umask', ';$', 'CORE::sysread', '*' . chr(92) . '$$;$', 'CORE::syscall', '$@', 'CORE::quotemeta', '_', 'CORE::dump', '', 'CORE::opendir', '*$', 'CORE::untie', undef(), 'CORE::truncate', '$$', 'CORE::select', ';*', 'CORE::sleep', ';$', 'CORE::seek', '*$$', 'CORE::read', '*' . chr(92) . '$$;$', 'CORE::rewinddir', '*', 'CORE::scalar', undef(), 'CORE::wantarray', '', 'CORE::oct', '_', 'CORE::bind', '*$', 'CORE::stat', '*', 'CORE::sqrt', '_', 'CORE::getc', ';*', 'CORE::fileno', '*', 'CORE::getpeername', '*', 'CORE::sin', '_', 'CORE::getnetbyaddr', '$$', 'CORE::grep', undef(), 'CORE::setservent', '$', 'CORE::sub', undef(), 'CORE::shmctl', '$$$', 'CORE::study', undef(), 'CORE::msgrcv', '$$$$$', 'CORE::setsockopt', '*$$$', 'CORE::int', '_', 'CORE::pop', ';' . chr(92) . '@', 'CORE::link', '$$', 'CORE::exec', undef(), 'CORE::setpwent', '', 'CORE::mkdir', '_;$', 'CORE::sysseek', '*$$', 'CORE::endservent', '', 'CORE::chr', '_', 'CORE::when', undef(), 'CORE::getpwuid', '$', 'CORE::setprotoent', '$', 'CORE::reverse', '@', 'CORE::say', undef(), 'CORE::goto', undef(), 'CORE::getgrent', '', 'CORE::endnetent', '', 'CORE::hex', '_', 'CORE::binmode', '*;$', 'CORE::formline', '$@', 'CORE::getgrnam', '$', 'CORE::ucfirst', '_', 'CORE::chdir', ';$', 'CORE::setnetent', '$', 'CORE::splice', chr(92) . '@;$$@', 'CORE::unlink', '@', 'CORE::time', '', 'CORE::push', chr(92) . '@@', 'CORE::exit', ';$', 'CORE::endgrent', '', 'CORE::unshift', chr(92) . '@@', 'CORE::local', undef(), 'CORE::my', undef(), 'CORE::cos', '_', 'CORE::redo', undef(), 'CORE::warn', '@', 'CORE::getsockname', '*', 'CORE::pipe', '**', 'CORE::sprintf', '$@', 'CORE::open', '*;$@', 'CORE::setpgrp', ';$$', 'CORE::exp', '_', 'CORE::seekdir', '*$', 'CORE::getservbyport', '$$', 'CORE::given', undef(), 'CORE::pack', '$@', 'CORE::msgget', '$$', 'CORE::rindex', '$$;$', 'CORE::srand', ';$', 'CORE::telldir', '*', 'CORE::connect', '*$', 'CORE::getprotobyname', '$', 'CORE::msgsnd', '$$$', 'CORE::length', '_', 'CORE::state', undef(), 'CORE::die', '@', 'CORE::delete', undef(), 'CORE::getservent', '', 'CORE::getservbyname', '$$', 'CORE::setpriority', '$$$', 'CORE::lc', '_', 'CORE::fcntl', '*$$', 'CORE::chroot', '_', 'CORE::recv', '*' . chr(92) . '$$$', 'CORE::dbmopen', chr(92) . '%$$', 'CORE::socketpair', '**$$$', 'CORE::vec', '$$$', 'CORE::system', undef(), 'CORE::defined', '_', 'CORE::index', '$$;$', 'CORE::caller', ';$', 'CORE::close', ';*', 'CORE::atan2', '$$', 'CORE::semop', '$$', 'CORE::unpack', '$;$', 'CORE::ord', '_', 'CORE::chmod', '@', 'CORE::prototype', undef(), 'CORE::getprotobynumber', '$', 'CORE::values', chr(92) . '[@%]', 'CORE::chomp', undef(), 'CORE::ioctl', '*$$', 'CORE::eof', ';*', 'CORE::crypt', '$$', 'CORE::do', undef(), 'CORE::flock', '*$', 'CORE::wait', '', 'CORE::sethostent', '$', 'CORE::return', undef(), 'CORE::getsockopt', '*$$', 'CORE::fork', '', 'CORE::require', undef(), 'CORE::format', undef(), 'CORE::readpipe', '_', 'CORE::endhostent', '', 'CORE::getpgrp', ';$', 'CORE::setgrent', '', 'CORE::keys', chr(92) . '[@%]', 'CORE::glob', undef(), 'CORE::getpriority', '$$', 'CORE::reset', ';$', 'CORE::sysopen', '*$$;$', 'CORE::continue', '', 'CORE::next', undef(), 'CORE::getgrgid', '$', 'CORE::default', undef(), 'CORE::shift', ';' . chr(92) . '@', 'CORE::symlink', '$$', 'CORE::exists', '$', 'CORE::printf', '$@'});
1;
;
View
21 src5/lib/Perlito5/Grammar.pm
@@ -42,6 +42,27 @@ sub ident {
$m;
}
+sub caret_char {
+ my $c = substr( $_[1], $_[2], 1 );
+ my $pos = $_[2];
+ if ($c eq '^') {
+ $pos++;
+ $c = substr( $_[1], $pos, 1 );
+ return 0 if $c lt 'A' || $c gt 'Z';
+ $c = chr( ord($c) - ord("A") + 1 );
+ }
+ elsif ( $_[0]->ws($_[1], $pos) ) {
+ return 0;
+ }
+ return 0 if $c lt "\cA" || $c gt "\cZ";
+ return {
+ str => $_[1],
+ from => $_[2],
+ to => $pos + 1,
+ capture => $c,
+ }
+}
+
token full_ident {
<.ident> [ '::' <.ident> ]*
};
View
78 src5/lib/Perlito5/Grammar/Sigil.pm
@@ -221,29 +221,30 @@ sub term_sigil {
}
}
}
- if ( substr($str, $p, 1) eq '^' ) {
+ my $caret = Perlito5::Grammar->caret_char( $str, $p );
+ if ( $caret ) {
# ${^ ...
- # TODO - make sure ^ is followed by an ASCII uppercase letter
- $m = Perlito5::Grammar->var_name( $str, $p + 1 );
+ my $p = $caret->{to};
+ my $name = Perlito5::Match::flat($caret);
+ $m = Perlito5::Grammar->var_name($str, $p);
if ($m) {
- my $p = $m->{to};
- if ( substr($str, $p, 1) eq '}' ) {
- my $name = Perlito5::Match::flat($m);
- my $c1 = chr( ord(substr($name, 0, 1)) - ord("A") + 1 );
- $m->{capture} = [ 'term',
- Perlito5::AST::Apply->new(
- 'arguments' => [
- Perlito5::AST::Val::Buf->new(
- 'buf' => $c1 . substr($name, 1),
- )
- ],
- 'code' => 'prefix:<' . $sigil . '>',
- 'namespace' => '',
- )
- ];
- $m->{to} = $m->{to} + 1;
- return $m;
- }
+ $name = $name . Perlito5::Match::flat($m);
+ $p = $m->{to};
+ }
+ if ( substr($str, $p, 1) eq '}' ) {
+ $caret->{capture} = [ 'term',
+ Perlito5::AST::Apply->new(
+ 'arguments' => [
+ Perlito5::AST::Val::Buf->new(
+ 'buf' => $name,
+ )
+ ],
+ 'code' => 'prefix:<' . $sigil . '>',
+ 'namespace' => '',
+ )
+ ];
+ $caret->{to} = $p + 1;
+ return $caret;
}
}
$m = Perlito5::Expression->curly_parse( $str, $p );
@@ -263,27 +264,22 @@ sub term_sigil {
}
}
}
- if ( $c1 eq '^' ) {
+ my $caret = Perlito5::Grammar->caret_char( $str, $p );
+ if ( $caret ) {
# $^ ...
- # TODO - make sure ^ is followed by an ASCII uppercase letter
- my $p = $q;
- $m = Perlito5::Grammar->word( $str, $p );
- if ($m) {
- my $name = Perlito5::Match::flat($m);
- my $c1 = chr( ord(substr($name, 0, 1)) - ord("A") + 1 );
- $m->{capture} = [ 'term',
- Perlito5::AST::Apply->new(
- 'arguments' => [
- Perlito5::AST::Val::Buf->new(
- 'buf' => $c1 . substr($name, 1),
- )
- ],
- 'code' => 'prefix:<' . $sigil . '>',
- 'namespace' => '',
- )
- ];
- return $m;
- }
+ my $name = Perlito5::Match::flat($caret);
+ $caret->{capture} = [ 'term',
+ Perlito5::AST::Apply->new(
+ 'arguments' => [
+ Perlito5::AST::Val::Buf->new(
+ 'buf' => $name,
+ )
+ ],
+ 'code' => 'prefix:<' . $sigil . '>',
+ 'namespace' => '',
+ )
+ ];
+ return $caret;
}
if ( $c1 eq '$' ) {
# $$ ...
View
5 src5/lib/Perlito5/Precedence.pm
@@ -114,7 +114,10 @@ sub op_parse {
if (exists($End_token->{$term})) {
my $c1 = substr($str, $pos + length($term) - 1, 1);
my $c2 = substr($str, $pos + length($term), 1);
- if (!(is_ident_middle($c1) && is_ident_middle($c2) )) {
+ if ( !(is_ident_middle($c1) && is_ident_middle($c2) )
+ && !($c1 eq '<' && $c2 eq '<')
+ )
+ {
# it looks like an end token, and it is not one of these cases:
# if_more
return {
View
2 src5/lib/Perlito5/Runtime.pm
@@ -103,7 +103,7 @@ $Perlito5::CORE_PROTO = {
'CORE::break' => '',
'CORE::undef' => undef,
'CORE::no' => undef,
- 'CORE::eval' => undef,
+ 'CORE::eval' => '_', # original undef
'CORE::split' => undef,
'CORE::localtime' => ';$',
'CORE::sort' => undef,
View
38 t5/base/lex.t
@@ -1,7 +1,7 @@
#!./perl
#print "1..57\n";
-print "1..40\n";
+print "1..43\n";
$x = 'x';
@@ -128,28 +128,28 @@ print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
$ {$CXY} = 23;
if ($ {^XY} != 23) { print "not " }
print "ok 30\n";
-##
-## # Does the syntax where we use the literal control character still work?
-## if (eval "\$ {\cX}" != 17 or $@) { print "not " }
-## print "ok 32\n";
-##
-## eval "\$\cQ = 24"; # Literal control character
-## if ($@ or ${"\cQ"} != 24) { print "not " }
-## print "ok 33\n";
-## if ($^Q != 24) { print "not " } # Control character escape sequence
-## print "ok 34\n";
-##
+
+ # Does the syntax where we use the literal control character still work?
+ if (eval "\$ {\cX}" != 17 or $@) { print "not " }
+ print "ok 31\n";
+
+ eval "\$\cQ = 24"; # Literal control character
+ if ($@ or ${"\cQ"} != 24) { print "not " }
+ print "ok 32\n";
+ if ($^Q != 24) { print "not " } # Control character escape sequence
+ print "ok 33\n";
+
# Does the old UNBRACED syntax still do what it used to?
if ("$^XY" ne "17Y") { print "not " }
- print "ok 31\n";
+ print "ok 34\n";
sub XX () { 6 }
$ {"\cQ\cXX"} = 119;
$^Q = 5; # This should be an unused ^Var.
$N = 5;
# The second caret here should be interpreted as an xor
if (($^Q^XX) != 3) { print "not " }
- print "ok 32\n";
+ print "ok 35\n";
## # if (($N ^ XX()) != 3) { print "not " }
## # print "ok 32\n";
##
@@ -174,11 +174,11 @@ print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
$ {^M} = 'Someother 3';
package main;
print "not " unless $^Q eq 'Someother';
- print "ok 33\n";
+ print "ok 36\n";
print "not " unless $ {^Quixote} eq 'Someother 2';
- print "ok 34\n";
+ print "ok 37\n";
print "not " unless $ {^M} eq 'Someother 3';
- print "ok 35\n";
+ print "ok 38\n";
}
@@ -215,7 +215,7 @@ print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
# arrays now *always* interpolate into "..." strings.
# 20000522 MJD (mjd@plover.com)
{
- my $test = 36;
+ my $test = 39;
eval(q(">@nosuch<" eq "><")) || print "# $@", "not ";
print "ok $test\n";
++$test;
@@ -274,4 +274,4 @@ print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
# Is "[~" scanned correctly?
@a = (1,2,3);
print "not " unless($a[~~2] == 3);
-print "ok 40\n";
+print "ok 43\n";

0 comments on commit 5879509

Please sign in to comment.
Something went wrong with that request. Please try again.