src/util/sequence.jam

# Copyright 2001, 2002, 2003 Dave Abrahams
# Copyright 2006 Rene Rivera
# Copyright 2002, 2003 Vladimir Prus
# Distributed under the Boost Software License, Version 1.0.
# (See accompanying file LICENSE_1_0.txt or http://www.boost.org/LICENSE_1_0.txt)

import assert ;
import numbers ;
import modules ;


# Note that algorithms in this module execute largely in the caller's module
# namespace, so that local rules can be used as function objects. Also note that
# most predicates can be multi-element lists. In that case, all but the first
# element are prepended to the first argument which is passed to the rule named
# by the first element.


# Return the elements e of $(sequence) for which [ $(predicate) e ] has a
# non-null value.
#
rule filter ( predicate + : sequence * )
{
    local caller = [ CALLER_MODULE ] ;
    local result ;

    for local e in $(sequence)
    {
        if [ modules.call-in $(caller) : $(predicate) $(e) ]
        {
            result += $(e) ;
        }
    }
    return $(result) ;
}


# Return a new sequence consisting of [ $(function) $(e) ] for each element e of
# $(sequence).
#
rule transform ( function + : sequence * )
{
    local caller = [ CALLER_MODULE ] ;
    local result ;

    for local e in $(sequence)
    {
        result += [ modules.call-in $(caller) : $(function) $(e) ] ;
    }
    return $(result) ;
}

if [ HAS_NATIVE_RULE sequence : transform : 1 ]
{
    NATIVE_RULE sequence : transform ;
}

# Returns the elements of 's' in reverse order
rule reverse ( s * )
{
    local r ;
    for local x in $(s)
    {
        r = $(x) $(r) ;
    }
    return $(r) ;
}


rule less ( a b )
{
    if $(a) < $(b)
    {
        return true ;
    }
}


# Insertion-sort s using the BinaryPredicate ordered.
#
rule insertion-sort ( s * : ordered * )
{
    if ! $(ordered)
    {
        return [ SORT $(s) ] ;
    }
    else
    {
        local caller = [ CALLER_MODULE ] ;
        ordered ?= sequence.less ;
        local result = $(s[1]) ;
        if $(ordered) = sequence.less
        {
            local head tail ;
            for local x in $(s[2-])
            {
                head = ;
                tail = $(result) ;
                while $(tail) && ( $(tail[1]) < $(x) )
                {
                    head += $(tail[1]) ;
                    tail = $(tail[2-]) ;
                }
                result = $(head) $(x) $(tail) ;
            }
        }
        else
        {
            for local x in $(s[2-])
            {
                local head tail ;
                tail = $(result) ;
                while $(tail) && [ modules.call-in $(caller) : $(ordered) $(tail[1]) $(x) ]
                {
                    head += $(tail[1]) ;
                    tail = $(tail[2-]) ;
                }
                result = $(head) $(x) $(tail) ;
            }
        }

        return $(result) ;
    }
}


# Merge two ordered sequences using the BinaryPredicate ordered.
#
rule merge ( s1 * : s2 * : ordered * )
{
    ordered ?= sequence.less ;
    local result__ ;
    local caller = [ CALLER_MODULE ] ;

    while $(s1) && $(s2)
    {
        if [ modules.call-in $(caller) : $(ordered) $(s1[1]) $(s2[1]) ]
        {
            result__ += $(s1[1]) ;
            s1 = $(s1[2-]) ;
        }
        else if [ modules.call-in $(caller) : $(ordered) $(s2[1]) $(s1[1]) ]
        {
            result__ += $(s2[1]) ;
            s2 = $(s2[2-]) ;
        }
        else
        {
            s2 = $(s2[2-]) ;
        }

    }
    result__ += $(s1) ;
    result__ += $(s2) ;

    return $(result__) ;
}

# Compares two sequences lexicagraphically
#
rule compare ( s1 * : s2 * : ordered * )
{
    if ! $(ordered)
    {
        if $(s1) < $(s2)
        {
            return true ;
        }
    }
    else
    {
        while true
        {
            if ! $(s2[1])-is-defined
            {
                return ;
            }
            else if ! $(s1[1])-is-defined
            {
                return true ;
            }
            else if [ $(ordered) $(s1[1]) $(s2[1]) ]
            {
                return true ;
            }
            else if [ $(ordered) $(s2[1]) $(s1[1]) ]
            {
                return ;
            }
            s1 = $(s1[2-]) ;
            s2 = $(s2[2-]) ;
        }
    }
}

# Join the elements of s into one long string. If joint is supplied, it is used
# as a separator.
#
rule join ( s * : joint ? )
{
    joint ?= "" ;
    return $(s:J=$(joint)) ;
}


