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

kjs at svn.parrot.org kjs at svn.parrot.org
Wed Feb 4 22:35:41 UTC 2009


Author: kjs
Date: Wed Feb  4 22:35:40 2009
New Revision: 36363
URL: https://trac.parrot.org/parrot/changeset/36363

Log:
[pod] heavily fix languages/pod, based on fperrad++ 's Markdown implementation (not in repository).

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	Wed Feb  4 21:37:50 2009	(r36362)
+++ trunk/languages/pod/pod.pir	Wed Feb  4 22:35:40 2009	(r36363)
@@ -1,14 +1,35 @@
+# Copyright (C) 2009, The Perl Foundation.
+# $Id$
+
 =head1 TITLE
 
 pod.pir - A Pod compiler.
 
-=head2 Description
+=head1 SYNOPSIS
 
-This is the base file for the Pod compiler.
+as a command line (without interactive mode) :
+
+    $ parrot markdown.pbc document.text
+    $ parrot markdown.pbc --target=parse document.text
+                                   PAST
+                                   HTML
+
+or as a library :
+
+     load_bytecode 'markdown.pbc'
+     $P0 = compreg 'markdown'
+     $S0 = <<'MARKDOWN'
+ Title
+ =====
+ Some text.
+ MARKDOWN
+     $P1 = $P0.'compile'($S0)
+     $S0 = $P1()
+     print $S0
 
-This file includes the parsing and grammar rules from
-the src/ directory, loads the relevant PGE libraries,
-and registers the compiler under the name 'Pod'.
+=head1 DESCRIPTION
+
+This is the base file for the Pod compiler.
 
 =head2 Functions
 
@@ -21,59 +42,27 @@
 
 =cut
 
+.namespace [ 'Pod';'Compiler' ]
 
+.sub 'onload' :anon :load :init
+    load_bytecode 'PCT.pbc'
 
-.HLL 'pod'
-
-.loadlib 'pod_group'
-
-.include 'src/Pod/DocTree/Node.pir'
-
-.namespace [ 'Pod';'DocTree';'Compiler' ]
-
-.sub 'to_html' :method
-    .param pmc node
-    .param pmc adverbs :slurpy :named
-.end
-
-.sub 'as_html' :method :multi(_,['Pod';'DocTree';'File'])
-    .param pmc node
-    .local string html
-    html = "<html>"
-
-
-    html .= "</html>"
-
-    .return (html)
-.end
-
-
-.sub 'as_html' :method :multi(_,['Pod';'DocTree';'Heading'])
-    .param pmc node
-    .local string html
-    .local string level
-    # create opening heading tag, e.g. <h1>
-    html = "<h"
-    $I0  = node."level"()
-    level = $I0
-    html .= level
-    html .= ">"
-
-    # create closin heading tag, e.g. </h1>
-    html .= "</h"
-    html .= level
-    html .= ">"
-
+    .local pmc p6meta
+    p6meta = new 'P6metaclass'
+    $P0 = p6meta.'new_class'('Pod::Compiler', 'parent'=>'PCT::HLLCompiler')
+    $P1 = $P0.'new'()
+    $P1.'language'('pod')
+    $P1.'parsegrammar'('Pod::Grammar')
+    $P1.'parseactions'('Pod::Grammar::Actions')
+    $P1.'removestage'('post')
+    $P1.'addstage'('html', 'before' => 'pir')
 .end
 
+=item html(source [, adverbs :slurpy :named])
 
+Transform Pod AST C<source> into a String containing HTML.
 
-.namespace [ 'Pod';'Compiler' ]
-
-.sub 'doctree' :method
-    .param pmc node
-    .param pmc adverbs :slurpy :named
-.end
+=cut
 
 .sub 'html' :method
     .param pmc source
@@ -84,38 +73,25 @@
 .end
 
 
+.sub 'pir' :method
+    .param pmc source
+    .param pmc adverbs         :slurpy :named
 
-.sub '' :anon :load :init
-    load_bytecode 'PCT.pbc'
-    .local pmc parrotns, hllns, exports
-    parrotns = get_root_namespace ['parrot']
-    hllns = get_hll_namespace
-    exports = split ' ', 'PAST PCT PGE'
-    parrotns.'export_to'(hllns, exports)
+    new $P0, 'CodeString'
+    $P0 = <<'PIRCODE'
+.sub 'main' :anon
+    $S0 = <<'PIR'
+PIRCODE
+    $P0 .= source
+    $P0 .= <<'PIRCODE'
+PIR
+    .return ($S0)
 .end
