Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Moved files / Added example

  • Loading branch information...
commit e599553ffe177005d08d85062cbd456cf0d67c1a 1 parent 97c62b8
Peter Stuifzand authored
5 examples/add/add.mp
... ... @@ -0,0 +1,5 @@
  1 +
  2 +Number = /\d+/
  3 +
  4 +
  5 +Parser ::= Number {{ return $_[1]; }}
0  Tokenizer.pm → old/Tokenizer.pm
File renamed without changes
0  Tokenizer/Actions.pm → old/Tokenizer/Actions.pm
File renamed without changes
199 old/output.pl
... ... @@ -0,0 +1,199 @@
  1 +use v5.10;
  2 +use strict;
  3 +use Marpa::XS;
  4 +use Data::Dumper;
  5 +use My_Actions;
  6 +
  7 +$Data::Dumper::Deepcopy = 1;
  8 +
  9 +my %tokens = (
  10 + Name => qr/(\w+)/,
  11 + DeclareOp => qr/::=/,
  12 + Plus => qr/\+/,
  13 + Star => qr/\*/,
  14 + CB => qr/{{/,
  15 + CE => qr/}}/,
  16 + Code => qr/(.+)(?=}})/,
  17 +);
  18 +
  19 +sub My_Actions::Lhs_0 {
  20 + shift; return [ lhs => $_[0] ]
  21 +}
  22 +sub My_Actions::Names_0 {
  23 + shift; return [ @_ ];
  24 +}
  25 +sub My_Actions::Rhs_0 {
  26 + shift; return [ rhs => $_[0] ]
  27 +}
  28 +sub My_Actions::Rhs_1 {
  29 + shift; return [ rhs => $_[0], min => 1 ]
  30 +}
  31 +sub My_Actions::Rhs_2 {
  32 + shift; return [ rhs => $_[0], min => 0 ]
  33 +}
  34 +sub My_Actions::Parser_0 {
  35 + shift; return { 'rules' => \@_ }
  36 +}
  37 +sub My_Actions::Rule_0 {
  38 + shift; return { @{$_[0]}, @{$_[2]} }
  39 +}
  40 +sub create_grammar {
  41 + my $grammar = Marpa::XS::Grammar->new(
  42 + { start => 'Parser',
  43 + actions => 'My_Actions',
  44 +
  45 + 'rules' => [
  46 + {
  47 + 'min' => 1,
  48 + 'rhs' => [
  49 + 'Rule'
  50 + ],
  51 + 'lhs' => 'Parser',
  52 + 'action' => 'Parser_0'
  53 + },
  54 + {
  55 + 'rhs' => [
  56 + 'Lhs',
  57 + 'DeclareOp',
  58 + 'Rhs'
  59 + ],
  60 + 'lhs' => 'Rule',
  61 + 'action' => 'Rule_0'
  62 + },
  63 + {
  64 + 'rhs' => [
  65 + 'Name'
  66 + ],
  67 + 'lhs' => 'Lhs',
  68 + 'action' => 'Lhs_0'
  69 + },
  70 + {
  71 + 'rhs' => [
  72 + 'Names'
  73 + ],
  74 + 'lhs' => 'Rhs',
  75 + 'action' => 'Rhs_0'
  76 + },
  77 + {
  78 + 'rhs' => [
  79 + 'Names',
  80 + 'Plus'
  81 + ],
  82 + 'lhs' => 'Rhs',
  83 + 'action' => 'Rhs_1'
  84 + },
  85 + {
  86 + 'rhs' => [
  87 + 'Names',
  88 + 'Star'
  89 + ],
  90 + 'lhs' => 'Rhs',
  91 + 'action' => 'Rhs_2'
  92 + },
  93 + {
  94 + 'min' => 1,
  95 + 'rhs' => [
  96 + 'Name'
  97 + ],
  98 + 'lhs' => 'Names',
  99 + 'action' => 'Names_0'
  100 + }
  101 + ],
  102 + terminals => [keys %tokens],
  103 + },
  104 + );
  105 + $grammar->precompute();
  106 + return $grammar;
  107 +}
  108 +
  109 +sub parse_token_stream {
  110 + my ($grammar, $fh) = @_;
  111 +
  112 + my $r= Marpa::XS::Recognizer->new( { grammar => $grammar } );
  113 +
  114 + LINE: while (<$fh>) {
  115 + my $line = $_;
  116 + chomp $line;
  117 + print $line;
  118 +
  119 + while ($line) {
  120 + $line =~ s/^\s+//;
  121 + next LINE if $line =~ m/^\#/;
  122 + #say $line;
  123 +
  124 + for my $token_name (@{$r->terminals_expected}) {
  125 + #say $token_name;
  126 + my $re = $tokens{$token_name};
  127 +
  128 + if ($line =~ s/^$re//) {
  129 + $r->read($token_name, $1 ? $1 : '');
  130 + }
  131 + }
  132 + }
  133 + }
  134 +
  135 + my $value_ref = $r->value;
  136 + return $$value_ref;
  137 +}
  138 +
  139 +sub generate_parser_code {
  140 + my ($parse_tree, $config) = @_;
  141 +
  142 + my $namespace = $config->{namespace};
  143 +
  144 + my $out = <<"PRE";
  145 +sub create_grammar {
  146 + my \$grammar = Marpa::XS::Grammar->new(
  147 + { start => 'Parser',
  148 + actions => '$namespace',
  149 +PRE
  150 + $out .= generate_rules($parse_tree, $config);
  151 +
  152 + $out .= <<'POST';
  153 + );
  154 + $grammar->precompute();
  155 + return $grammar;
  156 +}
  157 +POST
  158 +}
  159 +
  160 +sub generate_rules {
  161 + my ($parse_tree) = @_;
  162 + my $out = Dumper($parse_tree);
  163 + $out =~ s/\$VAR\d+\s+=\s+{//;
  164 + $out =~ s/};\n$/}/s;
  165 + return $out;
  166 +}
  167 +
  168 +sub generate_actions {
  169 + my ($parse_tree, $config) = @_;
  170 + my %actions;
  171 +
  172 + for (@{ $parse_tree->{rules} }) {
  173 + my $c = @{ $actions{$_->{lhs}} || [] };
  174 + my $name = $_->{lhs}.'_'.$c;
  175 + $_->{action} = $name;
  176 + push @{ $actions{$_->{lhs}} }, { name => $name, code => $_->{code} };
  177 + delete $_->{code};
  178 + }
  179 +
  180 + my $namespace = $config->{namespace};
  181 +
  182 + for my $rule_name (keys %actions) {
  183 + for my $action (@{$actions{$rule_name}}) {
  184 + say "sub ${namespace}::$action->{name} {";
  185 + say "\t".$action->{code};
  186 + say "}";
  187 + }
  188 + }
  189 +}
  190 +
  191 +open my $fh, '<', $ARGV[0] or die "Can't open $ARGV[0]";
  192 +
  193 +my $grammar = create_grammar();
  194 +my $parse_tree = parse_token_stream($grammar, $fh);
  195 +
  196 +my $config = { namespace => 'My_Actions' };
  197 +generate_actions($parse_tree, $config);
  198 +print generate_parser_code($parse_tree, $config);
  199 +