# Find the length of any sequence.
#
rule length ( s * )
{
    local result = 0 ;
    for local i in $(s)
    {
        result = [ CALC $(result) + 1 ] ;
    }
    return $(result) ;
}

# Removes duplicates from 'list'.  If 'stable' is
# passed, then the order of the elements will
# be unchanged.
rule unique ( list * : stable ? )
{
    local result ;
    local prev ;
    if $(stable)
    {
        for local f in $(list)
        {
            if ! $(f) in $(result)
            {
                result += $(f) ;
            }
        }
    }
    else
    {
        for local i in [ SORT $(list) ]
        {
            if $(i) != $(prev)
            {
                result += $(i) ;
            }
            prev = $(i) ;
        }
    }
    return $(result) ;
}


# Returns the maximum number in 'elements'. Uses 'ordered' for comparisons or
# 'numbers.less' if none is provided.
#
rule max-element ( elements + : ordered ? )
{
    ordered ?= numbers.less ;

    local max = $(elements[1]) ;
    for local e in $(elements[2-])
    {
        if [ $(ordered) $(max) $(e) ]
        {
            max = $(e) ;
        }
    }
    return $(max) ;
}


# Returns all of 'elements' for which corresponding element in parallel list
# 'rank' is equal to the maximum value in 'rank'.
#
rule select-highest-ranked ( elements * : ranks * )
{
    if $(elements)
    {
        local max-rank = [ max-element $(ranks) ] ;
        local result ;
        while $(elements)
        {
            if $(ranks[1]) = $(max-rank)
            {
                result += $(elements[1]) ;
            }
            elements = $(elements[2-]) ;
            ranks = $(ranks[2-]) ;
        }
        return $(result) ;
    }
}
NATIVE_RULE sequence : select-highest-ranked ;


rule __test__ ( )
{
    # Use a unique module so we can test the use of local rules.
    module sequence.__test__
    {
        import assert ;
        import sequence ;

        local rule is-even ( n )
        {
            if $(n) in 0 2 4 6 8
            {
                return true ;
            }
        }

        assert.result 4 6 4 2 8 : sequence.filter is-even : 1 4 6 3 4 7 2 3 8 ;

        # Test that argument binding works.
        local rule is-equal-test ( x y )
        {
            if $(x) = $(y)
            {
                return true ;
            }
        }

        assert.result 3 3 3 : sequence.filter is-equal-test 3 : 1 2 3 4 3 5 3 5 7 ;

        local rule append-x ( n )
        {
            return $(n)x ;
        }

        assert.result 1x 2x 3x : sequence.transform append-x : 1 2 3 ;

        local rule repeat2 ( x )
        {
            return $(x) $(x) ;
        }

        assert.result 1 1 2 2 3 3 : sequence.transform repeat2 : 1 2 3 ;

        local rule test-greater ( a b )
        {
            if $(a) > $(b)
            {
                return true ;
            }
        }
        assert.result 1 2 3 4 5 6 7 8 9 : sequence.insertion-sort 9 6 5 3 8 7 1 2 4 ;
        assert.result 9 8 7 6 5 4 3 2 1 : sequence.insertion-sort 9 6 5 3 8 7 1 2 4 : test-greater ;
        assert.result 1 2 3 4 5 6 :  sequence.merge 1 3 5 : 2 4 6 ;
        assert.result 6 5 4 3 2 1 :  sequence.merge 5 3 1 : 6 4 2 : test-greater ;
        assert.result 1 2 3 : sequence.merge 1 2 3 : ;
        assert.result 1 : sequence.merge 1 : 1 ;

        assert.result foo-bar-baz : sequence.join foo bar baz : - ;
        assert.result substandard : sequence.join sub stan dard ;
        assert.result 3.0.1 : sequence.join 3.0.1 : - ;

        assert.result 0 : sequence.length ;
        assert.result 3 : sequence.length a b c ;
        assert.result 17 : sequence.length 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 ;

        assert.result 1 : sequence.length a ;
        assert.result 10 : sequence.length a b c d e f g h i j ;
        assert.result 11 : sequence.length a b c d e f g h i j k ;
        assert.result 12 : sequence.length a b c d e f g h i j k l ;

        local p2 = x ;
        for local i in 1 2 3 4 5 6 7 8
        {
            p2 = $(p2) $(p2) ;
        }
        assert.result 256 : sequence.length $(p2) ;

        assert.result 1 2 3 4 5 : sequence.unique 1 2 3 2 4 3 3 5 5 5 ;

        assert.result 5 : sequence.max-element 1 3 5 0 4 ;

        assert.result e-3 h-3 : sequence.select-highest-ranked e-1 e-3 h-3 m-2 : 1 3 3 2 ;

        assert.result 7 6 5 4 3 2 1 : sequence.reverse 1 2 3 4 5 6 7 ;
    }
}