#!perl
# Copyright 2016 Jeffrey Kegler
# This file is part of Marpa::R3.  Marpa::R3 is free software: you can
# redistribute it and/or modify it under the terms of the GNU Lesser
# General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# Marpa::R3 is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser
# General Public License along with Marpa::R3.  If not, see
# http://www.gnu.org/licenses/.
# CENSUS: ASIS
# Note: Converted to SLIF from minus.t
use 5.010001;
use strict;
use warnings;
use Test::More tests => 10;
use lib 'inc';
use Marpa::R3::Test;
use Marpa::R3;
# The inefficiency (at least some of it) is deliberate.
# Passing up a duples of [ string, value ] and then
# assembling a final string at the top would be better
# than assembling the string then taking it
# apart at each step.  But I wanted to test having
# a start symbol that appears repeatedly on the RHS.
## no critic (Subroutines::RequireArgUnpacking)
sub subtraction {
    shift;
    my ( $right_string, $right_value ) = ( $_[2] =~ /^(.*)==(.*)$/xms );
    my ( $left_string,  $left_value )  = ( $_[0] =~ /^(.*)==(.*)$/xms );
    my $value = $left_value - $right_value;
    return '(' . $left_string . q{-} . $right_string . ')==' . $value;
} ## end sub subtraction
sub postfix_decr {
    shift;
    my ( $string, $value ) = ( $_[0] =~ /^(.*)==(.*)$/xms );
    return '(' . $string . q{--} . ')==' . $value--;
}
sub prefix_decr {
    shift;
    my ( $string, $value ) = ( $_[1] =~ /^(.*)==(.*)$/xms );
    return '(' . q{--} . $string . ')==' . --$value;
}
sub negation {
    shift;
    my ( $string, $value ) = ( $_[1] =~ /^(.*)==(.*)$/xms );
    return '(' . q{-} . $string . ')==' . -$value;
}
sub number {
    shift;
    my $value = $_[0];
    return "$value==$value";
}
sub minusminus {
    return q{--};
}
sub default_action {
    shift;
    return q{} if scalar @_ <= 0;
    return $_[0] if scalar @_ == 1;
    return '(' . join( q{;}, @_ ) . ')';
} ## end sub default_action
## use critic
my $grammar = Marpa::R3::Scanless::G->new(
    {
        source => \<<'END_OF_DSL',
:default ::= action => default_action
E ::= E Minus E action => subtraction
E ::= E MinusMinus action => postfix_decr
E ::= MinusMinus E action => prefix_decr
E ::= Minus E action => negation
E ::= Number action => number
MinusMinus ::= Minus Minus action => minusminus
Minus ~ '-'
Number ~ [\d]+
END_OF_DSL
        }
);
my $recce = Marpa::R3::Scanless::R->new( {
        grammar => $grammar,
        semantics_package => 'main',
} );
Marpa::R3::Test::is( $grammar->show_rules,
    <<'END_RULES', 'Minuses Equation Rules' );
G1 R0 E ::= E Minus E
G1 R1 E ::= E MinusMinus
G1 R2 E ::= MinusMinus E
G1 R3 E ::= Minus E
G1 R4 E ::= Number
G1 R5 MinusMinus ::= Minus Minus
G1 R6 [:start] ::= E
END_RULES
Marpa::R3::Test::is( $grammar->show_ahms,
    <<'END_AHMS', 'Minuses Equation AHMs' );
AHM 0: postdot = "E"
    E ::= . E Minus E
AHM 1: postdot = "Minus"
    E ::= E . Minus E
AHM 2: postdot = "E"
    E ::= E Minus . E
AHM 3: completion
    E ::= E Minus E .
AHM 4: postdot = "E"
    E ::= . E MinusMinus
AHM 5: postdot = "MinusMinus"
    E ::= E . MinusMinus
AHM 6: completion
    E ::= E MinusMinus .
AHM 7: postdot = "MinusMinus"
    E ::= . MinusMinus E
AHM 8: postdot = "E"
    E ::= MinusMinus . E
AHM 9: completion
    E ::= MinusMinus E .
AHM 10: postdot = "Minus"
    E ::= . Minus E
AHM 11: postdot = "E"
    E ::= Minus . E
AHM 12: completion
    E ::= Minus E .
AHM 13: postdot = "Number"
    E ::= . Number
AHM 14: completion
    E ::= Number .
AHM 15: postdot = "Minus"
    MinusMinus ::= . Minus Minus
AHM 16: postdot = "Minus"
    MinusMinus ::= Minus . Minus
AHM 17: completion
    MinusMinus ::= Minus Minus .
AHM 18: postdot = "E"
    [:start] ::= . E
AHM 19: completion
    [:start] ::= E .
AHM 20: postdot = "[:start]"
    [:start]['] ::= . [:start]
AHM 21: completion
    [:start]['] ::= [:start] .
END_AHMS
my %expected = map { ( $_ => 1 ) } (
    #<<< no perltidy
    '(((6--)--)-1)==5',
    '((6--)-(--1))==6',
    '((6--)-(-(-1)))==5',
    '(6-(--(--1)))==7',
    '(6-(--(-(-1))))==6',
    '(6-(-(--(-1))))==4',
    '(6-(-(-(--1))))==6',
    '(6-(-(-(-(-1)))))==5',
    #>>>
);
$recce->read( \q{6-----1} );
# Set max_parses to 20 in case there's an infinite loop.
# This is for debugging, after all
$recce->set( { max_parses => 20 } );
while ( my $value_ref = $recce->value() ) {
    my $value = $value_ref ? ${$value_ref} : 'No parse';
    if ( defined $expected{$value} ) {
        delete $expected{$value};
        Test::More::pass("Expected Value $value");
    }
    else {
        Test::More::fail("Unexpected Value $value");
    }
} ## end while ( my $value_ref = $recce->value() )
1;    # In case used as "do" file
# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: