diff options
author | Jesse Luehrs <doy@tozt.net> | 2013-07-19 01:59:18 -0400 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2013-07-19 01:59:59 -0400 |
commit | 56de12a2999763ca14aefdf4ac1af1d527ccbc71 (patch) | |
tree | d612dff83690f7fe722a1d44039ff582f7786e8e | |
parent | c4af186f76844b38e775e3454545acc84b4f144a (diff) | |
download | parse-keyword-56de12a2999763ca14aefdf4ac1af1d527ccbc71.tar.gz parse-keyword-56de12a2999763ca14aefdf4ac1af1d527ccbc71.zip |
start trying to implement some helper functions
these don't really work properly, but it's a start
-rw-r--r-- | Keyword.xs | 53 | ||||
-rw-r--r-- | lib/Parse/Keyword.pm | 14 |
2 files changed, 67 insertions, 0 deletions
@@ -71,3 +71,56 @@ install_keyword_handler(keyword, handler) SV *handler CODE: cv_set_call_parser((CV*)SvRV(keyword), parser_callback, handler); + +void +lex_read_space() + CODE: + lex_read_space(0); + +SV* +lex_peek_unichar() + PREINIT: + I32 ch; + CODE: + ch = lex_peek_unichar(0); + RETVAL = newSVpvf("%c", (int)ch); /* XXX unicode */ + OUTPUT: + RETVAL + +SV* +parse_block() + PREINIT: + I32 floor; + CV *code; + CODE: + floor = start_subparse(0, CVf_ANON); + code = newATTRSUB(floor, NULL, NULL, NULL, parse_block(0)); + if (CvCLONE(code)) { + code = cv_clone(code); + } + RETVAL = newRV_inc((SV*)code); + OUTPUT: + RETVAL + +void +ensure_linestr_len(len) + UV len + CODE: + while (PL_parser->bufend - PL_parser->bufptr < len) { + if (!lex_next_chunk(LEX_KEEP_PREVIOUS)) { + break; + } + } + +SV* +linestr() + CODE: + RETVAL = newSVpvn(PL_parser->bufptr, PL_parser->bufend - PL_parser->bufptr); + OUTPUT: + RETVAL + +void +lex_read_to(len) + UV len + CODE: + lex_read_to(PL_parser->bufptr + len); diff --git a/lib/Parse/Keyword.pm b/lib/Parse/Keyword.pm index b2e2709..aca308f 100644 --- a/lib/Parse/Keyword.pm +++ b/lib/Parse/Keyword.pm @@ -25,6 +25,20 @@ sub import { }; install_keyword_handler($sub, $keywords->{$keyword}); } + + my @helpers = qw( + lex_peek_unichar + lex_read_space + lex_read_to + parse_block + ensure_linestr_len + linestr + ); + + for my $helper (@helpers) { + no strict 'refs'; + *{ $caller . '::' . $helper } = \&{ __PACKAGE__ . '::' . $helper }; + } } 1; |