{
#Finding label word in the current line as every node and edge description
#contains label property. The value of label is extracted.
- if(m/label=\"(.*)\"/)
+ if( m/label=\"(.*)\"/ )
{
my $token = $1;
#Every edge is denoted as state_number -> state_number . The current
#line is searched for this and to and from state number are extracted.
- if(m/(\d+) -> (\d+)/)
+ if( m/(\d+) -> (\d+)/ )
{
# "$end" token is replaced with end.
- if($token eq "\$end")
+ if( $token eq "\$end" )
{
$table[ $1 ]{ end } = $2;
}
#The line describing the node contains State word in its description
#followed by state number. The state number is extracted and its value
#is stored.
- elsif(m/State (\d+)\\n/)
+ elsif( m/State (\d+)\\n/ )
{
$labels[ $1 ] = $token;
}
#state_number -> state_number R production_number.
#production_number denotes the production by which reduction is to happen.
#It is extracted from the label value of the specified state.
- elsif(m/(\d+) -> "\d+R(\d+)"/)
+ elsif( m/(\d+) -> "\d+R(\d+)"/ )
{
my $state_number = $1;
my $production_number = $2;
#with value equal to an array having number of words on right side and
#function with name of the value of left side.
$labels[$state_number] =~ m/$production_number (.+): (.+)\.\\l/;
- if($1 eq "\$accept")
+ if( $1 eq "\$accept" )
{
$table[ $state_number ] = {};
$acceptstate = $state_number;
my @hashval;
for my $key ( keys %$href )
{
- if($key eq "reduce")
+ if( $key eq "reduce" )
{
push @hashval , sprintf( "$key => [%s]",join(", ",@{ $href -> { $key } }));
}
our @ISA = qw(Exporter);
our @EXPORT = qw(lex);
-# lex(string)
-# Takes as input a string of line. Divides it into tokens as specified
-# by Regex and outputs an array of Tokens. Every Token is an array having
-# two values: token name and its value. If its an operator, it has only
-# one value.
-sub lex($)
+# lex(string,multiline)
+# Takes as input a string of line and multiline variable deciding whether
+# current line is related to the previous line. Divides it into tokens as
+# specified by Regex and outputs an array of Tokens. Every Token is an
+# array having two values: token name and its value. If its an operator,
+# it has only one value.
+sub lex($$)
{
+ my ( $curr_line , $multiline ) = @_;
my @tokens;
my $rhs = 0;
+ $_ = $curr_line;
while( $_ )
{
- if( $rhs && s/^(.+)//o )
+ if( $multiline )
{
- push @tokens, ["rhs",$1];
- $rhs=0;
+ my @vals = split;
+ if( $multiline eq 'automake_comment' )
+ {
+ if( $vals[ -1 ] ne '\\' )
+ {
+ $multiline = undef;
+ push @tokens, [ "newline" ];
+ }
+ $_ = undef;
+ last;
+ }
+ elsif( $multiline eq 'comment' )
+ {
+ my $comment;
+ foreach my $val ( @vals )
+ {
+ if($val =~ m/^##/)
+ {
+ if($vals[ -1 ] eq '\\')
+ {
+ $multiline = 'automake_comment';
+ }
+ $_ = undef;
+ last;
+ }
+ elsif( $val eq '\\' )
+ {
+ last;
+ }
+ else
+ {
+ $comment .= " ".$val;
+ }
+ }
+ if( $comment )
+ {
+ push @tokens, [ "comment" , $comment ];
+ }
+ if($vals[ -1 ] ne '\\')
+ {
+ $multiline = undef;
+ push @tokens, [ "newline" ];
+ }
+ $_ = undef;
+ }
+ else
+ {
+ $multiline = undef;
+ $rhs = 1;
+ }
}
- elsif(s/^(PROGRAMS|LIBRARIES|LTLIBRARIES|LISP|PYTHON|JAVA|SCRIPTS|DATA|HEADERS|MASN|TEXINFOS)//o)
+ elsif( $rhs )
+ {
+ my @vals = split;
+ my $comment;
+ foreach my $val ( @vals )
+ {
+ if( $val =~ m/^##/ )
+ {
+ if($vals[ -1 ] eq '\\' )
+ {
+ $multiline = 'automake_comment';
+ }
+ $_ = undef;
+ last;
+ }
+ elsif( $val =~ m/^#(.*)/ )
+ {
+ if($vals[ -1 ] eq '\\' )
+ {
+ $multiline = 'comment';
+ }
+ $comment .= " ".$1;
+ }
+ elsif( $val =~ m/\\/ )
+ {
+ if( !$multiline )
+ {
+ $multiline = 'rhsval';
+ }
+ }
+ elsif( $comment )
+ {
+ $comment .= " ".$val;
+ }
+ else
+ {
+ push @tokens, [ "rhsval" , $val];
+ }
+ }
+ if( $comment )
+ {
+ push @tokens, [ "comment" , $comment];
+ }
+ if( !$multiline )
+ {
+ push @tokens, [ "newline" ];
+ }
+ $_ = undef;
+ }
+ elsif( s/^##.*\n$//o )
+ {
+ }
+ elsif( s/^#(.*)\n$//o )
+ {
+ my $val = $1;
+ if($val =~ m/(.*?)\\/o)
+ {
+ push @tokens, [ "comment" , substr( $1 , 0 , -1 )];
+ $multiline = 'comment';
+ }
+ else
+ {
+ push @tokens, [ "comment" , $1];
+ push @tokens, [ "newline" ];
+ }
+ }
+ elsif( s/^(PROGRAMS|LIBRARIES|LTLIBRARIES|LISP|PYTHON|JAVA|SCRIPTS|DATA|HEADERS|MASN|TEXINFOS)//o)
{
push @tokens, [$1];
}
- elsif(s/^([a-zA-Z0-9]+)//o)
+ elsif( s/^([a-zA-Z0-9]+)//o )
{
push @tokens, ["value",$1];
}
- elsif(s/^(=)//o)
+ elsif( s/^(=)//o )
{
push @tokens, [$1];
$rhs = 1;
}
- elsif(s/^(:|_)//o)
+ elsif( s/^(:|_)//o )
{
push @tokens, [$1];
}
- elsif(s/^\n//o)
+ elsif( s/^\n//o )
{
push @tokens, ["newline"];
+ $multiline = undef;
}
- elsif(s/^(\r| )//o)
+ elsif( s/^(\r|\s*)//o )
{
}
else
die "Incorrect input $_";
}
}
- return @tokens;
+ return ( \@tokens , $multiline );
}
all: ast.png
-ast.png: Lexer.pm Tree.pm ParserTable.pm parser.pl
+ast.png: Lexer.pm Tree.pm ParserTable.pm parser.pl input.txt
perl -I. parser.pl
- unflatten -f -l 5 -c 6 -o ast1.gv ast.gv
+ unflatten -f -l 10 -c 10 -o ast1.gv ast.gv
dot -Tpng ast1.gv > ast.png
rm ast1.gv
automake.dot: automake.y
bison --graph automake.y
rm automake.tab.c
- unflatten -f -l 5 -c 6 -o automake1.dot automake.dot
+ unflatten -f -l 16 -c 9 -o automake1.dot automake.dot
dot -Tpng automake1.dot > automake.png
rm automake1.dot
our @ISA=qw(Exporter);
our @Export=qw(@table $accept);
-our $accept=9;
+our $accept=11;
our @table=(
- {stmt => 4, input => 2, lhs => 5, stmts => 3, value => 1, optionlist => 6},
- {'_' => 8, ':' => 7},
- {end => 9},
- {value => 1, optionlist => 6, stmt => 10, lhs => 5, reduce => [1, \&input]},
- {newline => 11},
- {'=' => 12},
- {DATA => 21, PYTHON => 18, LIBRARIES => 15, TEXINFOS => 24, PROGRAMS => 14, MASN => 23, value => 13, JAVA => 19, HEADERS => 22, SCRIPTS => 20, LTLIBRARIES => 16, primaries => 25, LISP => 17},
- {rhs => 26},
+ {commentlist => 7, optionlist => 8, stmts => 4, comment => 2, value => 1, stmt => 5, lhs => 6, input => 3},
+ {'_' => 10, ':' => 9},
+ {reduce => [1, \&commentlist]},
+ {end => 11},
+ {lhs => 6, reduce => [1, \&input], comment => 2, commentlist => 7, value => 1, optionlist => 8, stmt => 12},
+ {newline => 13},
+ {'=' => 14},
+ {reduce => [1, \&stmt], comment => 15},
+ {PYTHON => 21, HEADERS => 25, JAVA => 22, LTLIBRARIES => 19, PROGRAMS => 17, primaries => 28, MASN => 26, value => 16, SCRIPTS => 23, LISP => 20, DATA => 24, LIBRARIES => 18, TEXINFOS => 27},
+ {rhs => 30, rhsval => 29},
{reduce => [2, \&optionlist]},
{},
- {newline => 27},
+ {newline => 31},
{reduce => [2, \&stmts]},
- {rhs => 28},
- {'_' => 29, reduce => [1, \&primaries]},
+ {rhsval => 29, rhs => 32},
+ {reduce => [2, \&commentlist]},
+ {reduce => [1, \&primaries], '_' => 33},
{reduce => [1, \&primaries]},
{reduce => [1, \&primaries]},
{reduce => [1, \&primaries]},
{reduce => [1, \&primaries]},
{reduce => [1, \&primaries]},
{reduce => [2, \&lhs]},
- {reduce => [3, \&stmt]},
+ {reduce => [1, \&rhs]},
+ {reduce => [3, \&stmt], rhsval => 34},
{reduce => [3, \&stmts]},
- {reduce => [3, \&stmt]},
- {reduce => [3, \&optionlist]}
+ {commentlist => 35, reduce => [3, \&stmt], comment => 2, rhsval => 34},
+ {reduce => [3, \&optionlist]},
+ {reduce => [2, \&rhs]},
+ {reduce => [4, \&stmt], comment => 15}
);
\ No newline at end of file
use Exporter;
our @ISA = qw(Exporter);
-our @EXPORT = qw(input stmt stmts lhs primaries optionlist traverse printgraph);
+our @EXPORT = qw(input stmt stmts lhs rhs primaries optionlist commentlist traverse printgraph);
# Grammar Rule : (1) input => stmts
# Create a node having child as stmts.
sub input($)
{
- my ($val) = @_;
- my %node = (name => input, childs => [$val]);
+ my ( $val ) = @_;
+ my %node = (name => input, childs => [ $val ]);
return \%node;
}
# Grammar Rule : (1) stmt => lhs '=' rhs
-# Create a node for Automake rule. It has lhs and rhs as childs.
-# (2) stmt => value ':' rhs
-# Create a node for Make rule. It has value and rhs as childs.
-sub stmt($$$)
+# Create a node for Automake rule having lhs and rhs as its childs.
+# (2) stmt => lhs '=' rhs commentlist
+# Create a node for Automake rule having lhs, rhs and comments as its child.
+# (3) stmt => value ':' rhs
+# Create a node for Make rule having lhs and rhs as its childs.
+# (4) stmt => commentlist
+# Create a node for comments.
+sub stmt($;$$;$)
{
- my ($lhs, $sym, $rhs) = @_;
+ my ( $val1, $val2, $val3, $val4 ) = @_;
my %node;
- if($sym -> [0] eq '=')
+ if( !$val2 )
{
- my %rhsnode = (name => rhs, val => $rhs -> [1]);
- %node = (name => stmt, childs => [$lhs, \%rhsnode],type => automake);
+ %node = (name => stmt, childs => [ $val1 ], type => comment);
+ }
+ elsif( $val2 -> [0] eq '=' )
+ {
+ %node = (name => stmt, childs => [ $val1,$val3 ],type => automake);
+ if( $val4 )
+ {
+ push @{ $node{ childs }}, $val4;
+ }
}
else
{
- %node = (name => stmt, lhs => $lhs, rhs =>$rhs->[1],type => make);
+ %node = (name => stmt, childs => [ $val1,$val3 ],type => make);
}
return \%node;
}
# the childs array of the stmts(First Argument).
sub stmts($$;$)
{
- my ($val1,$val2,$val3) = @_;
+ my ( $val1, $val2, $val3) = @_;
if($val3 == undef)
{
- my %node = (name => stmts, childs => [$val1]);
- my %nodeval = (name => stmts, childs => [\%node]);
+ my %node = (name => stmts, childs => [ $val1 ]);
+ my %nodeval = (name => stmts, childs => [ \%node ]);
return \%nodeval;
}
else
{
- my %node = (name => stmts,childs => [$val2]);
- push @{$val1->{childs}},\%node;
+ my %node = (name => stmts,childs => [ $val2 ]);
+ push @{ $val1 -> { childs }}, \%node;
return $val1;
}
}
# option list and primary.
sub lhs($$)
{
- my ($val1, $val2) = @_;
- my %node = (name => lhs, childs => [$val1, $val2]);
+ my ( $val1, $val2 ) = @_;
+ my %node = (name => lhs, childs => [ $val1, $val2 ]);
return \%node;
}
+# Grammar Rule : (1) rhs => rhsval
+# Creates a node having rhsval as its value.
+# (2) rhs => rhs rhsval
+# Inserts rhsval into the array pointed by value key in rhs.
+sub rhs($;$)
+{
+ my ( $val1, $val2 ) = @_;
+ if($val2 == undef)
+ {
+ my %node = ( name => rhs, value => [$val1 -> [1]]);
+ return \%node;
+ }
+ else
+ {
+ push @{ $val1 -> { value }}, $val2 -> [1];
+ return $val1;
+ }
+}
+
+# Grammar Rule : (1) commentlist => comment
+# Creates a node having comment as its value.
+# (2) commentlist => commentlist comment
+# Inserts comment into the array pointed by value key in commentlist.
+sub commentlist($;$)
+{
+ my ( $val1, $val2 ) = @_;
+ if($val2 == undef)
+ {
+ my %node = ( name => commentlist, value => [ $val1 -> [1]]);
+ return \%node;
+ }
+ else
+ {
+ push @{ $val1 -> {value}} , $val2 -> [1];
+ return $val1;
+ }
+}
+
# Grammar Rule : (1) primaries : PROGRAMS
# (2) primaries : LIBRARIES
# (3) primaries : LTLIBRARIES
# Creates a node corresponding to the given primary.
sub primaries($)
{
- my ($val) = @_;
+ my ( $val ) = @_;
my %node;
if( $val -> [0] eq 'value')
{
}
else
{
- %node = ( name => primaries, val => $val1);
+ %node = ( name => primaries, val => $val);
}
return \%node;
}
# Add the data value to val key in the node pointed by optionlist(First Argument).
sub optionlist($$;$)
{
- my ($val1, $val2, $val3) = @_;
+ my ( $val1, $val2, $val3 ) = @_;
if($val3 == undef)
{
my %node = (name => optionlist, val => [$val1 -> [1]]);
sub printgraph($)
{
my $FH;
- open($FH, '>', 'ast.gv') or die $!;
+ open( $FH, '>', 'ast.gv' ) or die $!;
print $FH "graph graphname {\n";
- my ($ref) = @_;
+ my ( $ref ) = @_;
print $FH "0 [label=\"Root\"];";
- traverse($ref, $FH, 0, 1);
+ traverse( $ref, $FH, 0);
print $FH "}\n";
close $FH;
}
-# traverse(Hash, File Handle, Parent Id, Node Id)
+
+#Stores the next id to be alloted to new node.
+my $id=0;
+
+# traverse(Hash, File Handle, Parent Id)
# Traverses the tree recursively. Prints the information about the current
-# node to file. Call all its child with Parent Id equal to current Node Id
-# and Node Id equal to (Parent Id*2+i) where i is the ith Child.
-sub traverse($$$$)
+# node to file. Call all its child with Parent Id equal to current Node Id.
+sub traverse($$$)
{
- my ($ref,$FH,$parent,$id)=@_;
+ my ( $ref,$FH,$parent ) = @_;
+ $id++;
+ my $curr_id = $id;
my %node = %$ref;
- #print $level," ",$pos," ",$node{name}," ";
print $FH "$parent--$id;\n";
my $label = "";
@keys = sort grep {!/^childs/} keys %node;
- foreach $key (@keys)
+ foreach $key ( @keys )
{
$label .= $key."=>";
- if(ref($node{$key}) eq 'ARRAY')
+ if(ref( $node{ $key }) eq 'ARRAY')
{
$label .= join(" ",@{$node{$key}})."\n";
}
$label .= $node{$key}." ";
}
}
- print $FH "$id [label=\"$label\"];";
+ print $FH "$curr_id [label=\"$label\"];";
if( $node{childs} )
{
my $val1 = $node{childs};
- my $i = 1;
foreach $child (@$val1)
{
- traverse($child,$FH,$id,2*$id+$i);
- $i++;
+ traverse($child,$FH,$curr_id);
}
}
-}
\ No newline at end of file
+}
+1;
\ No newline at end of file
-%token value rhs PROGRAMS LIBRARIES LTLIBRARIES LISP PYTHON JAVA SCRIPTS DATA HEADERS MASN TEXINFOS newline
+%token value rhsval comment PROGRAMS LIBRARIES LTLIBRARIES LISP PYTHON JAVA SCRIPTS DATA HEADERS MASN TEXINFOS newline
%%
-input : stmts ;
+input : stmts
+;
stmts : stmt newline
| stmts stmt newline
-stmt : lhs '=' rhs
- | value ':' rhs
+;
+stmt : lhs '=' rhs
+ | lhs '=' rhs commentlist
+ | value ':' rhs
+ | commentlist
+;
lhs : optionlist primaries
+;
+rhs : rhsval
+ | rhs rhsval
+;
+commentlist: comment
+ | commentlist comment
+;
primaries : PROGRAMS
| LIBRARIES
| LTLIBRARIES
| MASN
| TEXINFOS
| value
+;
optionlist : value '_'
| optionlist value '_'
+;
%%
\ No newline at end of file
-dist_bin_PROGRAMS = server client
-server_SOURCES = server.c db.c
-client_SOURCES = client.c dep.c
+## Process this file with automake to produce Makefile.in
+dist_bin_PROGRAMS = server \
+client
+server_SOURCES = server.c db.c ## Server Files \
+Database Files
+#Comment Testing Here \
+Same here
+client_SOURCES = client.c dep.c #Multiline comment \
+Client dependencies
noinst_LIBRARIES = libfoo.a
noinst_LTLIBRARIES = foolib.a
files_JAVA = a.java b.java
#Stores the list of tokens generated by lexer.
my @tokens;
+my $multiline = 0;
+my $curr_tokens;
while ( <$data> )
{
- push @tokens, lex($_);
+ ( $curr_tokens, $multiline) = lex($_ , $multiline);
+ push @tokens,@$curr_tokens;
}
if( $debug )
{
print join(" ", @{$token}), "\n";
}
}
-
-push @tokens, ["end"];
+push @tokens, [ "end" ];
my @stack = (0);
print "Parser Output\n" if $debug;
projects / thirdparty / automake.git / commitdiff
