Skip to content

Commit

Permalink
Partially implement Pod '#' alias for %config :numbered
Browse files Browse the repository at this point in the history 
+ Implemented only for abbreviated blocks, e.g.,

   =para # some
   text

or

   =para
   # some
   text

+ Added TODOs and notes for upcoming implementations.

+ Some code cleanup.

Files changed:

+ src/Perl6/Actions.nqp

+ src/Perl6/Grammar.nqp

+ src/Perl6/Pod.nqp

+ t/spectest.data

    - added tests in t/spec/S26*/15-numbered-alias.t
  • Loading branch information
@tbrowder
tbrowder committed Sep 15, 2018
1 parent 39f2d68 commit b4bf166
Show file tree
Hide file tree
Showing 4 changed files with 473 additions and 156 deletions.
41 changes: 27 additions & 14 deletions src/Perl6/Actions.nqp
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -7,6 +7,11 @@ use QAST;


my $wantwant := Mu; my $wantwant := Mu;


# block types
my $para-block := 'paragraph';
my $delim-block := 'delimited';
my $abbrev-block := 'abbreviated';

# 2147483648 == 2**31. By adding 1 to it with add_i op, on 32-bit boxes it will overflow # 2147483648 == 2**31. By adding 1 to it with add_i op, on 32-bit boxes it will overflow
my int $?BITS := nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32; my int $?BITS := nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32;


Expand Down Expand Up @@ -1448,30 +1453,35 @@ class Perl6::Actions is HLL::Actions does STDActions {
make $<pod_block>.ast; make $<pod_block>.ast;
} }


# TODO The spaces arg from Grammar.nqp seems
# NOT to be handled. That shows up
# in testing for config continuation lines.
method pod_configuration($/) { method pod_configuration($/) {
make Perl6::Pod::make_config($/); make Perl6::Pod::make_config($/);
} }


method pod_block:sym<delimited>($/) { method pod_block:sym<delimited>($/) {
if $<type>.Str ~~ /^defn/ { if $<type>.Str ~~ /^defn/ {
make Perl6::Pod::defn($/, 'delimited'); make Perl6::Pod::defn($/, $delim-block);
return; }
else {
make Perl6::Pod::any_block($/, $delim-block);
} }
make Perl6::Pod::any_block($/);
} }


method pod_block:sym<delimited_comment>($/) { method pod_block:sym<delimited_comment>($/) {
make Perl6::Pod::raw_block($/); make Perl6::Pod::raw_block($/);
} }


method pod_block:sym<delimited_table>($/) { method pod_block:sym<delimited_table>($/) {
make Perl6::Pod::table($/); make Perl6::Pod::table($/, $delim-block);
} }


