diff options
| -rw-r--r-- | challenge-323/adam-russell/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-323/adam-russell/perl/IncrementDecrement.pm | 220 | ||||
| -rw-r--r-- | challenge-323/adam-russell/perl/IncrementDecrement.yp | 89 | ||||
| -rw-r--r-- | challenge-323/adam-russell/perl/ch-1.pl | 43 | ||||
| -rw-r--r-- | challenge-323/adam-russell/perl/ch-2.pl | 37 |
5 files changed, 390 insertions, 0 deletions
diff --git a/challenge-323/adam-russell/blog.txt b/challenge-323/adam-russell/blog.txt new file mode 100644 index 0000000000..f3b5f56af8 --- /dev/null +++ b/challenge-323/adam-russell/blog.txt @@ -0,0 +1 @@ +http://www.rabbitfarm.com/cgi-bin/blosxom/perl/2025/06/05 diff --git a/challenge-323/adam-russell/perl/IncrementDecrement.pm b/challenge-323/adam-russell/perl/IncrementDecrement.pm new file mode 100644 index 0000000000..41b6b03dd5 --- /dev/null +++ b/challenge-323/adam-russell/perl/IncrementDecrement.pm @@ -0,0 +1,220 @@ +#################################################################### +# +# This file was generated using Parse::Yapp version 1.21. +# +# Don't edit this file, use source file instead. +# +# ANY CHANGE MADE HERE WILL BE LOST ! +# +#################################################################### +package IncrementDecrement; +use vars qw ( @ISA ); +use strict; + +@ISA= qw ( Parse::Yapp::Driver ); +use Parse::Yapp::Driver; + +#line 10 "perl/IncrementDecrement.yp" + + my $variable_state = {}; + + +sub new { + my($class)=shift; + ref($class) + and $class=ref($class); + + my($self)=$class->SUPER::new( yyversion => '1.21', + yystates => +[ + {#State 0 + ACTIONS => { + 'DECREMENT' => 2, + 'INCREMENT' => 7, + 'LETTER' => 1 + }, + GOTOS => { + 'program' => 9, + 'decrement_variable' => 8, + 'increment_decrement' => 4, + 'increment_variable' => 3, + 'variable_declaration' => 6, + 'statement' => 5 + } + }, + {#State 1 + ACTIONS => { + 'INCREMENT' => 11, + 'DECREMENT' => 10 + }, + DEFAULT => -5 + }, + {#State 2 + ACTIONS => { + 'LETTER' => 12 + } + }, + {#State 3 + DEFAULT => -6 + }, + {#State 4 + DEFAULT => -4 + }, + {#State 5 + DEFAULT => -1 + }, + {#State 6 + DEFAULT => -3 + }, + {#State 7 + ACTIONS => { + 'LETTER' => 13 + } + }, + {#State 8 + DEFAULT => -7 + }, + {#State 9 + ACTIONS => { + '' => 15, + 'LETTER' => 1, + 'INCREMENT' => 7, + 'DECREMENT' => 2 + }, + GOTOS => { + 'statement' => 14, + 'variable_declaration' => 6, + 'increment_variable' => 3, + 'decrement_variable' => 8, + 'increment_decrement' => 4 + } + }, + {#State 10 + DEFAULT => -11 + }, + {#State 11 + DEFAULT => -9 + }, + {#State 12 + DEFAULT => -10 + }, + {#State 13 + DEFAULT => -8 + }, + {#State 14 + DEFAULT => -2 + }, + {#State 15 + DEFAULT => 0 + } +], + yyrules => +[ + [#Rule 0 + '$start', 2, undef + ], + [#Rule 1 + 'program', 1, +sub +#line 19 "perl/IncrementDecrement.yp" +{$variable_state} + ], + [#Rule 2 + 'program', 2, undef + ], + [#Rule 3 + 'statement', 1, undef + ], + [#Rule 4 + 'statement', 1, undef + ], + [#Rule 5 + 'variable_declaration', 1, +sub +#line 27 "perl/IncrementDecrement.yp" +{$variable_state->{$_[1]} = 0} + ], + [#Rule 6 + 'increment_decrement', 1, undef + ], + [#Rule 7 + 'increment_decrement', 1, undef + ], + [#Rule 8 + 'increment_variable', 2, +sub +#line 34 "perl/IncrementDecrement.yp" +{$variable_state->{$_[2]}++} + ], + [#Rule 9 + 'increment_variable', 2, +sub +#line 35 "perl/IncrementDecrement.yp" +{$variable_state->{$_[1]}++} + ], + [#Rule 10 + 'decrement_variable', 2, +sub +#line 38 "perl/IncrementDecrement.yp" +{$variable_state->{$_[2]}--} + ], + [#Rule 11 + 'decrement_variable', 2, +sub +#line 39 "perl/IncrementDecrement.yp" +{$variable_state->{$_[1]}--} + ] +], + @_); + bless($self,$class); +} + +#line 44 "perl/IncrementDecrement.yp" + + + + + sub lexer{ + my($parser) = @_; + $parser->YYData->{INPUT} or return(q//, undef); + $parser->YYData->{INPUT} =~ s/^[ \t]//g; + ## + # send tokens to parser + ## + for($parser->YYData->{INPUT}){ + s/^(\s+)// and return (q/SPACE/, $1); + s/^([a-z]{1})// and return (q/LETTER/, $1); + s/^(\+\+)// and return (q/INCREMENT/, $1); + s/^(--)// and return (q/DECREMENT/, $1); + } + } + + + sub parse{ + my($self, $input) = @_; + $input =~ tr/\t/ /s; + $input =~ tr/\n/ /s; + $self->YYData->{INPUT} = $input; + my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error); + return $result; + } + + + sub error{ + exists $_[0]->YYData->{ERRMSG} + and do{ + print $_[0]->YYData->{ERRMSG}; + return; + }; + print "syntax error\n"; + } + + + sub clear{ + my($self) = @_; + $variable_state = {}; + } + + + +1; diff --git a/challenge-323/adam-russell/perl/IncrementDecrement.yp b/challenge-323/adam-russell/perl/IncrementDecrement.yp new file mode 100644 index 0000000000..9883cc9494 --- /dev/null +++ b/challenge-323/adam-russell/perl/IncrementDecrement.yp @@ -0,0 +1,89 @@ + + + + %token INCREMENT + %token DECREMENT + %token LETTER + %expect 2 + + + %{ + my $variable_state = {}; + %} + + + + %% + + + program: statement {$variable_state} + | program statement + ; + + statement: variable_declaration #{$variable_state} + | increment_decrement + ; + + variable_declaration: LETTER {$variable_state->{$_[1]} = 0} + ; + + increment_decrement: increment_variable + | decrement_variable + ; + + increment_variable: INCREMENT LETTER {$variable_state->{$_[2]}++} + | LETTER INCREMENT {$variable_state->{$_[1]}++} + ; + + decrement_variable: DECREMENT LETTER {$variable_state->{$_[2]}--} + | LETTER DECREMENT {$variable_state->{$_[1]}--} + ; + + + + %% + + + + sub lexer{ + my($parser) = @_; + $parser->YYData->{INPUT} or return(q//, undef); + $parser->YYData->{INPUT} =~ s/^[ \t]//g; + ## + # send tokens to parser + ## + for($parser->YYData->{INPUT}){ + s/^(\s+)// and return (q/SPACE/, $1); + s/^([a-z]{1})// and return (q/LETTER/, $1); + s/^(\+\+)// and return (q/INCREMENT/, $1); + s/^(--)// and return (q/DECREMENT/, $1); + } + } + + + sub parse{ + my($self, $input) = @_; + $input =~ tr/\t/ /s; + $input =~ tr/\n/ /s; + $self->YYData->{INPUT} = $input; + my $result = $self->YYParse(yylex => \&lexer, yyerror => \&error); + return $result; + } + + + sub error{ + exists $_[0]->YYData->{ERRMSG} + and do{ + print $_[0]->YYData->{ERRMSG}; + return; + }; + print "syntax error\n"; + } + + + sub clear{ + my($self) = @_; + $variable_state = {}; + } + + diff --git a/challenge-323/adam-russell/perl/ch-1.pl b/challenge-323/adam-russell/perl/ch-1.pl new file mode 100644 index 0000000000..28698eecb8 --- /dev/null +++ b/challenge-323/adam-russell/perl/ch-1.pl @@ -0,0 +1,43 @@ + + + use v5.40; + use IncrementDecrement; + +use constant TEST0 => q/--x x++ x++/; +use constant TEST1 => q/x++ ++x x++/; +use constant TEST2 => q/x++ ++x --x x--/; +use constant COMPLEX_TEST => <<~END_TEST; + a b c + a++ b++ c++ + ++a ++b ++c + --a --b --c + a-- b-- c-- + a++ ++b c++ + END_TEST + + + + sub print_variables{ + my($results) = @_; + for my $k (keys %{$results}){ + print $k; + say qq/:\t$results->{$k}/; + } + } + + +MAIN:{ + my $parser = IncrementDecrement->new(); + say TEST0; + say print_variables $parser->parse(TEST0); + say TEST1; + $parser->clear(); + say print_variables $parser->parse(TEST1); + say TEST2; + $parser->clear(); + say print_variables $parser->parse(TEST2); + say COMPLEX_TEST; + $parser->clear(); + say print_variables $parser->parse(COMPLEX_TEST); +} + diff --git a/challenge-323/adam-russell/perl/ch-2.pl b/challenge-323/adam-russell/perl/ch-2.pl new file mode 100644 index 0000000000..fc05d1e33f --- /dev/null +++ b/challenge-323/adam-russell/perl/ch-2.pl @@ -0,0 +1,37 @@ + + use v5.40; + + sub calculate_tax{ + my($income, $tax_brackets) = @_; + + $tax_brackets = [sort {$a->[0] <=> $b->[0]} @{$tax_brackets}]; + use Data::Dump q/pp/; + + my $tax = 0; + my $taxed = 0; + my $taxable = 0; + + { + my $tax_bracket = shift @{$tax_brackets}; + if($tax_bracket->[0] <= $income){ + $taxable = $tax_bracket->[0] - $taxable; + $tax += ($taxable * ($tax_bracket->[1]/100)); + $taxed += $taxable; + } + else{ + $tax += (($income - $taxed) * ($tax_bracket->[1]/100)); + $taxed = $income; + } + redo unless $taxed >= $income || @{$tax_brackets} == 0; + } + + return $tax; + } + + +MAIN:{ + say calculate_tax 10, [[3, 50], [7, 10], [12,25]]; + say calculate_tax 2, [[1, 0], [4, 25], [5,50]]; + say calculate_tax 0, [[2, 50]]; +} + |
