[svn:parrot] r36156 - in trunk/languages/pod: . src/Pod/DocTree src/parser

[kjs at svn.parrot.org]

Author: kjs
Date: Thu Jan 29 20:54:52 2009
New Revision: 36156
URL: https://trac.parrot.org/parrot/log/branches?rev=36156

Log:
[pod] add Pod::DocTree::File class
+ add placeholder actions
+ create a subclass of HLLCompiler. This doesn't work yet. at all.

Modified:
   trunk/languages/pod/pod.pir
   trunk/languages/pod/src/Pod/DocTree/Node.pir
   trunk/languages/pod/src/parser/actions.pm
   trunk/languages/pod/src/parser/grammar.pg

Modified: trunk/languages/pod/pod.pir
==============================================================================
--- trunk/languages/pod/pod.pir	Thu Jan 29 20:49:39 2009	(r36155)
+++ trunk/languages/pod/pod.pir	Thu Jan 29 20:54:52 2009	(r36156)
@@ -21,6 +21,11 @@
 
 =cut
 
+.sub 'print'
+    .param string arg
+    print arg
+.end
+
 .HLL 'pod'
 
 .namespace [ 'Pod';'Compiler' ]
@@ -40,13 +45,20 @@
 .include 'src/gen_actions.pir'
 
 .sub 'onload' :anon :load :init
+    load_bytecode 'PCT.pbc'
     $P0 = get_hll_global ['PCT'], 'HLLCompiler'
-    $P1 = $P0.'new'()
+    $P2 = subclass $P0, 'PODCompiler'
+    $P1 = $P2.'new'()
     $P1.'language'('pod')
     $P0 = get_hll_namespace ['Pod';'Grammar']
     $P1.'parsegrammar'($P0)
     $P0 = get_hll_namespace ['Pod';'Grammar';'Actions']
     $P1.'parseactions'($P0)
+
+
+    ##  set the compilation stages in the @stages attribute
+    $P0 = split ' ', 'parse doctree'
+    setattribute $P1, '@stages', $P0
 .end
 
 =item main(args :slurpy)  :main
@@ -63,6 +75,8 @@
     $P1 = $P0.'command_line'(args)
 .end
 
+.include 'src/Pod/DocTree/Node.pir'
+
 =back
 
 =cut

Modified: trunk/languages/pod/src/Pod/DocTree/Node.pir
==============================================================================
--- trunk/languages/pod/src/Pod/DocTree/Node.pir	Thu Jan 29 20:49:39 2009	(r36155)
+++ trunk/languages/pod/src/Pod/DocTree/Node.pir	Thu Jan 29 20:54:52 2009	(r36156)
@@ -19,6 +19,7 @@
     parent = get_class ['PCT';'Node']
     base = p6meta.'new_class'('Pod;DocTree;Node', 'parent'=>parent)
 
+    p6meta.'new_class'('Pod;DocTree;File',        'parent'=>base)
     p6meta.'new_class'('Pod;DocTree;Heading',     'parent'=>base)
     p6meta.'new_class'('Pod;DocTree;Block',       'parent'=>base)
     p6meta.'new_class'('Pod;DocTree;List',        'parent'=>base)
@@ -50,6 +51,13 @@
 
 Other node attributes are generally defined by subclasses of C<Pod;DocTree;Node>.
 
+=head2 Pod;DocTree;File
+
+A C<Pod;DocTree;File> node represents a file containing Pod. As such, it's
+the C<root> node of the Pod parse tree. The C<name> attribute contains the
+name of the file.
+
+
 =head2 Pod;DocTree;Heading
 
 C<Pod;DocTree;Heading> nodes represent heading directives in the Pod document

Modified: trunk/languages/pod/src/parser/actions.pm
==============================================================================
--- trunk/languages/pod/src/parser/actions.pm	Thu Jan 29 20:49:39 2009	(r36155)
+++ trunk/languages/pod/src/parser/actions.pm	Thu Jan 29 20:54:52 2009	(r36156)
@@ -17,26 +17,25 @@
 
 class Pod::Grammar::Actions;
 