-
-.include 'src/gen_grammar.pir'
-.include 'src/gen_actions.pir'
-
-.sub 'onload' :anon :load :init
-    load_bytecode 'PCT.pbc'
-    $P0 = get_class ['PCT';'HLLCompiler']
-    $P2 = subclass $P0, ['Pod';'Compiler']
-    $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 html'
-    setattribute $P1, '@stages', $P0
+PIRCODE
+    .return ($P0)
 .end
 
 
-
 =item main(args :slurpy)  :main
 
 Start compilation by passing any command line C<args>
@@ -126,15 +102,27 @@
 .sub 'main' :main
     .param pmc args
 
+    load_bytecode 'dumper.pbc'
+    load_bytecode 'PGE/Dumper.pbc'
+
     $P0 = compreg 'pod'
-    $P1 = $P0.'command_line'(args)
+
+    .local pmc opts
+    opts = $P0.'process_args'(args)
+
+    $P1 = $P0.'evalfiles'(args, opts :flat :named)
+    print $P1
 .end
 
 
+.include 'src/gen_grammar.pir'
+.include 'src/gen_actions.pir'
+#.include 'src/gen_builtins.pir'
+.include 'src/Pod/DocTree/node.pir'
+
 
 =back
 
-=cut
 
 # Local Variables:
 #   mode: pir

Modified: trunk/languages/pod/src/Pod/DocTree/Node.pir
==============================================================================
--- trunk/languages/pod/src/Pod/DocTree/Node.pir	Wed Feb  4 21:37:50 2009	(r36362)
+++ trunk/languages/pod/src/Pod/DocTree/Node.pir	Wed Feb  4 22:35:40 2009	(r36363)
@@ -1,37 +1,44 @@
+# Copyright (C) 2009, The Perl Foundation.
+# $Id$
+
 =head1 NAME
 
-Pod;DocTree - Pod Document Tree
+Pod DocTree nodes.
 
 =head1 DESCRIPTION
 
-This file implements the various node types for Pod;DocTree, a tree
-representation of a Pod document.
+This file implements the various abstract syntax tree nodes
+for Pod.
 
 =cut
 
 .namespace [ 'Pod';'DocTree';'Node' ]
 
 .sub 'onload' :anon :load :init
-    ##   create the Pod;DocTree;Node base class
-    load_bytecode 'P6object.pbc'
-    .local pmc p6meta, parent, base
+    .local pmc p6meta, base
     p6meta = new 'P6metaclass'
-    parent = get_class ['PCT';'Node']
-    base = p6meta.'new_class'('Pod::DocTree::Node', 'parent'=>parent)
+    base = p6meta.'new_class'('Pod::DocTree::Node', 'parent'=>'PAST::Node')
 
-    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)
-    p6meta.'new_class'('Pod::DocTree::Item',        'parent'=>base)
-    p6meta.'new_class'('Pod::DocTree::Text',        'parent'=>base)
-    p6meta.'new_class'('Pod::DocTree::Format',      'parent'=>base)
-    p6meta.'new_class'('Pod::DocTree::Paragraph',   'parent'=>base)
-    p6meta.'new_class'('Pod::DocTree::Literal',     'parent'=>base)
+    p6meta.'new_class'('Pod::DocTree::File', 'parent'=>base)
+    p6meta.'new_class'('Pod::DocTree::Heading', 'parent'=>base)
+    p6meta.'new_class'('Pod::DocTree::Text', 'parent'=>base)
+    p6meta.'new_class'('Pod::DocTree::Block', 'parent'=>base)
+
+    p6meta.'new_class'('Markdown::Emphasis', 'parent'=>base)
+    p6meta.'new_class'('Markdown::Entity', 'parent'=>base)
+    p6meta.'new_class'('Markdown::HorizontalRule', 'parent'=>base)
+    p6meta.'new_class'('Markdown::ItemizedList', 'parent'=>base)
+    p6meta.'new_class'('Markdown::Line', 'parent'=>base)
+    p6meta.'new_class'('Markdown::ListItem', 'parent'=>base)
+    p6meta.'new_class'('Markdown::OrderedList', 'parent'=>base)
+    p6meta.'new_class'('Markdown::Para', 'parent'=>base)
+    p6meta.'new_class'('Markdown::Space', 'parent'=>base)
+    p6meta.'new_class'('Markdown::Strong', 'parent'=>base)
+    p6meta.'new_class'('Markdown::Title', 'parent'=>base)
+    p6meta.'new_class'('Markdown::Word', 'parent'=>base)
 .end
 
 
-
 =head1 Pod;DocTree Node Types
 
 =head2 Pod;DocTree;Node
