Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Move pod related metod from Actions.pm to Pod.pm
  • Loading branch information
Tadeusz Sośnierz committed Jul 10, 2011
1 parent 93c4425 commit 076e348
Show file tree
Hide file tree
Showing 3 changed files with 94 additions and 83 deletions.
90 changes: 9 additions & 81 deletions src/Perl6/Actions.pm
@@ -1,4 +1,5 @@
use NQPP6Regex;
use Perl6::Pod;

INIT {
# Add our custom nqp:: opcodes.
Expand Down Expand Up @@ -234,99 +235,34 @@ class Perl6::Actions is HLL::Actions {
}

method pod_block:sym<paragraph>($/) {
make self.any_block($/);
make Perl6::Pod::any_block($/);
}

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

method pod_block:sym<abbreviated>($/) {
make self.any_block($/);
make Perl6::Pod::any_block($/);
}

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

method pod_block:sym<end>($/) {
}

method pod_block:sym<delimited>($/) {
make self.any_block($/);
make Perl6::Pod::any_block($/);
}

method pod_block:sym<delimited_raw>($/) {
make self.raw_block($/);
}

method any_block($/) {
my @children := [];
for $<pod_content> {
# not trivial, for it can be either an array or a pod node
# and we can't really flatten a list in nqp
# I hope there's a better way,
# but let's settle on this for now
if pir::isa($_.ast, 'ResizablePMCArray') {
for $_.ast {
@children.push($_);
}
} else {
@children.push($_.ast);
}
}
my $content := $*ST.add_constant(
'Array', 'type_new',
|@children,
);
if $<type>.Str ~~ /^item \d*$/ {
my $level := nqp::substr($<type>.Str, 4);
my $level_past;
if $level ne '' {
$level_past := $*ST.add_constant(
'Int', 'int', +$level,
)<compile_time_value>;
} else {
$level_past := $*ST.find_symbol(['Mu']);
}
my $past := $*ST.add_constant(
'Pod::Item', 'type_new',
:level($level_past),
:content($content<compile_time_value>),
);
return $past<compile_time_value>;
}
my $name := $*ST.add_constant('Str', 'str', $<type>.Str);
my $past := $*ST.add_constant(
'Pod::Block::Named', 'type_new',
:name($name<compile_time_value>),
:content($content<compile_time_value>),
);
return $past<compile_time_value>;
}

method raw_block($/) {
my $type;
my $str := $*ST.add_constant(
'Str', 'str',
pir::isa($<pod_content>, 'ResizablePMCArray')
?? pir::join('', $<pod_content>) !! ~$<pod_content>,
);
my $content := $*ST.add_constant(
'Array', 'type_new',
$str<compile_time_value>
);
my $past := $*ST.add_constant(
$<type>.Str eq 'code' ?? 'Pod::Block::Code'
!! 'Pod::Block::Comment',
'type_new',
:content($content<compile_time_value>),
);
return $past<compile_time_value>;
make Perl6::Pod::raw_block($/);
}

method pod_text_para($/) {
my $t := self.formatted_text($<text>.Str);
my $t := Perl6::Pod::formatted_text($<text>.Str);
my $past := $*ST.add_constant('Str', 'str', $t);
make $past<compile_time_value>;
}
Expand All @@ -340,7 +276,7 @@ class Perl6::Actions is HLL::Actions {
}

method pod_textcontent:sym<regular>($/) {
my $t := self.formatted_text($<text>.Str);
my $t := Perl6::Pod::formatted_text($<text>.Str);
my $past := $*ST.add_constant('Str', 'str', $t);
make $past<compile_time_value>;
}
Expand All @@ -361,14 +297,6 @@ class Perl6::Actions is HLL::Actions {
make $past<compile_time_value>;
}


method formatted_text($a) {
my $r := subst($a, /\s+/, ' ', :global);
$r := subst($r, /^^\s*/, '');
$r := subst($r, /\s*$$/, '');
return $r;
}

method unitstart($/) {
# Use SET_BLOCK_OUTER_CTX (inherited from HLL::Actions)
# to set dynamic outer lexical context and namespace details
Expand Down
76 changes: 76 additions & 0 deletions src/Perl6/Pod.pm
@@ -0,0 +1,76 @@
# various helper methods for Pod parsing and processing
class Perl6::Pod {
our sub any_block($/) {
my @children := [];
for $<pod_content> {
# not trivial, for it can be either an array or a pod node
# and we can't really flatten a list in nqp
# I hope there's a better way,
# but let's settle on this for now
if pir::isa($_.ast, 'ResizablePMCArray') {
for $_.ast {
@children.push($_);
}
} else {
@children.push($_.ast);
}
}
my $content := $*ST.add_constant(
'Array', 'type_new',
|@children,
);
if $<type>.Str ~~ /^item \d*$/ {
my $level := nqp::substr($<type>.Str, 4);
my $level_past;
if $level ne '' {
$level_past := $*ST.add_constant(
'Int', 'int', +$level,
)<compile_time_value>;
} else {
$level_past := $*ST.find_symbol(['Mu']);
}
my $past := $*ST.add_constant(
'Pod::Item', 'type_new',
:level($level_past),
:content($content<compile_time_value>),
);
return $past<compile_time_value>;
}
my $name := $*ST.add_constant('Str', 'str', $<type>.Str);
my $past := $*ST.add_constant(
'Pod::Block::Named', 'type_new',
:name($name<compile_time_value>),
:content($content<compile_time_value>),
);
return $past<compile_time_value>;
}

our sub raw_block($/) {
my $type;
my $str := $*ST.add_constant(
'Str', 'str',
pir::isa($<pod_content>, 'ResizablePMCArray')
?? pir::join('', $<pod_content>) !! ~$<pod_content>,
);
my $content := $*ST.add_constant(
'Array', 'type_new',
$str<compile_time_value>
);
my $past := $*ST.add_constant(
$<type>.Str eq 'code' ?? 'Pod::Block::Code'
!! 'Pod::Block::Comment',
'type_new',
:content($content<compile_time_value>),
);
return $past<compile_time_value>;
}

our sub formatted_text($a) {
my $r := subst($a, /\s+/, ' ', :global);
$r := subst($r, /^^\s*/, '');
$r := subst($r, /\s*$$/, '');
return $r;
}
}

# vim: ft=perl6
11 changes: 9 additions & 2 deletions tools/build/Makefile.in
Expand Up @@ -62,6 +62,8 @@ PERL6_G = src/gen/perl6-grammar.pir
PERL6_G_PBC = blib/Perl6/Grammar.pbc
PERL6_A = src/gen/perl6-actions.pir
PERL6_A_PBC = blib/Perl6/Actions.pbc
PERL6_P = src/gen/perl6-pod.pir
PERL6_P_PBC = blib/Perl6/Pod.pbc
PERL6_C = src/gen/perl6-compiler.pir
PERL6_C_PBC = blib/Perl6/Compiler.pbc
PERL6_M = src/gen/perl6-metamodel.pir
Expand Down Expand Up @@ -246,7 +248,7 @@ $(PERL6_EXE): $(PERL6_PBC)
$(PBC_TO_EXE) $(PERL6_PBC)

# the complete compiler, including core/setting
$(PERL6_PBC): $(PERL6_G_PBC) $(PERL6_A_PBC) $(PERL6_C_PBC) src/main.nqp
$(PERL6_PBC): $(PERL6_G_PBC) $(PERL6_A_PBC) $(PERL6_C_PBC) $(PERL6_P_PBC) src/main.nqp
$(PERL) tools/build/gen-version.pl >src/gen/main-version.nqp
$(NQP_EXE) --vmlibs=perl6_group,perl6_ops --target=pir --output=src/gen/perl6.pir \
--combine src/main.nqp src/gen/main-version.nqp
Expand All @@ -267,11 +269,16 @@ $(PERL6_G_PBC): $(NQP_EXE) $(PERL6_ST_PBC) src/Perl6/Grammar.pm
src/Perl6/Grammar.pm
$(PARROT) $(PARROT_ARGS) -o $(PERL6_G_PBC) $(PERL6_G)

$(PERL6_A_PBC): $(NQP_EXE) $(DYNEXT_TARGET) src/Perl6/Actions.pm
$(PERL6_A_PBC): $(NQP_EXE) $(DYNEXT_TARGET) src/Perl6/Actions.pm $(PERL6_P_PBC)
$(NQP_EXE) --vmlibs=perl6_group,perl6_ops --target=pir --output=$(PERL6_A) --encoding=utf8 \
src/Perl6/Actions.pm
$(PARROT) $(PARROT_ARGS) -o $(PERL6_A_PBC) $(PERL6_A)

$(PERL6_P_PBC): $(NQP_EXE) $(DYNEXT_TARGET) src/Perl6/Pod.pm
$(NQP_EXE) --vmlibs=perl6_group,perl6_ops --target=pir --output=$(PERL6_P) --encoding=utf8 \
src/Perl6/Pod.pm
$(PARROT) $(PARROT_ARGS) -o $(PERL6_P_PBC) $(PERL6_P)

$(PERL6_C_PBC): $(NQP_EXE) $(DYNEXT_TARGET) src/Perl6/Compiler.nqp
$(NQP_EXE) --target=pir --output=$(PERL6_C) --encoding=utf8 \
src/Perl6/Compiler.nqp
Expand Down

0 comments on commit 076e348

Please sign in to comment.