Permalink
Browse files

Perlito - misc - tree grammar placeholder

  • Loading branch information...
1 parent a3e2348 commit fcea7562c5528644a7cd975e487f73f13d0feb51 @fglock committed Oct 14, 2013
Showing with 96 additions and 0 deletions.
  1. +96 −0 misc/tree_grammar.pl
View
96 misc/tree_grammar.pl
@@ -0,0 +1,96 @@
+package main {
+ use Data::Dumper;
+ use strict;
+
+ my $in = eval join( '', <> );
+ print Dumper $in;
+
+ my $rule = [ Ref => 'Perlito5::AST::Apply' ];
+ TreeGrammar::scan( $rule, $in );
+
+ $rule = [
+ Lookup => 'name',
+ [ Value => 'a' ]
+ ];
+ TreeGrammar::scan( $rule, $in );
+}
+
+package TreeGrammar {
+ use Data::Dumper;
+ use strict;
+
+ my %dispatch;
+ INIT {
+ %dispatch = (
+ Ref => \&Ref, # Ref => 'Perlito5::AST::Apply'
+ Lookup => \&Lookup, # Lookup => 'namespace'
+ Index => \&Index, # Index => '0'
+ Value => \&Value, # Value => '123'
+ );
+ }
+
+ sub render {
+ my ( $rule, $node ) = @_;
+ if ( ref($rule) ) {
+
+ # print "Rule ", Dumper $rule;
+ # print Dumper \%dispatch;
+ return $dispatch{ $rule->[0] }->( $rule, $node );
+ }
+ return;
+ }
+
+ sub scan {
+ my ( $rule, $node ) = @_;
+ render( $rule, $node );
+ if ( ref($node) eq 'ARRAY' ) {
+ scan( $rule, $_ ) for @$node;
+ }
+ elsif ( ref($node) ) {
+ scan( $rule, $_ ) for values %$node;
+ }
+ return;
+ }
+
+ sub Ref {
+ my ( $rule, $node ) = @_;
+ if ( ref($node) eq $rule->[1] ) {
+ print "match: Ref $node\n";
+ return { pos => $node };
+ }
+ return;
+ }
+
+ sub Lookup {
+ my ( $rule, $node ) = @_;
+ return if !ref($node) || ref($node) eq 'ARRAY';
+ if ( exists( $node->{ $rule->[1] } ) ) {
+ print "match: Lookup $node\n";
+ return render( $rule->[2], $node->{ $rule->[1] } ) if $rule->[2];
+ return { pos => $node };
+ }
+ return;
+ }
+
+ sub Index {
+ my ( $rule, $node ) = @_;
+ return if !ref($node) || ref($node) ne 'ARRAY';
+ if ( exists( $node->[ $rule->[1] ] ) ) {
+ print "match: Index $node\n";
+ return render( $rule->[2], $node->[ $rule->[1] ] ) if $rule->[2];
+ return { pos => $node };
+ }
+ return;
+ }
+
+ sub Value {
+ my ( $rule, $node ) = @_;
+ return if ref($node);
+ if ( $node eq $rule->[1] ) {
+ print "match: Value $node\n";
+ return { pos => $node };
+ }
+ return;
+ }
+
+}

0 comments on commit fcea756

Please sign in to comment.