@@ -201,6 +208,132 @@
 
 =cut
 
+
+
+=head1 NAME
+
+Pod::HTML::Compiler - Pod AST Compiler
+
+=head1 DESCRIPTION
+
+Pod::HTML::Compiler implements a compiler for Pod AST nodes.
+
+=head1 METHODS
+
+=over
+
+=cut
+
+.namespace [ 'Pod';'HTML';'Compiler' ]
+
+.sub '__onload' :anon :load :init
+    $P0 = get_hll_global 'P6metaclass'
+    $P0 = $P0.'new_class'('Pod::HTML::Compiler')
+.end
+
+.sub 'to_html' :method
+    .param pmc past
+    .param pmc adverbs         :slurpy :named
+
+    .tailcall self.'html'(past)
+.end
+
+.sub 'xml_escape' :anon
+    .param string str
+    $P0 = split '&', str
+    str = join '&amp;', $P0
+    $P0 = split '<', str
+    str = join '&lt;', $P0
+    $P0 = split '>', str
+    str = join '&gt;', $P0
+    .return (str)
+.end
+
+=item html_children(node)
+
+Return generated HTML for all of its children.
+
+=cut
+
+.sub 'html_children' :method
+    .param pmc node
+    .local pmc code, iter
+    code = new 'CodeString'
+    iter = node.'iterator'()
+  iter_loop:
+    unless iter goto iter_end
+    .local pmc cpast
+    cpast = shift iter
+    $P0 = self.'html'(cpast)
+    code .= $P0
+    goto iter_loop
+  iter_end:
+    .return (code)
+.end
+
+
+=item html(Any node)
+
+=cut
+
+.sub 'html' :method :multi(_,_)
+    .param pmc node
+    .tailcall self.'html_children'(node)
+.end
+
+
+=item html(Pod::DocTree::File node)
+
+=cut
+
+.sub 'html' :method :multi(_,['Pod';'DocTree';'File'])
+    .param pmc node
+    .tailcall self.'html_children'(node)
+.end
+
+
+=item html(Pod::DocTree::Heading node)
+
+=cut
+
+.sub 'html' :method :multi(_,['Pod';'DocTree';'Heading'])
+    .param pmc node
+    .local pmc code
+    new code, 'CodeString'
+    $S0 = "<h"
+    $S1 = node.'level'()
+    $S0 .= $S1
+    $S0 .= ">"
+    set code, $S0
+
+    .return (code)
+.end
+
+
+=item html(Pod::DocTree::Text node)
+
+=cut
+
+.sub 'html' :method :multi(_,['Pod';'DocTree';'Text'])
+    .param pmc node
+    #$S1 = self.'html_children'(node)
+    #$S2 = node.'level'()
+    .local pmc code
+    new code, 'CodeString'
+    $S0 = "<text>"
+    set code, $S0
+    .return (code)
+.end
+
+
+
+=back
+
+=cut
+
+
+
+
 # Local Variables:
 #   mode: pir
 #   fill-column: 100

Modified: trunk/languages/pod/src/parser/actions.pm
==============================================================================
--- trunk/languages/pod/src/parser/actions.pm	Wed Feb  4 21:37:50 2009	(r36362)
+++ trunk/languages/pod/src/parser/actions.pm	Wed Feb  4 22:35:40 2009	(r36363)
@@ -15,122 +15,37 @@
 
 =end comments
 
-class Pod::Grammar::Actions;
-
+=cut
 
+class Pod::Grammar::Actions;
 
 method TOP($/) {
-    my $file := Pod::DocTree::File.new();
-
+    my $past := Pod::DocTree::File.new();
     for $<pod_section> {
-        $file.push( $( $_ ) );
+        $past.push( $( $_ ) );
     }
-    make $file;
+    make $past;
 }
 
-
 method pod_section($/) {
-    #for $<pod_sequence> {
-    #    ## XXX store it where? A block?
-    #    $( $_ );
-    #}
-    #make $( $<pod_sequence>[0] );
-    make Pod::DocTree::Text.new( :name("pod-section"));
+    my $pod := Pod::DocTree::Block.new();
+    for $<pod_sequence> {
+        $pod.push( $( $_ ) );
+    }
+    make $pod
 }
 
 method pod_sequence($/, $key) {
     make $( $/{$key} );
 }
 