210 old/output2.pl
... ... @@ -0,0 +1,210 @@
  1 +use v5.10;
  2 +use strict;
  3 +use Marpa::XS;
  4 +use Data::Dumper;
  5 +use My_Actions;
  6 +
  7 +$Data::Dumper::Deepcopy = 1;
  8 +
  9 +my %tokens = (
  10 + Name => qr/(\w+)/,
  11 + DeclareOp => qr/::=/,
  12 + Plus => qr/\+/,
  13 + Star => qr/\*/,
  14 + CB => qr/{{/,
  15 + CE => qr/}}/,
  16 + Code => qr/(.+)(?=}})/,
  17 +);
  18 +
  19 +sub My_Actions::Lhs_0 {
  20 + shift; return [ lhs => $_[0] ]
  21 +}
  22 +sub My_Actions::Names_0 {
  23 + shift; return [ @_ ];
  24 +}
  25 +sub My_Actions::Rhs_0 {
  26 + shift; return [ rhs => $_[0] ]
  27 +}
  28 +sub My_Actions::Rhs_1 {
  29 + shift; return [ rhs => $_[0], min => 1 ]
  30 +}
  31 +sub My_Actions::Rhs_2 {
  32 + shift; return [ rhs => $_[0], min => 0 ]
  33 +}
  34 +sub My_Actions::Parser_0 {
  35 + shift; return { 'rules' => \@_ }
  36 +}
  37 +sub My_Actions::Rule_0 {
  38 + shift; return { @{$_[0]}, @{$_[2]} }
  39 +}
  40 +sub My_Actions::Rule_1 {
  41 + shift; return { @{$_[0]}, @{$_[2]}, code => $_[4] }
  42 +}
  43 +sub create_grammar {
  44 + my $grammar = Marpa::XS::Grammar->new(
  45 + { start => 'Parser',
  46 + actions => 'My_Actions',
  47 +
  48 + 'rules' => [
  49 + {
  50 + 'min' => 1,
  51 + 'rhs' => [
  52 + 'Rule'
  53 + ],
  54 + 'lhs' => 'Parser',
  55 + 'action' => 'Parser_0'
  56 + },
  57 + {
  58 + 'rhs' => [
  59 + 'Lhs',
  60 + 'DeclareOp',
  61 + 'Rhs'
  62 + ],
  63 + 'lhs' => 'Rule',
  64 + 'action' => 'Rule_0'
  65 + },
  66 + {
  67 + 'rhs' => [
  68 + 'Lhs',
  69 + 'DeclareOp',
  70 + 'Rhs',
  71 + 'CB',
  72 + 'Code',
  73 + 'CE'
  74 + ],
  75 + 'lhs' => 'Rule',
  76 + 'action' => 'Rule_1'
  77 + },
  78 + {
  79 + 'rhs' => [
  80 + 'Name'
  81 + ],
  82 + 'lhs' => 'Lhs',
  83 + 'action' => 'Lhs_0'
  84 + },
  85 + {
  86 + 'rhs' => [
  87 + 'Names'
  88 + ],
  89 + 'lhs' => 'Rhs',
  90 + 'action' => 'Rhs_0'
  91 + },
  92 + {
  93 + 'rhs' => [
  94 + 'Names',
  95 + 'Plus'
  96 + ],
  97 + 'lhs' => 'Rhs',
  98 + 'action' => 'Rhs_1'
  99 + },
  100 + {
  101 + 'rhs' => [
  102 + 'Names',
  103 + 'Star'
  104 + ],
  105 + 'lhs' => 'Rhs',
  106 + 'action' => 'Rhs_2'
  107 + },
  108 + {
  109 + 'min' => 1,
  110 + 'rhs' => [
  111 + 'Name'
  112 + ],
  113 + 'lhs' => 'Names',
  114 + 'action' => 'Names_0'
  115 + }
  116 + ],
  117 + terminals => [keys %tokens],
  118 + } );
  119 + $grammar->precompute();
  120 + return $grammar;
  121 +}
  122 +
  123 +sub parse_token_stream {
  124 + my ($grammar, $fh) = @_;
  125 +
  126 + my $r= Marpa::XS::Recognizer->new( { grammar => $grammar } );
  127 +
  128 + LINE: while (<$fh>) {
  129 + my $line = $_;
  130 + chomp $line;
  131 +
  132 + while ($line) {
  133 + $line =~ s/^\s+//;
  134 + next LINE if $line =~ m/^\#/;
  135 +
  136 + for my $token_name (@{$r->terminals_expected}) {
  137 + my $re = $tokens{$token_name};
  138 +
  139 + if ($line =~ s/^$re//) {
  140 + $r->read($token_name, $1 ? $1 : '');
  141 + }
  142 + }
  143 + }
  144 + }
  145 +
  146 + my $value_ref = $r->value;
  147 + return $$value_ref;
  148 +}
  149 +
  150 +sub generate_parser_code {
  151 + my ($parse_tree, $config) = @_;
  152 +
  153 + my $namespace = $config->{namespace};
  154 +
  155 + my $out = <<"PRE";
  156 +sub create_grammar {
  157 + my \$grammar = Marpa::XS::Grammar->new(
  158 + { start => 'Parser',
  159 + actions => '$namespace',
  160 +PRE
  161 + $out .= generate_rules($parse_tree, $config);
  162 +
  163 + $out .= <<'POST';
  164 + );
  165 + $grammar->precompute();
  166 + return $grammar;
  167 +}
  168 +POST
  169 +}
  170 +
  171 +sub generate_rules {
  172 + my ($parse_tree) = @_;
  173 + my $out = Dumper($parse_tree);
  174 + $out =~ s/\$VAR\d+\s+=\s+{//;
  175 + $out =~ s/};\n$/}/s;
  176 + return $out;
  177 +}
  178 +
  179 +sub generate_actions {
  180 + my ($parse_tree, $config) = @_;
  181 + my %actions;
  182 +
  183 + for (@{ $parse_tree->{rules} }) {
  184 + my $c = @{ $actions{$_->{lhs}} || [] };
  185 + my $name = $_->{lhs}.'_'.$c;
  186 + $_->{action} = $name;
  187 + push @{ $actions{$_->{lhs}} }, { name => $name, code => $_->{code} };
  188 + delete $_->{code};
  189 + }
  190 +
  191 + my $namespace = $config->{namespace};
  192 +
  193 + for my $rule_name (keys %actions) {
  194 + for my $action (@{$actions{$rule_name}}) {
  195 + say "sub ${namespace}::$action->{name} {";
  196 + say "\t".$action->{code};
  197 + say "}";
  198 + }
  199 + }
  200 +}
  201 +
  202 +open my $fh, '<', $ARGV[0] or die "Can't open $ARGV[0]";
  203 +
  204 +my $grammar = create_grammar();
  205 +my $parse_tree = parse_token_stream($grammar, $fh);
  206 +
  207 +my $config = { namespace => 'My_Actions' };
  208 +generate_actions($parse_tree, $config);
  209 +print generate_parser_code($parse_tree, $config);
  210 +