+
+
 method TOP($/) {
-    my $rootblock;
+    my $file := Pod::DocTree::File.new();
 
     for $<pod_section> {
-        $rootblock.push( $( $_  ) );
+        $file.push( $( $_ ) );
     }
-
-    make $rootblock;
+    make $file;
 }
 
-method skipped($/) {
-
-}
 
 method pod_section($/) {
-    for $<pod_sequence> {
-        ## XXX store it where? A block?
-        $( $_ );
-    }
-    make $( $<pod_sequence>[0] );
+    #for $<pod_sequence> {
+    #    ## XXX store it where? A block?
+    #    $( $_ );
+    #}
+    #make $( $<pod_sequence>[0] );
+    make Pod::DocTree::Text.new( :name("pod-section"));
 }
 
 method pod_sequence($/, $key) {
@@ -44,11 +43,11 @@
 }
 
 method pod_directive($/) {
-
+    make Pod::DocTree::Text.new( :name("pod-directive") );
 }
 
 method cut_directive($/) {
-
+    make Pod::DocTree::Text.new( :name("cut-directive") );
 }
 
 
@@ -61,6 +60,7 @@
 }
 
 method heading($/) {
+    say("heading");
     my $heading := Pod::DocTree::Heading.new();
     ## set the level of the heading
     $heading.level($<digit>);
@@ -83,18 +83,20 @@
 
 
 method end_directive($/) {
-
+    make Pod::DocTree::Text.new( :name("end-directive") );
 }
+
 method for_directive($/) {
     # use same code as in begin-directive.
+    make Pod::DocTree::Text.new( :name("for-directive") );
 }
 
 method over_directive($/) {
-
+    make Pod::DocTree::Text.new( :name("over-directive") );
 }
 
 method back_directive($/) {
-
+    make Pod::DocTree::Text.new( :name("back-directive") );
 }
 
 method item_directive($/) {
@@ -104,15 +106,15 @@
 }
 
 method encoding_directive($/) {
-
+    make Pod::DocTree::Text.new( :name("encoding-directive") );
 }
 
 method paragraph($/) {
-
+    make Pod::DocTree::Text.new( :name("paragraph") );
 }
 
 method literal_paragraph($/) {
-
+    make Pod::DocTree::Text.new( :name("literal-paragraph") );
 }
 
 method block_name($/) {
@@ -125,13 +127,10 @@
 }
 
 method format_code($/) {
-
+    make Pod::DocTree::Text.new( :name("format-code") );
 }
 
-## XXX not sure if this needs action method is needed.
-method pod_ws($/) {
 
-}
 
 # Local Variables:
 #   mode: cperl

Modified: trunk/languages/pod/src/parser/grammar.pg
==============================================================================
--- trunk/languages/pod/src/parser/grammar.pg	Thu Jan 29 20:49:39 2009	(r36155)
+++ trunk/languages/pod/src/parser/grammar.pg	Thu Jan 29 20:54:52 2009	(r36156)
@@ -18,7 +18,7 @@
 
 rule skipped {
     ^^ <![=]> \N*
-    {*}
+
 }
 
 rule pod_section {
@@ -168,7 +168,7 @@
 }
 
 regex format_code {
-    <[BCEFILSXZ]>
+    $<code>=<[BCEFILSXZ]>
     [ '<<<' <formatted_text> '>>>'
     | '<<'  <formatted_text> '>>'
     | '<'   <formatted_text> '>'
@@ -178,7 +178,6 @@
 
 token pod_ws {
     [ ' ' | \t ]+ # Literal spaces or tabs, no newlines or other whitespace
-    {*}
 }
 
 token blank_line { ^^ <.pod_ws>? \n }