gistfile1.txt

our sub _HELPER_generate-series(@lhs, $rhs , :$exclude-limit) {
    my sub get-series-params (@lhs, $limit? ) {
        fail "Need something on the LHS" unless @lhs.elems;
        fail "Need more than one item on the LHS" if @lhs.elems == 1 && $limit ~~ Code;
        fail "Need more items on the LHS" if @lhs[*-1] ~~ Code && @lhs[*-1].count != Inf && @lhs.elems < @lhs[*-1].count;

        my $limit-reached;
        given $limit {
            when Code { $limit-reached = $limit; }
            when .defined { 
                $limit-reached = sub ($previous , $current) {
                    my $current_cmp  =  $limit cmp $current ;
                    return $current_cmp == 0 unless $previous.defined;
                    my $previous_cmp = $limit cmp $previous;

                    return ($current_cmp == 0 #We reached the limit exactly
                            || $previous_cmp != $current_cmp) ; #We went past the limit
                }   
            }
            $limit-reached = Mu;
        }

        #BEWARE: Here be ugliness
        return ( 'code' , @lhs[*-1] , $limit-reached)  if @lhs[* - 1] ~~ Code ; # case: (a,b,c,{code}) ... *
        return ( 'stag' , { $_ } , $limit-reached) if @lhs.elems > 1 && @lhs[*-1] cmp @lhs[*-2] == 0 ;  # case: (a , a) ... *

        if  @lhs[*-1] ~~ Str ||  $limit ~~ Str {
            if @lhs[*-1].chars == 1 && $limit.defined && $limit.chars == 1 {
                return ( 'char-succ' , { $_.ord.succ.chr } , $limit-reached) if @lhs[*-1] lt  $limit;# case (... , non-number) ... limit
                return ( 'char-pred' , { $_.ord.pred.chr } , $limit-reached) if @lhs[*-1] gt  $limit;# case (... , non-number) ... limit
            }
            return ( 'text-succ' , { $_.succ } , $limit-reached) if $limit.defined && @lhs[*-1] lt  $limit;# case (... , non-number) ... limit
            return ( 'text-pred' , { $_.pred } , $limit-reached) if $limit.defined && @lhs[*-1] gt  $limit;# case (... , non-number) ... limit
            return ( 'text-pred' , { $_.pred } , $limit-reached) if @lhs.elems > 1 && @lhs[*-2] gt  @lhs[*-1];# case (non-number , another-smaller-non-number) ... *
            return ( 'text-succ' , { $_.succ } , $limit-reached) ;# case (non-number , another-non-number) ... *
        }
        return ( 'pred' , { $_.pred } , $limit-reached) if @lhs.elems == 1 && $limit.defined && $limit before @lhs[* - 1];  # case: (a) ... b where b before a
        return ( 'succ' , { $_.succ } , $limit-reached) if @lhs.elems == 1 ;  # case: (a) ... *

        my $diff = @lhs[*-1] - @lhs[*-2];
        return ('arithmetic' , { $_ + $diff } , $limit-reached) if @lhs.elems == 2 || @lhs[*-2] - @lhs[*-3] == $diff ; #Case Arithmetic series

        if @lhs[*-2] / @lhs[*-3] == @lhs[*-1] / @lhs[*-2] { #Case geometric series
            my $factor = @lhs[*-2] / @lhs[*-3];
            if $factor ~~ ::Rat && $factor.denominator == 1 {
                $factor = $factor.Int;
            }
            if ($factor < 0) {
                return ( 'geometric-switching-sign' , { $_ * $factor } , -> $a, $b { $limit-reached.($a.abs, $b.abs) });
            } else {
                return ( 'geometric-same-sign' , { $_ * $factor } , $limit-reached);
            }
        }
        fail "Unable to figure out pattern of series";
    }

    my sub is-on-the-wrong-side($type , $get-value-to-compare, $limit , @lhs ) {
        my $first = @lhs[*-3] // @lhs[0];
        return if $limit ~~ Code;

        if $type eq 'arithmetic' | 'geometric-switching-sign' | 'geometric-same-sign' {
            ($get-value-to-compare(@lhs[*-2]) >= $get-value-to-compare(@lhs[*-1]) && $get-value-to-compare($limit) > $get-value-to-compare($first) )
            ||
            ($get-value-to-compare(@lhs[*-2]) <= $get-value-to-compare(@lhs[*-1]) && $get-value-to-compare($limit) < $get-value-to-compare($first) );
        }
    }

    my sub infinite-series (@lhs, $next , $type) {
        gather {
            for 0..^(@lhs.elems - 1) -> $i { take @lhs[$i]; }
            take @lhs[*-1] unless $type eq 'code';

            my $arity = $next.count;
            my @args=@lhs;
            pop @args if $type eq 'code';
            @args.munch( @args.elems - $arity ); #We make sure there are $arity + 1 elems

            loop {                         #Then we extrapolate using $next and the $args
                my $current = $next.(|@args) // last;
                take $current ;
                if $arity {
                    @args.push($current) ;
                    @args.munch(1) if @args.elems > $arity
                }
            }
        }
    }

    my $limit = ($rhs ~~ Whatever ?? Any !! $rhs);
    fail('Limit must be a literal') if $exclude-limit && (!$limit.defined || $limit ~~ Code);
    my ($type , $next , $limit-reached) = get-series-params(@lhs , $limit );
    return infinite-series(@lhs , $next , $type) unless $limit.defined; #Infinite series

    my $series = infinite-series(@lhs , $next , $type);
    my $get-value-to-compare = $type eq 'geometric-switching-sign' ?? { $_.abs; } !! { $_; };
    return Nil if @lhs.elems > 1 && is-on-the-wrong-side($type , $get-value-to-compare,  $limit , @lhs);

    my $arity = $limit-reached.count;
    my @args;
    gather {
        while $series {
            my $val = $series.shift();
            @args.push: $val;
            @args.munch( @args.elems - $arity ); #We make sure there are $arity + 1 elems
            if $limit-reached.(!@args) {
                take $val if $get-value-to-compare($val) cmp $get-value-to-compare($limit) == 0  && !$exclude-limit;
                last ;
            };
            take $val;
        }
    }
}

our multi sub infix:<...>(@lhs, $limit) {
    _HELPER_generate-series(@lhs, $limit )
}
our multi sub infix:<...^>(@lhs, $limit) {
    _HELPER_generate-series(@lhs, $limit , :exclude-limit)
}
our multi sub infix:<...^>($lhs , $limit) {
    $lhs.list ...^ $limit;
}
our multi sub infix:<...^>(@lhs, @rhs) {
    fail "Need something on RHS" if !@rhs;
    (@lhs ...^ @rhs.shift), @rhs
}