#  Copyright (C) Vladimir Prus 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 feature ;
import utility : ungrist ;
import sequence : unique ;
import errors : error ;

# Refines 'properties' by overriding any elements for which a different
# value is specified in 'requirements'. If the resulting property set
# will be link-incompatible with 'properties', it is an error.
# On success, returns properties. On error, returns a list which first
# element is "@error" and the other elements compose the explanation
# string.
rule refine ( properties * : requirements * : feature-space ? )
{
    feature-space ?= feature ;

    local result ;
    local error ;


    # All the elements of requirements should be present in the result
    # Record them so that we can handle 'properties'.
    for local r in $(requirements)
    {
        # Note: cannot use local here, so take an ugly name
         __require__$(r:G) = $(r:G=) ;
    }

    for local p in $(properties)
    {
        # No processing for free properties
        if free in [ $(feature-space).attributes $(p:G) ]
        {
            result += $(p) ;
        }
        else
        {
            local required-value = $(__require__$(p:G)) ;
            if $(required-value)
            {
                local value = $(p:G=) ;
                if $(value) != $(required-value)
                {
                    if link-incompatible in [ $(feature-space).attributes $(p:G) ]
                    {
                        error = @error link-incompatible properties $(p) and
                                $(p:G)$(required-value) ;
                        # Cannot break, so just iterate again
                    }
                    else
                    {
                        result += $(p:G)$(required-value) ;
                    }
                }
                else
                {
                    result += $(p) ;
                }
            }
            else
            {
                result += $(p) ;
            }
        }
    }

    # Unset our ugly map.        
    for local r in $(requirements)
    {
         __require__$(r:G) = ;
    }

    if $(error)
    {
        return $(error) ;
    }
    else
    {
        return [ unique $(result) $(requirements) ] ;
    }
}

# Helper for as-path, below. Orders properties with the implicit ones
# first, and within the two sections in alphabetical order of feature
# name.
local rule path-order ( feature-space x y )
{
    if $(y:G) && ! $(x:G)
    {
        return true ;
    }
    else if $(x:G) && ! $(y:G)
    {
        return ;
    }
    else
    {
        if ! $(x:G)
        {
            x = [ $(feature-space).expand-subfeatures $(x) ] ;
            y = [ $(feature-space).expand-subfeatures $(y) ] ;
        }
        
        if $(x[0]) < $(y[0])
        {
            return true ;
        }
    }
}

# Returns a path which represents the given expanded property set.
rule as-path ( properties * : feature-space ? )
{
    feature-space ?= feature ;
    
    # trim redundancy
    properties = [ $(feature-space).minimize $(properties) ] ;
    
    # sort according to path-order
    properties = [ sequence.insertion-sort $(properties) : path-order $(feature-space) ] ;
    
    local components ;
    for local p in $(properties)
    {
        if $(p:G)
        {
            local f = [ ungrist $(p:G) ] ;
            components += $(f)-$(p:G=) ;
        }
        else
        {
            components += $(p) ;
        }
    }
    return $(components:J=/) ;
}

# Exit with error if property is not valid.
rule validate ( property : feature-space ?  )
{
    feature-space ?= feature ;
    local msg ;
    if $(property:G)
    {
        local feature = [ ungrist $(property:G) ] ; # Ungrist for better error messages
        local value = $(property:G=) ;

        if ! [ $(feature-space).valid $(feature) ]
        {
            msg = "unknown feature '$(feature)'" ;
        }
        else if $(value) && ! $(value) in [ $(feature-space).values $(feature) ]
                && ! free in [ $(feature-space).attributes $(feature) ] 
        {
            msg = "value '"$(value:J=" ")"' is not valid for feature'"$(feature)' ;
        } 
        else if ! $(value)
        {
            msg = "No value specified for feature '$(feature)'" ; 
        }
    }
    else
    {
        if ! [ $(feature-space).is-implicit-value $(property) ]
        {
            msg = '$(property:J=" ")' "is not a value of implicit feature" ;        
        }
    }
    if $(msg) 
    {
        error "Invalid property "'$(property:J=" ")'": "$(msg:J=" "). ;
    }
}

local rule __test__ ( )
{
    import class : new ;
    import errors : try catch ;

    local test-space = [ new feature-space ] ;

    module $(test-space)
    {
        import assert ;

        feature toolset : gcc : implicit ;
        feature define : : free ;
        feature runtime-link : dynamic static : symmetric link-incompatible ;
        feature optimization : on off ;
        feature variant : debug release : implicit composite ;
        feature rtti : on off : link-incompatible ;

        compose <variant>debug : <define>_DEBUG <optimization>off ;
        compose <variant>release : <define>NDEBUG <optimization>on ;

    }

    assert.result <toolset>gcc <rtti>off <define>FOO
        : refine <toolset>gcc <rtti>off
        : <define>FOO
        : $(test-space)
        ;

    assert.result <toolset>gcc <optimization>on
        : refine <toolset>gcc <optimization>off
        : <optimization>on
        : $(test-space)
        ;

    assert.result <toolset>gcc <rtti>off
        : refine <toolset>gcc : <rtti>off : $(test-space)
        ;

    assert.result debug
      : as-path <optimization>off <variant>debug
      : $(test-space)
      ;

    assert.result gcc/debug/rtti-off
      : as-path <toolset>gcc <optimization>off <rtti>off <variant>debug
      : $(test-space)
      ;

    r = [ refine <toolset>gcc <rtti>off
            : <rtti>on
            : $(test-space) ] ;
    assert.equal $(r[1]) : "@error" ;

    try ;
        validate <feature>value : $(test-space) ;
    catch "Invalid property '<feature>value': unknown feature 'feature'." ;

    try ;
        validate <rtti>default : $(test-space) ;
    catch "Invalid property '<rtti>default': value 'default' is not valid for feature'rtti'." ;
    
    validate <define>WHATEVER : $(test-space) ;

    try ;
        validate <rtti> : $(test-space) ;
    catch "Invalid property '<rtti>': No value specified for feature 'rtti'." ;

    try ;
        validate value : $(test-space) ;
    catch "Invalid property 'value': 'value' is not a value of implicit feature." ;
           
}