method pod_block:sym<delimited_code>($/) { method pod_block:sym<delimited_code>($/) {
my $config := $<pod_configuration>.ast; # TODO add numbered-alias handling
my $config := $<pod_configuration>.ast;
my @contents := $<delimited_code_content>.ast; my @contents := $<delimited_code_content>.ast;
@contents := Perl6::Pod::serialize_array(@contents).compile_time_value; @contents := Perl6::Pod::serialize_array(@contents).compile_time_value;
make Perl6::Pod::serialize_object('Pod::Block::Code', make Perl6::Pod::serialize_object('Pod::Block::Code',
:@contents,:$config).compile_time_value :@contents,:$config).compile_time_value
} }
Expand All @@ -1495,21 +1505,23 @@ class Perl6::Actions is HLL::Actions does STDActions {


method pod_block:sym<paragraph>($/) { method pod_block:sym<paragraph>($/) {
if $<type>.Str ~~ /^defn/ { if $<type>.Str ~~ /^defn/ {
make Perl6::Pod::defn($/, 'paragraph'); make Perl6::Pod::defn($/, $para-block);
return; }
else {
make Perl6::Pod::any_block($/, $para-block);
} }
make Perl6::Pod::any_block($/);
} }


method pod_block:sym<paragraph_comment>($/) { method pod_block:sym<paragraph_comment>($/) {
make Perl6::Pod::raw_block($/); make Perl6::Pod::raw_block($/);
} }


method pod_block:sym<paragraph_table>($/) { method pod_block:sym<paragraph_table>($/) {
make Perl6::Pod::table($/); make Perl6::Pod::table($/, $para-block);
} }


method pod_block:sym<paragraph_code>($/) { method pod_block:sym<paragraph_code>($/) {
# TODO make config via call to make_config in Pod.nqp
my $config := $<pod_configuration>.ast; my $config := $<pod_configuration>.ast;
my @contents := []; my @contents := [];
for $<pod_line> { for $<pod_line> {
Expand All @@ -1522,18 +1534,19 @@ class Perl6::Actions is HLL::Actions does STDActions {


method pod_block:sym<abbreviated>($/) { method pod_block:sym<abbreviated>($/) {
if $<type>.Str ~~ /^defn/ { if $<type>.Str ~~ /^defn/ {
make Perl6::Pod::defn($/, 'abbreviated'); make Perl6::Pod::defn($/, $abbrev-block);
return; }
else {
make Perl6::Pod::any_block($/, $abbrev-block);
} }
make Perl6::Pod::any_block($/);
} }


method pod_block:sym<abbreviated_comment>($/) { method pod_block:sym<abbreviated_comment>($/) {
make Perl6::Pod::raw_block($/); make Perl6::Pod::raw_block($/);
} }


method pod_block:sym<abbreviated_table>($/) { method pod_block:sym<abbreviated_table>($/) {
make Perl6::Pod::table($/); make Perl6::Pod::table($/, $abbrev-block);
} }


method pod_block:sym<abbreviated_code>($/) { method pod_block:sym<abbreviated_code>($/) {
Expand Down
78 changes: 61 additions & 17 deletions src/Perl6/Grammar.nqp
View file
Original file line number Original file line Diff line number Diff line change
Expand Up @@ -768,6 +768,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
} }
method attach_leading_docs() { method attach_leading_docs() {
# TODO allow some limited text layout here
if ~$*DOC ne '' { if ~$*DOC ne '' {
my $cont := Perl6::Pod::serialize_aos( my $cont := Perl6::Pod::serialize_aos(
[Perl6::Pod::normalize_text(~$*DOC)] [Perl6::Pod::normalize_text(~$*DOC)]
Expand All @@ -783,6 +784,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
} }
method attach_trailing_docs($doc) { method attach_trailing_docs($doc) {
# TODO allow some limited text layout here
unless $*POD_BLOCKS_SEEN{ self.from() } { unless $*POD_BLOCKS_SEEN{ self.from() } {
$*POD_BLOCKS_SEEN{ self.from() } := 1; $*POD_BLOCKS_SEEN{ self.from() } := 1;
my $pod_block; my $pod_block;
Expand Down Expand Up @@ -815,9 +817,18 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
} }
# any number of paragraphs of text # any number of paragraphs of text
# the paragraphs are separated by one
# or more pod_newlines
# each paragraph originally could have
# consisted of more than one line of
# text that were subsequently squeezed
# into one line
token pod_content:sym<text> { token pod_content:sym<text> {
<pod_newline>* <pod_newline>*
# TODO get first line if IN-DEFN-BLOCK
<pod_textcontent>+ % <pod_newline>+ <pod_textcontent>+ % <pod_newline>+
<pod_newline>* <pod_newline>*
} }
Expand All @@ -830,7 +841,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
proto token pod_textcontent { <...> } proto token pod_textcontent { <...> }
# text not being code # for non-code (i.e., regular) text
token pod_textcontent:sym<regular> { token pod_textcontent:sym<regular> {
$<spaces>=[ \h* ] $<spaces>=[ \h* ]
<?{ $*POD_IN_CODE_BLOCK <?{ $*POD_IN_CODE_BLOCK
Expand All @@ -847,6 +858,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<?{ !$*POD_IN_CODE_BLOCK <?{ !$*POD_IN_CODE_BLOCK
&& $*ALLOW_INLINE_CODE && $*ALLOW_INLINE_CODE
&& ($<spaces>.to - $<spaces>.from) > $*VMARGIN }> && ($<spaces>.to - $<spaces>.from) > $*VMARGIN }>
# TODO get first line if IN-DEFN-BLOCK
$<text> = [ $<text> = [
[<!before '=' \w> \N+]+ % [<pod_newline>+ $<spaces>] [<!before '=' \w> \N+]+ % [<pod_newline>+ $<spaces>]
] ]
Expand Down Expand Up @@ -972,7 +985,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
} }
:my $*ALLOW_INLINE_CODE := 0; :my $*ALLOW_INLINE_CODE := 0;
$<type> = [ $<type> = [
# allow 'defn' to have %config
<pod_code_parent> { <pod_code_parent> {
$*ALLOW_INLINE_CODE := 1; $*ALLOW_INLINE_CODE := 1;
} }
Expand All @@ -981,6 +993,7 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_newline>+ <pod_configuration($<spaces>)> <pod_newline>+
[ [
# TODO need first line to check for ws-separated '#'
<pod_content> * <pod_content> *
^^ $<spaces> '=end' \h+ ^^ $<spaces> '=end' \h+
[ [
Expand Down Expand Up @@ -1086,14 +1099,19 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*ALLOW_INLINE_CODE := 0; :my $*ALLOW_INLINE_CODE := 0;
[ :!ratchet [ :!ratchet
$<type> = [ $<type> = [
# allow 'defn' to have %config
<pod_code_parent> { $*ALLOW_INLINE_CODE := 1 } <pod_code_parent> { $*ALLOW_INLINE_CODE := 1 }
|| <identifier> || <identifier>
] ]
:my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_configuration($<spaces>)>
<pod_newline> <pod_newline>
] ]
# TODO [defn, term], [first text, line numbered-alias]
# if this is a defn block
# the first line of the first pod_textcontent
# becomes the term
# then combine the rest of the text
# TODO exchange **0..1 for modern syntax
<pod_content=.pod_textcontent>**0..1 <pod_content=.pod_textcontent>**0..1
} }
Expand All @@ -1112,6 +1130,8 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
'=for' \h+ 'table' {} '=for' \h+ 'table' {}
:my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_configuration($<spaces>)> <pod_newline> <pod_configuration($<spaces>)> <pod_newline>
# TODO add numbered-alias token here
[ <!before \h* \n> <table_row>]* [ <!before \h* \n> <table_row>]*
} }
Expand All @@ -1122,10 +1142,20 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*POD_ALLOW_FCODES := 0; :my $*POD_ALLOW_FCODES := 0;
:my $*POD_IN_CODE_BLOCK := 1; :my $*POD_IN_CODE_BLOCK := 1;
<pod_configuration($<spaces>)> <pod_newline> <pod_configuration($<spaces>)> <pod_newline>
# TODO get first line if IN-DEFN-BLOCK
[ <!before \h* '=' \w> <pod_line> ]* [ <!before \h* '=' \w> <pod_line> ]*
} }
# TODO make sure this token works in all desired
# places: may have to remove the before/afters
# when using with non-abbreviated blocks
# (particulary code blocks)
token numbered-alias { <after [^|\s]> '#' <before \s> }
token pod_block:sym<abbreviated> { token pod_block:sym<abbreviated> {
# Note an abbreviated block does not have
# %config data, but see the hash mark
# handling below.
^^ ^^
$<spaces> = [ \h* ] $<spaces> = [ \h* ]
'=' <!before begin || end || for || finish || config> '=' <!before begin || end || for || finish || config>
Expand All @@ -1135,13 +1165,20 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*ALLOW_INLINE_CODE := 0; :my $*ALLOW_INLINE_CODE := 0;
[ :!ratchet [ :!ratchet
$<type> = [ $<type> = [
# defn special now, can have data on same line <pod_code_parent> {
<pod_code_parent2> { $*ALLOW_INLINE_CODE := 1 } $*ALLOW_INLINE_CODE := 1;
}
|| <identifier> || <identifier>
] ]
:my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
# An optional hash char here is special.
[\h+ <numbered-alias>]?
[\h*\n|\h+] [\h*\n|\h+]
] ]
# TODO [defn, term], [first text, line numbered-alias]
# TODO exchange **0..1 for modern syntax
<pod_content=.pod_textcontent>**0..1 <pod_content=.pod_textcontent>**0..1
} }
Expand All @@ -1158,6 +1195,10 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
^^ ^^
$<spaces> = [ \h* ] $<spaces> = [ \h* ]
'=table' {} '=table' {}
# An optional hash char here is special.
[\h+ <numbered-alias>]?
:my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES'); :my $*POD_ALLOW_FCODES := nqp::getlexdyn('$*POD_ALLOW_FCODES');
<pod_newline> <pod_newline>
[ <!before \h* \n> <table_row>]* [ <!before \h* \n> <table_row>]*
Expand All @@ -1169,18 +1210,28 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
'=' <pod-delim-code-typ> {} '=' <pod-delim-code-typ> {}
:my $*POD_ALLOW_FCODES := 0; :my $*POD_ALLOW_FCODES := 0;
:my $*POD_IN_CODE_BLOCK := 1; :my $*POD_IN_CODE_BLOCK := 1;
# An optional hash char here is special.
# For the code block, we want to eat any ws
# between the '#' and the next char
#$<numbered-alias>=[\h+ '#' \s]?
$<numbered-alias>=[\h+ '#' \s]?
[\h*\n|\h+] [\h*\n|\h+]
[ <!before \h* '=' \w> <pod_line> ]* [ <!before \h* '=' \w> <pod_line> ]*
} }
# TODO exchange **1 for modern syntax
token pod_line { <pod_string>**1 [ <pod_newline> | $ ] } token pod_line { <pod_string>**1 [ <pod_newline> | $ ] }
token pod_newline { token pod_newline {
\h* \n \h* \n
} }
# these parents can have %config keys in their delimited form, # These parents can contain implicit code blocks when data
# but no other data on the same line except for 'item' # lines begin with whitespace indention from the virtual
# margin.
token pod_code_parent { token pod_code_parent {
[ [
| [ 'pod' | 'item' \d* | 'nested' | 'defn' | 'finish' ] | [ 'pod' | 'item' \d* | 'nested' | 'defn' | 'finish' ]
Expand All @@ -1189,16 +1240,6 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
<![\w]> <![\w]>
} }
# these parents can NOT have %config keys in their other forms,
# and no other data on the same line execept for 'item' and 'defn'
token pod_code_parent2 {
[
| [ 'pod' | 'item' \d* | 'nested' | 'defn' [\h+ \N*]? | 'finish' ]
| <upper>+
]
<![\w]>
}
token install_doc_phaser { <?> } token install_doc_phaser { <?> }
token vnum { token vnum {
Expand Down Expand Up @@ -1281,6 +1322,9 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
:my $*DECLARATOR_DOCS; :my $*DECLARATOR_DOCS;
:my $*PRECEDING_DECL; # for #= comments :my $*PRECEDING_DECL; # for #= comments
:my $*PRECEDING_DECL_LINE := -1; # XXX update this when I see another comment like it? :my $*PRECEDING_DECL_LINE := -1; # XXX update this when I see another comment like it?
# TODO use these vars to implement S26 pod data block handling
:my $*DATA-BLOCKS := [];
:my %*DATA-BLOCKS := {};
# Quasis and unquotes # Quasis and unquotes
:my $*IN_QUASI := 0; # whether we're currently in a quasi block :my $*IN_QUASI := 0; # whether we're currently in a quasi block
Expand Down
Loading

0 comments on commit b4bf166

Please sign in to comment.