-method pod_directive($/) {
-    make Pod::DocTree::Text.new( :name("pod-directive") );
-}
-
-method cut_directive($/) {
-    make Pod::DocTree::Text.new( :name("cut-directive") );
-}
-
-
-
-sub title($/, $block) {
-    if $<block_title> {
-        my $title := $( $<block_title>[0] );
-        $block.title( $title.name() );
-    }
-}
 
 method heading($/) {
-    my $heading := Pod::DocTree::Heading.new();
-
-    ## set the level of the heading
-    $heading.level($<digit>);
-
-    title($/, $heading);
-
-    make $heading;
-}
-
-
-method begin_directive($/) {
-    my $block := Pod::DocTree::Block.new();
-    my $name  := $( $<block_name> );
-    $block.name( $name.name() );
-
-    title($/, $block);
-
-    make $block;
-}
-
-
-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($/) {
-    my $item := Pod::DocTree::Item.new();
-
-    make $item;
-}
-
-method encoding_directive($/) {
-    make Pod::DocTree::Text.new( :name("encoding-directive") );
+    my $head := Pod::DocTree::Heading.new();
+    $head.level(~$<digit>);
+    make $head;
 }
 
-method paragraph($/) {
-    make Pod::DocTree::Text.new( :name("paragraph") );
-}
-
-method literal_paragraph($/) {
-    make Pod::DocTree::Text.new( :name("literal-paragraph") );
-}
-
-method block_name($/) {
-    ## XXX fix: only match the non-whitespace text
-    make Pod::DocTree::Text.new( :name( $/ ) );
-}
-
-method block_title($/) {
-    make Pod::DocTree::Text.new( :name( $<formatted_text> ) );
-}
-
-method format_code($/) {
-    make Pod::DocTree::Text.new( :name("format-code") );
-}
-
-
 
 # Local Variables:
 #   mode: cperl
@@ -138,4 +53,3 @@
 #   fill-column: 100
 # End:
 # vim: expandtab shiftwidth=4:
-

Modified: trunk/languages/pod/src/parser/grammar.pg
==============================================================================
--- trunk/languages/pod/src/parser/grammar.pg	Wed Feb  4 21:37:50 2009	(r36362)
+++ trunk/languages/pod/src/parser/grammar.pg	Wed Feb  4 22:35:40 2009	(r36363)
@@ -1,3 +1,4 @@
+# Copyright (C) 2009, The Perl Foundation.
 # $Id$
 
 =begin overview
@@ -6,6 +7,8 @@
 
 =end overview
 
+=cut
+
 grammar Pod::Grammar is PCT::Grammar;
 
 rule TOP {
@@ -44,13 +47,13 @@
 token pod_directive {
     ^^ '=pod' \n
     <.blank_line>
-    {*}
+
 }
 
 token cut_directive {
     ^^ '=cut' \n
     <.blank_line>?
-    {*}
+
 }
 
 token heading {
@@ -70,7 +73,7 @@
     <block_title>?
     \n
     <.blank_line>
-    {*}
+
 }
 
 token end_directive {
@@ -78,7 +81,7 @@
     <block_name>
     \n
     <.blank_line>
-    {*}
+
 }
 
 token for_directive {
@@ -88,7 +91,7 @@
     <block_title>?
     \n
     <paragraph>
-    {*}
+
 }
 
 token over_directive {
@@ -100,13 +103,13 @@
     ]?
     \n
     <.blank_line>
-    {*}
+
 }
 
 token back_directive {
     ^^ '=back' \n
     <.blank_line>
-    {*}
+
 }
 
 token item_directive {
@@ -119,7 +122,7 @@
     ]?
     \n
     <.blank_line>
-    {*}
+
 }
 
 token encoding_directive {
@@ -128,7 +131,7 @@
     <block_name>
     \n
     <.blank_line>
-    {*}
+
 }
 
 regex paragraph {
@@ -136,26 +139,26 @@
     <!before '='>           # Not a directive
     [ <formatted_text> \n ]+
     <.blank_line>
-    {*}
+
 }
 
 regex literal_paragraph {
     ^^
     [ <.pod_ws> <formatted_text> \n ]+
     <.blank_line>
-    {*}
+
 }
 
 token block_name {
     <.pod_ws>
     <[_]+alpha+digit>+
-    {*}
+
 }
 
 token block_title {
     <.pod_ws>
     <formatted_text>
-    {*}
+
 }
 
 regex formatted_text {
@@ -173,7 +176,7 @@
     | '<<'  <formatted_text> '>>'
     | '<'   <formatted_text> '>'
     ]
-    {*}
+
 }
 
 token pod_ws {
@@ -182,6 +185,7 @@
 
 token blank_line { ^^ <.pod_ws>? \n }
 
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4


More information about the parrot-commits mailing list