Skip to content

Couple simple changes to start, including working operator with > 2 operands #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
Hedrik wants to merge 5 commits into
base: master
Choose a base branch
from
Open

Couple simple changes to start, including working operator with > 2 operands #1

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
e8792a2
Updated to actually display output from print statements
Hedrik Oct 30, 2014
8096f66
more tests
Hedrik Oct 30, 2014
4170a1f
remove dup code in grammar
Hedrik Oct 30, 2014
1996d6f
add debug output
Hedrik Oct 30, 2014
45fa030
More debug, and now handles more than 2 operands
Hedrik Oct 31, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 25 additions & 2 deletions DSL/Operator.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,10 +17,28 @@ has 'arguments' => (
required => 1
);

my $debug = 1;
# Comment out next line for debug output
#undef $debug;

sub from_parse {
my $self=shift;
my @terms;
print STDERR "DSL::Operator->from_parse( ".(
(ref $_[0] eq "ARRAY") ?
"[ ".join(", ",map { my $that = $_;
while (ref $that eq 'ARRAY' and @$that == 1) {$that = $that->[0];}
((ref $that) =~ /^DSL::/) ? $that->prettyprint : $that
} @{$_[0]})." ]"
: (ref $_[0]) =~ /^DSL::/ ? $_[0]->prettyprint : $_[0]
)." )\n" if defined($debug);
@terms=@{$_[0]}; shift;
print STDERR "~~(" if defined($debug);
for my $that (@terms) {
print STDERR " \"".(((ref $that) =~ /^DSL::/) ? $that->prettyprint : $that)."\"" if defined($debug);
while (ref $that eq 'ARRAY' and @$that == 1) {$that = $that->[0];}
}
print STDERR " )~~\n" if defined($debug);
if (@terms < 2) {
return $terms[0];
}
Expand All @@ -29,11 +47,16 @@ sub from_parse {
}
my @args = (shift @terms);
my $op = shift @terms;
while($terms[1] eq $op) {
my $oneLastTerm=0;
while((@terms > 1) && ($terms[1] eq $op)) {
push @args, shift @terms;
shift @terms;
$oneLastTerm=1;
}
return __PACKAGE__->new( operator=>$op, arguments=>[ @args, __PACKAGE__->from_parse(@terms)] );
push @args, shift @terms if $oneLastTerm;
return (@terms == 0)
? __PACKAGE__->new( operator=>$op, arguments=>[ @args ] )
: __PACKAGE__->new( operator=>$op, arguments=>[ @args, __PACKAGE__->from_parse(@terms)] );

}

Expand Down
48 changes: 26 additions & 22 deletions DSL/Parser.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,32 +31,36 @@ equals: '='
variable:
/(?!=print[^a-zA-Z0-9_])[a-zA-Z_][a-zA-Z0-9_]*/ { "DSL::Variable"->get($item[1]) }

expression: <leftop: term ('+' | '-') term>
{
my $expressions=$item[1];
if (ref $expressions ne 'ARRAY') {
expression: <leftop: term ('+' | '-') term> expOrTermProc[$item[1]]

term: <leftop: factor ('*' | '/') factor> expOrTermProc[$item[1]]

# {
# my $expressions=$item[1];
# if (ref $expressions ne 'ARRAY') {
# $return=$expressions;
# }
# elsif (@$expressions == 1) {
# $return=$expressions->[0];
# if (ref $return eq 'ARRAY' and @$return == 1) {
# $return=$return->[0];
# }
# }
# else {
# $return=DSL::Operator->from_parse($expressions);
# }
# }

expOrTermProc: {
my $expressions=$arg[0];
## should always be an array
if ((ref $expressions) ne 'ARRAY') {
$return=$expressions;
}
elsif (@$expressions == 1) {
$return=$expressions->[0];
if (ref $return eq 'ARRAY' and @$return == 1) {
$return=$return->[0];
}
}
else {
$return=DSL::Operator->from_parse($expressions);
}
}

term: <leftop: factor ('*' | '/') factor>
{
my $expressions=$item[1];
if (ref $expressions ne 'ARRAY') {
$return=$expressions;
}
elsif (@$expressions == 1) {
$return=$expressions->[0];
if (ref $return eq 'ARRAY' and @$return == 1) {
## reductio ad infinitum
while ((ref $return) eq 'ARRAY' and @$return == 1) {
$return=$return->[0];
}
}
Expand Down
3 changes: 2 additions & 1 deletion DSL/Statement/Print.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,9 @@ sub do {
for my $expression (@{$self->expressions}) {
my $result=$expression->do;
push @results, $result;
# print $result;
print $result;
}
print "\n";
return join(", ", @results) . "\n";
}

Expand Down
19 changes: 18 additions & 1 deletion prd.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,17 +20,34 @@

my @tests=(
"a=7;\nb =6\n;c = a + b;\nprint a;\nprint a+b; print c*a; print a+b*c;\n",
"print 2 * 2;\n",
"print 2 * 2 + 1;\n",
"print 2d6 + 2d6;\n",
"a=7;\nb =6\n;c = a + b;\nprint a+b+c; print a*b*c;\n",
"print 2 * 2 * 1;\n",
"print 2*2*1;\n",
"print 1d6;\n",
"print d6;\n",
"print 2d6;\n",
"print 2d6, 2d6;\n",
"print 32d24;\n",
"a=2d6\n;print a;\n",
"print 2d6 + 2d6 + 2d6;\n",
);

for my $test (0..$#tests) {
print "==========\n";
printf "Test %2d:\n%s\n", 1+$test, $tests[$test];
print "----------\n";
my $result=$dsl->parse($tests[$test]);
die "Cannot parse test " . ($test+1) . "\n" unless (defined($result));
do {print "****-> Cannot parse test " . ($test+1) . "\n";next;} unless (defined($result));
# print Dumper($result);
print $result->prettyprint;
print "<--Output-->\n";
my $retResult=$result->do;
print "--Returned result--> ".$retResult;
}
print "###########\n\n";

exit;

Expand Down