#  (C) Copyright David Abrahams 2002. Permission to copy, use, modify, sell and
#  distribute this software is granted provided this copyright notice appears in
#  all copies. This software is provided "as is" without express or implied
#  warranty, and with no claim as to its suitability for any purpose.

import assert ;

# 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 ] is
# has a non-null value.
rule filter ( predicate__ + : sequence__ * )
{
    # trailing underscores hopefully prevent collisions with module
    # locals in the caller
    local result__ ; 
    
    module [ CALLER_MODULE ]
    {
        for local e in $(sequence__)
        {
            if [ $(predicate__) $(e) ]
            {
                result__ += $(e) ;
            }
        }
    }
    return $(result__) ;
}

# return a new sequence consisting of [ $(function) $(e) ] for each
# element e of $(sequence).
rule transform ( function__ + : sequence__ * )
{
    # trailing underscores hopefully prevent collisions with module
    # locals in the caller
    local result__ ; 
    
    module [ CALLER_MODULE ]
    {
        for local e in $(sequence__)
        {
            result__ += [ $(function__) $(e) ] ;
        }
    }
    return $(result__) ;
}


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

# insertion-sort s using the BinaryPredicate ordered.
rule insertion-sort ( s * : ordered * )
{
    ordered ?= sequence.less ;
    local result__ = $(s[1]) ;
    module [ CALLER_MODULE ]
    {
        for local x in $(s[2-])
        {
            local head tail ;
            tail = $(result__) ;
            while $(tail) && [ $(ordered) $(tail[1]) $(x) ]
            {
                head += $(tail[1]) ;
                tail = $(tail[2-]) ;
            }
            result__ = $(head) $(x) $(tail) ;
        }
    }
    return $(result__) ;
}

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

# Find the length of any sequence in log(N) time.
rule length ( s * )
{
    local length = "" ;
    local zeros p10 d z ; # declared once for speed
    
    # Find the power of 10 that is just less than length(s)
    zeros = "" ;
    p10 = 1 ;
    while $(s[$(p10)0])
    {
        p10 = $(p10)0 ;
        zeros = $(zeros[1])0 $(zeros) ;
    }
    
    # zeros is a list of the form  ... 000 00 0 ""
    for z in $(zeros) # for each digit in the result
    {
        # Find the next digit
        d = 0 1 2 3 4 5 6 7 8 9 ;
        while $(s[$(d[2])$(z)])
        {
            d = $(d[2-]) ;
        }
        
        # append it to the result
        length = $(length)$(d[1]) ;
        
        # Explanation: $(d[1])$(z) the largest number x of the form
        # n000..., where n is a digit, such that x <= length(s). Here
        # we're deleting x elements from the list. Since $(s[n]-)
        # removes n - 1 elements from the list, we chop an additional
        # one off the end.
        s = $(s[$(d[1])$(z)--2]) ;
    }
    return $(length) ;
}

rule unique ( list * )
{
    local result ;
    for local f in $(list)
    {
        if ! $(f) in $(result)
        {
            result += $(f) ;
        }
    }
    return $(result) ;
}

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

        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 foo-bar-baz : sequence.join foo bar baz : - ;
        assert.result substandard : sequence.join sub stan dard ;
        
        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 ;
        
        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 ;
    }
}