Add pod-related tokens to Grammar.pm

src/Perl6/Grammar.pm

@@ -117,7 +117,7 @@ grammar Perl6::Grammar is HLL::Grammar {
     token unv {
         # :dba('horizontal whitespace')
         [
-        | ^^ <?before \h* '=' [ \w | '\\'] > <.pod_comment>
+        | ^^ <?before \h* '=' [ \w | '\\'] > <.pod_content>
         | \h* <comment>
         | \h+
         ]
@@ -142,30 +142,144 @@ grammar Perl6::Grammar is HLL::Grammar {
         '#=' $<attachment>=[\N*]
     }
 
-    token pod_comment {
-        ^^ \h* '='
+    proto token pod_content { <...> }
+
+    token pod_content:sym<block> {
+        <pod_newline>*
+        <pod_block>
+        <pod_newline>*
+    }
+
+    # any number of paragraphs of text
+    token pod_content:sym<text> {
+        <pod_newline>*
+        <pod_textcontent> ** <pod_newline>+
+        <pod_newline>*
+    }
+
+    proto token pod_textcontent { <...> }
+
+    # a single paragraph of text
+    token pod_text_para {
+        $<text> = [
+            \h* <!before '=' \w> \N+ <pod_newline>
+        ] +
+    }
+
+    # text not being code
+    token pod_textcontent:sym<regular> {
+        $<spaces>=[ \h* ]
+         <?{ !$*ALLOW_CODE
+             || ($<spaces>.to - $<spaces>.from) <= $*VMARGIN }>
+
+        $<text> = [
+            \h* <!before '=' \w> \N+ <pod_newline>
+        ] +
+    }
+
+    token pod_textcontent:sym<code> {
+        $<spaces>=[ \h* ]
+        <?{ $*ALLOW_CODE
+            && ($<spaces>.to - $<spaces>.from) > $*VMARGIN }>
+        $<text> = [
+            [<!before '=' \w> \N+] ** [<pod_newline> $<spaces>]
+        ]
+    }
+
+    proto token pod_block { <...> }
+
+    token pod_block:sym<delimited> {
+        ^^
+        $<spaces> = [ \h* ]
+        '=begin' \h+ <!before 'END'>
+        {}
+        :my $*VMARGIN := $<spaces>.to - $<spaces>.from;
+        :my $*ALLOW_CODE := 0;
+        $<type> = [
+            <pod_code_parent> { $*ALLOW_CODE := 1 }
+            || <identifier>
+        ]
+        <pod_newline>+
         [
-        | 'begin' \h+ 'END' >>
-            [ .*? \n '=' 'end' \h+ 'END' » \N* || .* ]
-        | 'begin' \h+ <identifier>
-            [
-            ||  .*? \n '=' 'end' \h+ $<identifier> » \N*
-            ||  <.panic: '=begin without matching =end'>
-            ]
-        | 'begin' » \h*
-            [ $$ || '#' || <.panic: 'Unrecognized token after =begin'> ]
-            [
-            || .*? \n \h* '=' 'end' » \N*
-            || <.panic: '=begin without matching =end'>
-            ]
-        |
-            [ <?before .*? ^^ '=cut' » >
-              <.panic: 'Obsolete pod format, please use =begin/=end instead'> ]?
-            [ <alpha> || \s || <.panic: 'Illegal pod directive'> ]
-            \N*
+         <pod_content> *
+         ^^ \h* '=end' \h+ $<type> <pod_newline>
+         ||  <.panic: '=begin without matching =end'>
+        ]
+    }
+
+    token pod_block:sym<delimited_raw> {
+        ^^ \h* '=begin' \h+ <!before 'END'>
+                        $<type>=[ 'code' || 'comment' ]
+                        <pod_newline>+
+        [
+         $<pod_content> = [ .*? ]
+         ^^ \h* '=end' \h+ $<type> <pod_newline>
+         ||  <.panic: '=begin without matching =end'>
         ]
     }
 
+    token pod_block:sym<end> {
+        ^^ \h*
+        [
+            || '=begin' \h+ 'END' <pod_newline>
+            || '=for'   \h+ 'END' <pod_newline>
+            || '=END' \h+
+        ]
+        .*
+    }
+
+    token pod_block:sym<paragraph> {
+        ^^
+        $<spaces> = [ \h* ]
+        {}
+        :my $*VMARGIN := $<spaces>.to - $<spaces>.from;
+        :my $*ALLOW_CODE := 0;
+        '=for' \h+ <!before 'END'>
+        $<type> = [
+            <pod_code_parent> { $*ALLOW_CODE := 1 }
+            || <identifier>
+        ]
+
+        <pod_newline>
+        $<pod_content> = <pod_textcontent>?
+    }
+
+    token pod_block:sym<paragraph_raw> {
+        ^^ \h* '=for' \h+ <!before 'END'>
+                          $<type>=[ 'code' || 'comment' ]
+                          <pod_newline>
+        $<pod_content> = <pod_text_para>
+    }
+
+    token pod_block:sym<abbreviated> {
+        ^^
+        $<spaces> = [ \h* ]
+        {}
+        :my $*VMARGIN := $<spaces>.to - $<spaces>.from;
+        :my $*ALLOW_CODE := 0;
+        '=' <!before begin || end || for || END>
+        $<type> = [
+            <pod_code_parent> { $*ALLOW_CODE := 1 }
+            || <identifier>
+        ]
+        \s
+        $<pod_content> = <pod_textcontent>?
+    }
+
+    token pod_block:sym<abbreviated_raw> {
+        ^^ \h* '=' $<type>=[ 'code' || 'comment' ] \s
+        $<pod_content> = <pod_text_para> *
+    }
+
+    token pod_newline {
+        \h* \n
+    }
+
+    token pod_code_parent {
+        'pod' <!before \w> || 'item' \d* <!before \w>
+        # TODO: Also Semantic blocks one day
+    }
+
     ## Top-level rules
 
     token comp_unit {
@@ -185,6 +299,9 @@ grammar Perl6::Grammar is HLL::Grammar {
         :my $*FORBID_PIR := 0;                     # whether pir::op and Q:PIR { } are disallowed
         :my $*HAS_YOU_ARE_HERE := 0;               # whether {YOU_ARE_HERE} has shown up
         :my $*TYPENAME := '';
+        :my $*VMARGIN    := 0;
+        :my $*ALLOW_CODE := 0;
+
 
         # Various interesting scopes we'd like to keep to hand.
         :my $*GLOBALish;