Created
May 18, 2016 11:03
-
-
Save rns/b00a4e6a48eaf86f1c6ad2fe33a14ad9 to your computer and use it in GitHub Desktop.
ECMAScript::AST traversal example
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 1: Program | |
# 2: Statement | |
# 3: VariableStatement | |
# 3: VAR: 'var' @0:3 | |
# 3: IDENTIFIER: 'i' @4:5 | |
# 3: ASSIGN: '=' @6:7 | |
# 3: DECIMALLITERAL: '0' @8:9 | |
# 2: Statement | |
# 3: ExpressionStatement | |
# 3: IDENTIFIER: 'i' @11:12 | |
# 3: ASSIGN: '=' @13:14 | |
# 3: IDENTIFIER: 'i' @15:16 | |
# 3: PLUS: '+' @17:18 | |
# 3: DECIMALLITERAL: '1' @19:20 | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env perl | |
use 5.010; | |
use strict; | |
use warnings FATAL => 'all'; | |
use MarpaX::Languages::ECMAScript::AST; | |
use Data::Dumper; | |
$Data::Dumper::Deepcopy = 1; | |
$Data::Dumper::Indent = 0; | |
$Data::Dumper::Terse = 1; | |
$Data::Dumper::Sortkeys = 1; | |
my $ecmaSourceCode = 'var i = 0; i = i + 1;'; | |
my $ecmaAstObject = MarpaX::Languages::ECMAScript::AST->new(); | |
my $ast = $ecmaAstObject->parse($ecmaSourceCode); | |
my %semantic = map{ $_ => 1 } qw{ | |
Program Statement VariableStatement ExpressionStatement | |
VAR IDENTIFIER ASSIGN DECIMALLITERAL PLUS | |
}; | |
sub traverse{ | |
my ($node) = @_; | |
state $level = 0; | |
# unpack node | |
my ($lhs, $rhs, $values) = map { $node->{$_} } qw { lhs rhs values }; | |
# print debug info: uncomment to see what you may need to distill | |
# say "$level:", ' ' x $level, Dumper $node; | |
$level++ if $semantic{$lhs}; | |
# process node based on its LHS -- node id -- unless it's just syntax | |
say qq{# $level:}, ' ' x $level, $lhs | |
if $semantic{$lhs}; # skip syntactic nodes | |
# process node RHS -- node children | |
for my $i (0..@$values-1){ | |
# name & value -- node child | |
my $name = $rhs->[$i]; | |
my $value = $values->[$i]; | |
# process child as literal | |
if (ref $value eq "ARRAY"){ | |
my ($start, $length, $literal) = @$value; | |
if (exists $semantic{$name}){ | |
say qq{# $level:}, ' ' x $level, qq{$name: '$literal'}, ' @', $start, ':', $start + $length; | |
} | |
} | |
# process child recursively | |
elsif (ref $value eq "HASH"){ | |
traverse($value); | |
$level-- | |
if $semantic{$lhs}; # skip syntactic nodes | |
} | |
} | |
} | |
traverse($ast); |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
origin: http://irclog.perlgeek.de/marpa/2016-05-18#i_12498971