lib/Parser.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

package Parser; 
use strict;
use warnings;
use Parse::RecDescent;
 
my $parser=Parse::RecDescent->new(do {local $/;<DATA>});
 
sub parse {
    return $parser->program($_[0]);
}
 
__DATA__
{
use Tree::DAG_Node::XPath;
use Tree::Template::Declare::DAG_Node;
use Tree::Template::Declare
    builder =>
    Tree::Template::Declare::DAG_Node->new('Tree::DAG_Node::XPath');
 
sub diag {
# warn '#'.(shift)."\n <".join('><',@_).">\n"; 
}
 
}
 
word:        /[[:alpha:]]\w*/
number:      /\d+/
 
program: line(s)
         { diag 'program',@item;
           tree { node { name 'program'; attach_nodes @{$item[1]} }; };
         }
 
line: label(?) statement
      { diag 'line',@item;
        node { name 'line';
               if (@{$item[1]}) {
                   diag 'line-label',$item[1]->[0];
                  attribs label => $item[1]->[0];
               };
               attach_nodes $item{statement};
             };
      }
 
statement: word '=' expression
           { diag 'assign';
             node { name 'assign';
                    node { name 'var'; attribs name => $item{word} };
                    attach_nodes $item{expression};
                  };
           }
         | 'if' expression 'then' word 'else' word
           { diag 'if';
             node { name 'if';
                    node { name 'guard'; attach_nodes $item{expression} };
                    node { name 'then'; attribs label => $item[4] };
                    node { name 'else'; attribs label => $item[6] };
                  };
            }
         | 'goto' word
           { diag 'goto';
             node { name 'goto'; attribs label => $item{label} };
           }
         | 'print' expression
           { diag 'print';
             node { name 'print'; attach_nodes $item{expression} };
           }
 
label: word ':' { $item{word} }
 
expression: mult_expr '+' expression
            { diag 'add';
              node { name 'add';
                     attach_nodes $item{mult_expr}, $item{expression} };
            }
          | mult_expr
            { diag 'add->mult'; $item[1]; }
 
mult_expr: simple_expr '*' mult_expr
           { diag 'mult';
             node { name 'mult';
                    attach_nodes $item{simple_expr}, $item{expression} };
           }
         | simple_expr
           { diag 'mult->simple'; $item[1]; }
 
simple_expr: '(' expression ')' { diag 'parens'; $item{expression} }
           | word               { diag 'var'; node { name 'var'; attribs name => $item[1] } }
           | number             { diag 'const',@item; node { name 'const'; attribs value => $item[1] } }