From 9b37b2290e12eead598bbac51361202700cbff8e Mon Sep 17 00:00:00 2001 From: Peter Stuifzand Date: Sat, 17 Mar 2012 20:01:49 +0100 Subject: [PATCH] Generates packages instead of programs --- Makefile | 7 ++ bin/marp | 7 ++ examples/add/add.mp | 7 +- examples/add/add.pl | 7 ++ examples/htmlgen/htmlgen.mp | 23 ++++ examples/htmlgen/htmlgen.pl | 19 ++++ examples/htmlgen/htmlgenprog.pl | 131 +++++++++++++++++++++++ examples/htmlgen/test.htmlgen | 12 +++ examples/lisp/lisp.mp | 12 +++ examples/lisp/test.lsp | 1 + lib/Marp/App.pm | 42 ++++++++ lib/MarpaX/CodeGen.pm | 111 +++++++++++-------- lib/MarpaX/CodeGen/Dumper.pm | 22 ++++ lib/MarpaX/CodeGen/HTMLGen.pm | 135 +++++++++++++++++++++++ lib/MarpaX/CodeGen/Marpa.pm | 22 ++++ lib/MarpaX/CodeGen/SimpleLex.pm | 182 ++++++++++++++++++++++++++++++++ lib/MarpaX/SimpleLexer.pm | 34 +++--- marpa+.mp | 30 ++++++ marpa.mp | 2 +- marpa_parser.pl | 4 + 20 files changed, 749 insertions(+), 61 deletions(-) create mode 100755 bin/marp create mode 100644 examples/add/add.pl create mode 100644 examples/htmlgen/htmlgen.mp create mode 100644 examples/htmlgen/htmlgen.pl create mode 100644 examples/htmlgen/htmlgenprog.pl create mode 100644 examples/htmlgen/test.htmlgen create mode 100644 examples/lisp/lisp.mp create mode 100644 examples/lisp/test.lsp create mode 100644 lib/Marp/App.pm create mode 100644 lib/MarpaX/CodeGen/Dumper.pm create mode 100644 lib/MarpaX/CodeGen/HTMLGen.pm create mode 100644 lib/MarpaX/CodeGen/Marpa.pm create mode 100644 lib/MarpaX/CodeGen/SimpleLex.pm create mode 100644 marpa+.mp diff --git a/Makefile b/Makefile index 99736ad..556e689 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,10 @@ +all: htmlgen + +htmlgen: htmlgen.pl test.htmlgen + perl $< test.htmlgen + +htmlgen.pl: htmlgen.mp + perl generated_marpa_parser3.pl $< > $@ generated_marpa_parser.pl: marpa_parser.pl marpa.mp perl -I lib marpa_parser.pl marpa.mp > $@ diff --git a/bin/marp b/bin/marp new file mode 100755 index 0000000..9a962b2 --- /dev/null +++ b/bin/marp @@ -0,0 +1,7 @@ +#!/usr/bin/env perl +use lib 'lib'; +use Marp::App; +my $app = Marp::App->new(); +$app->parse_args(@ARGV); +$app->run(); + diff --git a/examples/add/add.mp b/examples/add/add.mp index 5e6b21e..ddaf744 100644 --- a/examples/add/add.mp +++ b/examples/add/add.mp @@ -1,5 +1,6 @@ - Number = /\d+/ +Space = /[ \r\n\t]+/ - -Parser ::= Number {{ return $_[1]; }} +Parser ::= Number WS {{ return $_[1]; }} +WS ::= Null +WS ::= Space diff --git a/examples/add/add.pl b/examples/add/add.pl new file mode 100644 index 0000000..f4c5b0f --- /dev/null +++ b/examples/add/add.pl @@ -0,0 +1,7 @@ + +use MarpaX::Parser::Number; +use Data::Dumper; + +my $p = MarpaX::Parser::Number->new(); +my $tree = $p->parse(*STDIN); +print Dumper($tree); diff --git a/examples/htmlgen/htmlgen.mp b/examples/htmlgen/htmlgen.mp new file mode 100644 index 0000000..07277c1 --- /dev/null +++ b/examples/htmlgen/htmlgen.mp @@ -0,0 +1,23 @@ +WS = /[ \t\n\r]+/ +Id = /([a-z]+)/ +Tag = /(\w+)/ +Char = /([^"])/ + +Parser ::= Tree+ {{ shift; return \@_; }} +Tree ::= Space Tag Block {{ shift; return { _tag => $_[1], _block => $_[2] } }} +Tree ::= Space Tag Attrs {{ shift; return { _tag => $_[1], _attrs => $_[2] } }} +Tree ::= Space Tag Attrs Block {{ shift; return { _tag => $_[1], _attrs => $_[2], _block => $_[3] } }} +Tree ::= Space AtId {{ shift; return $_[1]; }} +Tree ::= Space String Space {{ shift; return $_[1]; }} +Tree ::= Space $? AtId Space Block {{ shift; return { _if => $_[2], _block => $_[4] } }} +Block ::= Space ${ Space Parser Space $} Space {{ shift; return $_[3]; }} +Block ::= Space ${ $} {{ shift; return []; }} +Attrs ::= Attr+ {{ shift; return \@_; }} +Attr ::= Space Id $= String {{ shift; return { _id => $_[1], _string => $_[3] } }} +Attr ::= Space Id $= AtId {{ shift; return { _id => $_[1], _atid => $_[3] } }} +AtId ::= $@ Id {{ shift; return $_[0].$_[1]; }} +String ::= $" Chars $" {{ shift; return {_str => $_[1]} }} +Chars ::= Null +Chars ::= Char+ {{ shift; return join('', @_); }} +Space ::= Null +Space ::= WS diff --git a/examples/htmlgen/htmlgen.pl b/examples/htmlgen/htmlgen.pl new file mode 100644 index 0000000..935f6b0 --- /dev/null +++ b/examples/htmlgen/htmlgen.pl @@ -0,0 +1,19 @@ +use strict; +use lib 'lib'; +use Data::Dumper; + +use MarpaX::Parser::HTMLGen; +use MarpaX::CodeGen::HTMLGen; + +my $infile = $ARGV[0]; + +open my $fh, '<', $infile or die "Can't open '$infile'"; + +my $codegen = MarpaX::CodeGen::HTMLGen->new; + +my $parser = MarpaX::Parser::HTMLGen->new; +my $parse_tree = $parser->parse($fh); +print Dumper($parse_tree); + +$codegen->generate_code($parse_tree); + diff --git a/examples/htmlgen/htmlgenprog.pl b/examples/htmlgen/htmlgenprog.pl new file mode 100644 index 0000000..fcc2a75 --- /dev/null +++ b/examples/htmlgen/htmlgenprog.pl @@ -0,0 +1,131 @@ +#!/usr/bin/perl -w +use 5.14.1; +use Data::Dumper; + +sub load_program { + my ($fh) = @_; + + my @program; + my %labels; + my %strings; + + while (<$fh>) { + chomp; + + s/^\s+//; + + if (m/^\.STR\s+(\w+)\s(.*)$/) { + my $k = $1; + my $v = $2; + $v =~ s/\\n/\n/g; + $strings{$k} = $v; + } + elsif (m/^Emit\s+(\w+)/) { + my $k = $1; + push @program, [ 'Emit', $strings{$k} ]; + } + elsif (m/^Emit\s+\@(\w+)$/) { + my $key = $1; + push @program, [ 'Emit_Field', $key ]; + } + elsif (m/^Exists\s+\@(\w+)$/) { + my $key = $1; + push @program, [ 'Exists', $key ]; + } + elsif (m/^End$/) { + push @program, [ 'End' ]; + } + elsif (m/^JF\s+(\w+)$/) { + push @program, [ 'JF', $1 ]; + } + elsif (m/^JT\s+(\w+)$/) { + push @program, [ 'JE', $1 ]; + } + elsif (m/^(\w+):/) { + $labels{$1} = scalar @program; + } + } + return (\%labels, \@program); +} + +sub create_machine { + my $filename = shift; + + my %opcodes = ( + Emit => sub { print $_[1]; return $_[0]->{ip}+1 }, + Emit_Field => sub { print $_[0]->{data}{$_[1]}; return $_[0]->{ip}+1 }, + Exists => sub { $_[0]->{jmp_flag} = exists $_[0]->{data}{$_[1]}; return $_[0]->{ip}+1 }, + JF => sub { return !$_[0]->{jmp_flag} ? $_[0]->{labels}{$_[1]} : $_[0]->{ip}+1; }, + JT => sub { return $_[0]->{jmp_flag} ? $_[0]->{labels}{$_[1]} : $_[0]->{ip}+1; }, + End => sub { return -1; }, + ); + + open my $fh, '<', $filename or die "Can't open $filename"; + my ($labels, $program) = load_program($fh); + + return sub { + my ($data) = @_; + + my $machine = { + jmp_flag => 0, + ip => 0, + data => $data, + labels => $labels, + program => $program, + }; + + while ($machine->{ip} >= 0) { + my $instr = $program->[$machine->{ip}]; + $machine->{ip} = $opcodes{ $instr->[0] }->($machine, $instr->[1]); + } + } +} + +*output_html = create_machine($ARGV[0]); + +print <<"HEADER"; + +HEADER + +my @description = ( + { + id => 'sku', + name => 'sku', + description => 'Unieke code', + title => 'SKU', + }, + { + id => 'barcode', + name => 'barcode', + description => 'Niet verplicht', + title => 'Streepjescode', + }, + { + id => 'name', + name => 'name', + title => 'Naam', + description => 'Naam van uw product', + }, + { + id => 'price', + name => 'price', + title => 'Prijs', + description => 'In euro cent incl. btw', + }, +); + +for (@description) { + output_html($_); +} + diff --git a/examples/htmlgen/test.htmlgen b/examples/htmlgen/test.htmlgen new file mode 100644 index 0000000..cb72f3b --- /dev/null +++ b/examples/htmlgen/test.htmlgen @@ -0,0 +1,12 @@ +p { + label id=@id { @title } + " " + ?@description { + span class="description" { + "(" @description ")" + } + " " + } + input type="text" id=@id name=@name value=@value +} +"\n" diff --git a/examples/lisp/lisp.mp b/examples/lisp/lisp.mp new file mode 100644 index 0000000..cb2db38 --- /dev/null +++ b/examples/lisp/lisp.mp @@ -0,0 +1,12 @@ + +String = /"([^"]+)"/ +Number = /(\d+)/ +Symbol = /([a-z]+)/ + +Parser ::= Expression+ {{ shift; return \@_; }} +Expression ::= $( List $) {{ shift; return $_[1]; }} +List ::= Expression+ {{ shift; return \@_; }} +Expression ::= String {{ shift; return { string => $_[0] }; }} +Expression ::= Number {{ shift; return { number => $_[0] }; }} +Expression ::= Symbol {{ shift; return { symbol => $_[0] }; }} + diff --git a/examples/lisp/test.lsp b/examples/lisp/test.lsp new file mode 100644 index 0000000..992e94e --- /dev/null +++ b/examples/lisp/test.lsp @@ -0,0 +1 @@ +( add 10 10 1 9393 45 ) diff --git a/lib/Marp/App.pm b/lib/Marp/App.pm new file mode 100644 index 0000000..47b57c3 --- /dev/null +++ b/lib/Marp/App.pm @@ -0,0 +1,42 @@ +package Marp::App; +use 5.10.0; + +use strict; +use warnings; + +use MarpaX::Parser::Marpa; + +sub new { + my ($klass) = @_; + my $self = bless {}, $klass; + return $self; +} + +sub parse_args { + my ($self, @args) = @_; + $self->{infile} = $args[0]; + $self->{codegen} = $args[1]; + $self->{package} = $args[2]; + return; +} + +sub run { + my ($self) = @_; + + my $infile = $self->{infile}; + + open my $fh, '<', $infile or die "Can't open '$infile'"; + + my $codegen_class = $self->{codegen} // 'MarpaX::CodeGen::Dumper'; + eval "require $codegen_class"; + my $codegen = $codegen_class->new({package => $self->{package}}); + + my $parser = MarpaX::Parser::Marpa->new(); + my $parse_tree = $parser->parse($fh); + + $codegen->generate_code($parse_tree); + + return; +} + +1; diff --git a/lib/MarpaX/CodeGen.pm b/lib/MarpaX/CodeGen.pm index aaf88f4..9dc951d 100644 --- a/lib/MarpaX/CodeGen.pm +++ b/lib/MarpaX/CodeGen.pm @@ -5,11 +5,43 @@ use Data::Dumper; $Data::Dumper::Deepcopy = 1; use parent 'Exporter'; -our @EXPORT = qw/generate_code/; +our @EXPORT_OK = qw/generate_code/; + +sub find_inline_tokens { + my ($parse_tree) = @_; + my $c = 0; + + my %token_to_name; + + for my $rule (@{$parse_tree->{rules}}) { + my $i = 0; + for my $rhs (@{ $rule->{rhs} }) { + if (ref($rhs) eq 'HASH') { + if ($rhs->{token}) { + my $name; + if ($token_to_name{$rhs->{token}}) { + $name = $token_to_name{$rhs->{token}}; + } + else { + $name = 'TOK_'.$c; + $c++; + $token_to_name{$rhs->{token}} = $name; + push @{$parse_tree->{tokens}}, { lhs => $name, char => $rhs->{token} }; + } + $rule->{rhs}[$i] = $name; + } + } + } + continue { $i++; } + } + return; +} sub generate_code { my ($parse_tree, $config) = @_; + find_inline_tokens($parse_tree); + print <<'HEADER'; use strict; use FindBin '$Bin'; @@ -19,42 +51,7 @@ use Marpa::XS; use MarpaX::SimpleLexer; HEADER - if ($config->{dumper}) { - print <<'HEADER'; -use Data::Dumper; -HEADER - } - else { - print <<'HEADER'; -use MarpaX::CodeGen 'generate_code'; -HEADER - } - - print <<'HEADER'; -my %tokens = ( -HEADER - - for (@{ $parse_tree->{tokens} }) { - if ($_->{regex}) { - printf(" %-30s => qr/%s/,\n",$_->{lhs}, $_->{regex}); - } - else { - $_->{char} =~ s/^\$//; - printf(" %-30s => '%s',\n", $_->{lhs}, $_->{char}); - } - } - - #Name => qr/(\w+)/, - #DeclareOp => qr/::=/, - #Plus => qr/\+/, - #Star => qr/\*/, - #CB => qr/{{/, - #CE => qr/}}/, - #Code => qr/(.+)(?=}})/, - - print <<'HEADER'; -); -HEADER + generate_tokens($parse_tree->{tokens}); print generate_actions($parse_tree, $config); print generate_parser_code($parse_tree, $config); @@ -66,21 +63,39 @@ my $simple_lexer = MarpaX::SimpleLexer->new({ }); open my $fh, '<', $ARGV[0] or die "Can't open $ARGV[0]"; +my $codegen_class = $ARGV[1] // 'MarpaX::CodeGen::Dumper'; my $parse_tree = $simple_lexer->parse($fh); OUT - if ($config->{dumper}) { - print <<'OUT'; -print Dumper($parse_tree); -OUT - } - else { - print <<'OUT'; + print <<'OUT'; my $config = { namespace => 'My_Actions' }; -generate_code($parse_tree, $config); +eval "require $codegen_class"; +my $codegen = $codegen_class->new(); +$codegen->generate_code($parse_tree, $config); OUT +} + +sub generate_tokens { + my ($tokens) = @_; + + print <<'HEADER'; +my %tokens = ( +HEADER + + for (@{ $tokens }) { + if ($_->{regex}) { + printf(" %-30s => qr/%s/,\n",$_->{lhs}, $_->{regex}); + } + else { + $_->{char} =~ s/^\$//; + printf(" %-30s => '%s',\n", $_->{lhs}, $_->{char}); + } } + + print <<'HEADER'; +); +HEADER } sub generate_parser_code { @@ -110,6 +125,12 @@ POST sub generate_rules { my ($parse_tree) = @_; my $rules = $parse_tree->{rules}; + for (@$rules) { + if (@{$_->{rhs}} == 1 && $_->{rhs}[0] eq 'Null'){ + $_->{rhs} = []; + } + } + my $out = Dumper({rules=>$rules}); $out =~ s/\$VAR\d+\s+=\s+{//; $out =~ s/};\n$/,/s; diff --git a/lib/MarpaX/CodeGen/Dumper.pm b/lib/MarpaX/CodeGen/Dumper.pm new file mode 100644 index 0000000..cd89f98 --- /dev/null +++ b/lib/MarpaX/CodeGen/Dumper.pm @@ -0,0 +1,22 @@ +package MarpaX::CodeGen::Dumper; +use 5.14.2; +use strict; +use warnings; +use Data::Dumper; + +$Data::Dumper::Deepcopy = 1; + + +sub new { + my ($klass) = @_; + return bless {}, $klass; +} + + +sub generate_code { + my ($self, $parse_tree) = @_; + print Dumper($parse_tree); +} + +1; + diff --git a/lib/MarpaX/CodeGen/HTMLGen.pm b/lib/MarpaX/CodeGen/HTMLGen.pm new file mode 100644 index 0000000..de75ed7 --- /dev/null +++ b/lib/MarpaX/CodeGen/HTMLGen.pm @@ -0,0 +1,135 @@ +package MarpaX::CodeGen::HTMLGen; +use strict; +use warnings; +use 5.14.2; + +sub new { + my ($klass) = @_; + return bless { + strings => {}, + str_count => 0, + lines => [], + label_count => 0, + }, $klass; +} + +sub add_string { + my ($self, $string) = @_; + my $l = sprintf('STR_%04d',$self->{str_count}); + $self->{str_count}++; + $self->{strings}{$l} = $string; + return $l; +} + +sub generate_code { + my ($self, $tree) = @_; + + $self->_generate_code($tree); + $self->add_line("End"); + + for my $key (sort keys %{$self->{strings}}) { + print "\t".'.STR ' . $key . " " . $self->{strings}{$key} . "\n"; + } + print "\n"; + + for my $line (@{$self->{lines}}) { + if ($line =~ m/:$/) { + print $line . "\n"; + } + else { + print "\t" . $line . "\n"; + } + } +} + +sub add_line { + my ($self, $line) = @_; + push @{$self->{lines}}, $line; + return; +} + +#===================================== +sub emit_out { + my ($self, @str) = @_; + + for (@str) { + #s/"/\\"/g; + + if (m/^@/) { + $self->add_line(qq{Emit $_}); + } + else { + my $l = $self->add_string($_); + $self->add_line(qq{Emit $l}); + } + } +} + +sub gen_lbl { + my ($self) = @_; + my $lbl = 'L'.$self->{label_count}; + $self->{label_count}++; + return $lbl; +} + +sub emit_label { + my ($self, $lbl) = @_; + $self->add_line("$lbl:"); + return; +} + +sub emit_if_exists { + my ($self, $name, $lbl) = @_; + $self->add_line('Exists '. $name); + $self->add_line('JF '. $lbl); +} + +sub _generate_code { + my ($self, $tree) = @_; + + if (ref($tree) eq 'ARRAY') { + for (@$tree) { + $self->_generate_code($_); + } + } + elsif (ref($tree) eq 'HASH') { + if (exists $tree->{_if}) { + my $lbl = $self->gen_lbl(); + $self->emit_if_exists($_->{_if}, $lbl); + $self->_generate_code($_->{_block}); + $self->emit_label($lbl); + } + elsif (exists $tree->{_tag}) { + if (!exists $tree->{_attrs}) { + $self->emit_out('<' . $tree->{_tag} . '>'); + } + else { + $self->emit_out('<' . $tree->{_tag}); + for my $attr (@{$tree->{_attrs}}) { + $self->emit_out(' '.$attr->{_id}.'="'); + if (exists $attr->{_string}) { + $self->emit_out($attr->{_string}{_str}); + } + else { + $self->emit_out($attr->{_atid}); + } + $self->emit_out('"'); + } + $self->emit_out('>'); + } + + if (exists $tree->{_block}) { + $self->_generate_code($tree->{_block}); + $self->emit_out('{_tag} . '>'); + } + } + elsif (exists $tree->{_str}) { + $self->emit_out($tree->{_str}); + } + } + else { + $self->emit_out($tree); + } +} + +1; diff --git a/lib/MarpaX/CodeGen/Marpa.pm b/lib/MarpaX/CodeGen/Marpa.pm new file mode 100644 index 0000000..ef0ceb4 --- /dev/null +++ b/lib/MarpaX/CodeGen/Marpa.pm @@ -0,0 +1,22 @@ +package MarpaX::CodeGen::Marpa; +use 5.14.2; +use strict; +use warnings; +use MarpaX::CodeGen; + +$Data::Dumper::Deepcopy = 1; + + +sub new { + my ($klass) = @_; + return bless {}, $klass; +} + + +sub generate_code { + my ($self, $parse_tree, $config) = @_; + return MarpaX::CodeGen::generate_code($parse_tree, $config); +} + +1; + diff --git a/lib/MarpaX/CodeGen/SimpleLex.pm b/lib/MarpaX/CodeGen/SimpleLex.pm new file mode 100644 index 0000000..2db1430 --- /dev/null +++ b/lib/MarpaX/CodeGen/SimpleLex.pm @@ -0,0 +1,182 @@ +package MarpaX::CodeGen::SimpleLex; +use 5.14.2; +use strict; +use Data::Dumper; +$Data::Dumper::Deepcopy = 1; + +use Carp; + +sub new { + my ($klass, $config) = @_; + my $self = bless { config => $config }, $klass; + + if (!defined $config->{package}) { + croak "Variable 'package' not specified"; + } + + return $self; +} + +sub find_inline_tokens { + my ($parse_tree) = @_; + my $c = 0; + + my %token_to_name; + + for my $rule (@{$parse_tree->{rules}}) { + my $i = 0; + for my $rhs (@{ $rule->{rhs} }) { + if (ref($rhs) eq 'HASH') { + if ($rhs->{token}) { + my $name; + if ($token_to_name{$rhs->{token}}) { + $name = $token_to_name{$rhs->{token}}; + } + else { + $name = 'TOK_'.$c; + $c++; + $token_to_name{$rhs->{token}} = $name; + push @{$parse_tree->{tokens}}, { lhs => $name, char => $rhs->{token} }; + } + $rule->{rhs}[$i] = $name; + } + } + } + continue { $i++; } + } + return; +} + +sub generate_code { + my ($self, $parse_tree) = @_; + + my $package = $self->{config}->{package}; + + find_inline_tokens($parse_tree); + + print "package $package;\n"; + + print <<'HEADER'; +use strict; + +use Marpa::XS; +use MarpaX::Simple::Lexer; +HEADER + + generate_tokens($parse_tree->{tokens}); + + print generate_actions($parse_tree, $self->{config}); + print generate_parser_code($parse_tree, $self->{config}); + + print <<'OUT'; +sub new { + my ($klass) = @_; + my $self = bless {}, $klass; + return $self; +} + +sub parse { + my ($self, $fh) = @_; + my $grammar = create_grammar(); + my $recognizer = Marpa::XS::Recognizer->new({ grammar => $grammar }); + my $simple_lexer = MarpaX::Simple::Lexer->new( + recognizer => $recognizer, +# input_filter => sub { ${$_[0]} =~ s/[\r\n]+//g }, + tokens => \%tokens, + ); + $simple_lexer->recognize($fh); + my $parse_tree = ${$recognizer->value}; + return $parse_tree; +} + +1; +OUT +} + +sub generate_tokens { + my ($tokens) = @_; + + print <<'HEADER'; +my %tokens = ( +HEADER + + for (@{ $tokens }) { + if ($_->{regex}) { + printf(" %-30s => qr/%s/,\n",$_->{lhs}, $_->{regex}); + } + else { + $_->{char} =~ s/^\$//; + printf(" %-30s => '%s',\n", $_->{lhs}, $_->{char}); + } + } + + print <<'HEADER'; +); +HEADER +} + +sub generate_parser_code { + my ($parse_tree, $config) = @_; + + my $namespace = $config->{package} . '::Actions'; + + my $out = <<"PRE"; +sub create_grammar { + my \$grammar = Marpa::XS::Grammar->new( + { start => 'Parser', + actions => '$namespace', +PRE + + $out .= generate_rules($parse_tree, $config); + + $out .= <<'POST'; + lhs_terminals => 0, + } + ); + $grammar->precompute(); + return $grammar; +} +POST +} + +sub generate_rules { + my ($parse_tree) = @_; + my $rules = $parse_tree->{rules}; + for (@$rules) { + if (@{$_->{rhs}} == 1 && $_->{rhs}[0] eq 'Null'){ + $_->{rhs} = []; + } + } + my $out = Dumper({rules=>$rules}); + $out =~ s/\$VAR\d+\s+=\s+{//; + $out =~ s/};\n$/,/s; + return $out; +} + +sub generate_actions { + my ($parse_tree, $config) = @_; + my %actions; + + for (@{ $parse_tree->{rules} }) { + my $c = @{ $actions{$_->{lhs}} || [] }; + my $name = $_->{lhs}.'_'.$c; + $_->{action} = $name; + push @{ $actions{$_->{lhs}} }, { name => $name, code => $_->{code} }; + delete $_->{code}; + } + + my $namespace = $config->{package} . '::Actions'; + + my $out = ''; + for my $rule_name (keys %actions) { + for my $action (@{$actions{$rule_name}}) { + $out .= "sub ${namespace}::$action->{name} {\n"; + $out .= "\t".$action->{code}."\n"; + $out .= "}\n\n"; + } + } + return $out; +} + +1; + diff --git a/lib/MarpaX/SimpleLexer.pm b/lib/MarpaX/SimpleLexer.pm index ed1d9a4..38db0c1 100644 --- a/lib/MarpaX/SimpleLexer.pm +++ b/lib/MarpaX/SimpleLexer.pm @@ -1,6 +1,7 @@ package MarpaX::SimpleLexer; use strict; use 5.14.2; +use Data::Dumper; sub new { my ($klass, $options) = @_; @@ -36,35 +37,44 @@ sub _parse_token_stream { chomp $line; #say STDERR "====================="; - PART: while ($line) { - $line =~ s/^\s+//; - ##say STDERR "Line: $line"; + PART: while (length $line > 0) { + #$line =~ s/^\s+//; + #say STDERR "Line: $line"; next LINE if $line =~ m/^\#/; for my $token_name (@{$r->terminals_expected}) { + #say STDERR "Token: $token_name"; my $re = $self->{tokens}{$token_name}; if (ref($re) eq 'Regexp') { + + #say STDERR 're'; + if ($line =~ s/^$re//s) { - if ($r->read($token_name, $1 ? $1 : '')) { +# #say "[$1]"; + if ($r->read($token_name, $1)) { next PART; } } } else { - my ($char, $rest) = split(//, $line, 2); + ##say STDERR "RE: [$re][$line]"; + #say STDERR "ORD: [".ord($re)."][".ord($line)."]"; - if ($re eq $char) { - if ($r->read($token_name, $char)) { - $line = $rest; - next PART; - } + if (ord($re) == ord($line)) { + my $read = $r->read($token_name, $re); + $line = substr $line, 1; + next PART; } } } - # Didn't know what to do... - die "No expected terminal found here"; + $line =~ s/^\s+//; + if (length $line> 0) { + # Didn't know what to do... + #warn 'hmm ' . $line; +# die "No expected terminal found here"; + } } } diff --git a/marpa+.mp b/marpa+.mp new file mode 100644 index 0000000..f6e23c5 --- /dev/null +++ b/marpa+.mp @@ -0,0 +1,30 @@ +Name = /(\w+)/ +DeclareOp = /::=/ +Plus = $+ +Star = $* +CB = /{{/ +CE = /}}/ +Code = /(?{rules}}, $_[1] }} +Decl ::= TokenRule WS {{ push @{$_[0]->{tokens}}, $_[1] }} +TokenRule ::= Lhs WS EQ WS SLASH RX SLASH {{ shift; return { @{$_[0]}, regex => qr/$_[5]/ } }} +TokenRule ::= Lhs WS EQ WS Char {{ shift; return { @{$_[0]}, 'char' => $_[4] } }} +Rule ::= Lhs WS DeclareOp WS Rhs {{ shift; return { @{$_[0]}, @{$_[4]} } }} +Rule ::= Lhs WS DeclareOp WS Rhs WS CB Code CE {{ shift; return { @{$_[0]}, @{$_[4]}, code => $_[7] } }} +Lhs ::= Name {{ shift; return [ lhs => $_[0] ] }} +Rhs ::= Names {{ shift; return [ rhs => $_[0] ] }} +Rhs ::= Names Star {{ shift; return [ rhs => $_[0], min => 0 ] }} +Rhs ::= Names Plus {{ shift; return [ rhs => $_[0], min => 1 ] }} +Names ::= NamePart+ {{ shift; return [ @_ ]; }} +NamePart ::= WS Name {{ shift; return $_[1]; }} +NamePart ::= WS Char {{ shift; return { token => $_[1] }; }} +WS ::= Null +WS ::= Space diff --git a/marpa.mp b/marpa.mp index 3e1355a..c528e19 100644 --- a/marpa.mp +++ b/marpa.mp @@ -14,7 +14,7 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see . -Name = /\w+/ +Name = /(\w+)/ DeclareOp = /::=/ Plus = $+ Star = $* diff --git a/marpa_parser.pl b/marpa_parser.pl index f6b60f1..da0ca39 100644 --- a/marpa_parser.pl +++ b/marpa_parser.pl @@ -14,8 +14,12 @@ # You should have received a copy of the GNU General Public License # along with this program. If not, see . +# +# The original marpa parser generator + use v5.10; use strict; +use lib 'lib'; use MarpaX::CodeGen 'generate_code'; use MarpaX::SimpleLexer; use Marpa::XS;