Mostly working Pod code block refactor

rakudo · Feb 19, 2014 · 39308e5 · 39308e5
1 parent 0bc8fb7
commit 39308e5
Show file tree

Hide file tree

Showing 3 changed files with 63 additions and 12 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -561,14 +561,35 @@ class Perl6::Actions is HLL::Actions does STDActions {
         make Perl6::Pod::any_block($/);
     }
 
-    method pod_block:sym<delimited_raw>($/) {
+    method pod_block:sym<delimited_comment>($/) {
         make Perl6::Pod::raw_block($/);
     }
 
     method pod_block:sym<delimited_table>($/) {
         make Perl6::Pod::table($/);
     }
 
+    method pod_block:sym<delimited_code>($/) {
+        my $config  := $<pod_configuration>.ast;
+        my @content := $<delimited_code_content>.ast;
+        my $twine   := Perl6::Pod::serialize_array(@content).compile_time_value;
+        make Perl6::Pod::serialize_object(
+            'Pod::Block::Code', :content($twine),
+            :config($config),
+        ).compile_time_value
+    }
+
+    method delimited_code_content($/) {
+        if $<pod_string> {
+            my @t := Perl6::Pod::merge_twines($<pod_string>);
+            @t.push($<delimited_code_content>.ast);
+            make @t;
+        }
+        else {
+            make "";
+        }
+    }
+
     method pod_block:sym<paragraph>($/) {
         make Perl6::Pod::any_block($/);
     }
@@ -585,14 +606,22 @@ class Perl6::Actions is HLL::Actions does STDActions {
         make Perl6::Pod::any_block($/);
     }
 
-    method pod_block:sym<abbreviated_raw>($/) {
+    method pod_block:sym<abbreviated_comment>($/) {
         make Perl6::Pod::raw_block($/);
     }
 
     method pod_block:sym<abbreviated_table>($/) {
         make Perl6::Pod::table($/);
     }
 
+    method pod_block:sym<abbreviated_code>($/) {
+        my @t     := Perl6::Pod::merge_twines($<pod_string>);
+        my $twine := Perl6::Pod::serialize_array(@t).compile_time_value;
+        make Perl6::Pod::serialize_object(
+            'Pod::Block::Code', :content($twine)
+        ).compile_time_value
+    }
+
     method pod_block:sym<end>($/) {
     }
 

diff --git a/src/Perl6/Grammar.nqp b/src/Perl6/Grammar.nqp
@@ -688,12 +688,21 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
         ^^
         $<spaces> = [ \h* ]
         '=begin' \h+ 'code'
-            :my $*POD_ALLOW_FCODES := 0;
-            <pod_configuration($<spaces>)> <pod_newline>+
+        :my $*POD_ALLOW_FCODES := 0;
+        :my $*ALLOW_CODE := 0;
+        <pod_configuration($<spaces>)> <pod_newline>+
         [
-         <pod_content>*
-         ^^ \h* '=end' \h+ 'code' <pod_newline>
-         ||  <.typed_panic: 'X::Syntax::Pod::BeginWithoutEnd'>
+        || <delimited_code_content(~$<spaces>)>
+        || <.typed_panic: 'X::Syntax::Pod::BeginWithoutEnd'>
+        ]
+    }
+
+    token delimited_code_content($spaces = '') {
+        ^^ $spaces
+        [
+        || '=end' \h+ 'code' <pod_newline>
+        || <pod_string>**1 <pod_newline>
+           <delimited_code_content($spaces)>
         ]
     }
 
@@ -786,11 +795,12 @@ grammar Perl6::Grammar is HLL::Grammar does STD {
         $<spaces> = [ \h* ]
         '=code' <pod_configuration($<spaces>)> <pod_newline>
         :my $*POD_ALLOW_FCODES := 0;
-        [ <!before \h* \n> <pod_content>]*
+        :my $*ALLOW_CODE := 0;
+        [ <pod_string> <pod_newline> ]+
     }
 
     token pod_newline {
-        \h* \n
+        \h* [ \n | $ ]
     }
 
     token pod_code_parent {

diff --git a/src/Perl6/Pod.nqp b/src/Perl6/Pod.nqp
@@ -61,15 +61,27 @@ class Perl6::Pod {
         my $config := $<pod_configuration>.ast;
         my $str := $*W.add_constant('Str', 'str', ~$<pod_content>);
         my $content := serialize_array([$str.compile_time_value]);
-        my $type := $<type>.Str eq 'code' ?? 'Pod::Block::Code'
-                                          !! 'Pod::Block::Comment';
         my $past := serialize_object(
-            $type, :config($config),
+            'Pod::Block::Comment', :config($config),
             :content($content.compile_time_value),
         );
         return $past.compile_time_value;
     }
 
+#    our sub code_block($/) {
+#        my @children := [];
+#        my $config := $<pod_configuration>.ast;
+#        for $<pod_string> {
+#            @children.push($_.ast);
+#        }
+#        my $content := serialize_array(@children);
+#        my $past := serialize_object(
+#            'Pod::Block::Code', :config($config),
+#            :content($content.compile_time_value),
+#        );
+#        return $past.compile_time_value;
+#    }
+
     our sub config($/) {
         my $type := $*W.add_constant('Str', 'str', ~$<type>);
         return serialize_object(