0  tokenizer.pl → old/tokenizer.pl
File renamed without changes
50 old/tokens.pl
... ... @@ -0,0 +1,50 @@
  1 +use v5.10;
  2 +use Marpa::XS;
  3 +use Data::Dumper;
  4 +
  5 +my $grammar = Marpa::XS::Grammar->new(
  6 + { start => 'Parser',
  7 + actions => 'My_Actions',
  8 + rules => [
  9 + { lhs => 'Parser', rhs => [ 'NumberLine' ], min => 1, action => 'Parser' },
  10 + { lhs => 'NumberLine', rhs => [ 'NumberList', "\n" ], action => 'NumberLine' },
  11 + { lhs => 'NumberList', rhs => ['Number'] },
  12 + { lhs => 'NumberList', rhs => ['Number', 'WS', 'NumberList'] },
  13 + { lhs => 'Number', rhs => ['Digit'], min => 1, action => 'Number' },
  14 + { lhs => 'Digit', rhs => ['0'] },
  15 + { lhs => 'Digit', rhs => ['1'] },
  16 + { lhs => 'Digit', rhs => ['2'] },
  17 + { lhs => 'Digit', rhs => ['3'] },
  18 + { lhs => 'Digit', rhs => ['4'] },
  19 + { lhs => 'Digit', rhs => ['5'] },
  20 + { lhs => 'Digit', rhs => ['6'] },
  21 + { lhs => 'Digit', rhs => ['7'] },
  22 + { lhs => 'Digit', rhs => ['8'] },
  23 + { lhs => 'Digit', rhs => ['9'] },
  24 + { lhs => 'WS', rhs => [ ' ' ], min => 1 },
  25 + ],
  26 + }
  27 +);
  28 +use List::Util 'sum';
  29 +
  30 +sub My_Actions::Parser { shift;return [ map { if (ref) { @$_ } else { $_ } } @_ ]; }
  31 +sub My_Actions::NumberLine { shift; pop; return [ map { if (ref) { @$_ } else { $_ } } @_ ]; }
  32 +sub My_Actions::NumberList { shift; return [ $_[0] ] if (@_ == 1); return [ $_[0], @{$_[2]} ] if @_ == 3; }
  33 +sub My_Actions::Number { shift; return [ 'Number', (join '', @_) ] }
  34 +sub My_Actions::Digit { shift; return $_[0]; }
  35 +sub My_Actions::WS { shift; return; }
  36 +
  37 +$grammar->precompute();
  38 +
  39 +my $re = Marpa::XS::Recognizer->new( { grammar => $grammar } );
  40 +
  41 +while (<>) {
  42 + my @tokens = split //;
  43 + for (@tokens) {
  44 + $re->read($_, $_);
  45 + }
  46 +}
  47 +
  48 +my $value_ref = $re->value;
  49 +say Dumper($$value_ref);
  50 +
3  test.mt
... ... @@ -1,3 +0,0 @@
1   -Regex=R:R:(.*)$
2   -Name=R:(\w+)
3   -DeclareOp=R:=

0 comments on commit e599553

Please sign in to comment.
Something went wrong with that request. Please try again.