#!/usr/bin/perl

my $maxbits =  32; # Maximum pattern length.
my $Sigma   = 256; # Assume 8-bit text.

sub shift_OR_exact { # Exact shift-OR
                     # a.k.a. Baeza-Yates-Gonnet exact.
    use integer;

    my ( $T, $P ) = @_; # The text and the pattern.

    # Sanity checks.

    my ( $n, $m ) = ( length( $T ), length( $P ) );

    die "pattern '$P' longer than $maxbits\n" if $m > $maxbits;
    return -1 if $m  > $n;
    return  0 if $m == $n and $P eq $T;
    return  index( $T, $P ) if $m == 1;

    # Preprocess.

    # We need a mask of $m 1 bits, the $m1b.
    my $m1b = ( 1 << $m ) - 1;
    my ( $i, @table, $mask );

    for ( $i = 0; $i < $Sigma; $i++ ) { # Initialize the table.
        $table[ $i ] = $m1b;
    }

    # Adjust the table according to the pattern.
    for ( $i = 0, $mask = 1 ; $i < $m; $i++, $mask <<= 1 ) {
        $table[ ord( substr( $P, $i, 1 ) ) ] &= ~$mask;
    }

    # Match.

    my $last_i = $m - $m;
    my $state;
    my $P0     = substr( $P, 0, 1 ); # Fast skip goal.
    my $watch  = 1 << ( $m - 1 );    # This bit off indicates a match.

    for ( $i = 0; $i < $n; $i++ ) {
        # Fast skip and fast fail.
        $i = index( $T, $P0, $i );
        return -1 if $i == -1;

        $state = $m1b;

        while ( $i < $n ) {
            $state =              # Advance the state.
                ( $state << 1 ) | # The 'Shift' and the 'OR'.
                $table[ ord( substr( $T, $i, 1 ) ) ];
            # Check for match.
            return $i - $m + 1 # Match.
                if ( $state & $watch ) == 0;
            # Give up this match attempt.
            # (but not yet the whole string:
            #  a battle lost versus a war lost)
            last if $state == $m1b;
            $i++;
        }
    }

    return -1; # Mismatch.
}
