1 files changed, 89 insertions, 0 deletions
diff --git a/lib/Parser.pm b/lib/Parser.pm
new file mode 100644
index 0000000..c10a8f9
--- /dev/null
+++ b/lib/Parser.pm
@@ -0,0 +1,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] } }