#  (C) Copyright David Abrahams 2001. 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.

# Glossary
#
# feature      -  a normalized aspect of a build configuration
#
# value        -  a specific available setting for a feature
#
# property     -  a feature-value pair, expressed ase <feature>value
#
# subfeature   -  a feature which only exists in the presence of its
#                 parent, and whose identity can be derived (in the
#                 context of its parent) from the name of its value
#
# value-string - a string of the form value-subvalue1-subvalue2...
#                -subvalueN, where value is a feature value and
#                subvalue1...subvalueN are values of related
#                subfeatures.

import class : * ;

# A feature-space is a class to facilitate testing. We want to be able
# to make and populate instances of a feature-space for testing
# purposes without intruding on the default feature-space
local rule feature-space ( )
{
import errors : error lol->list ;
import property ;
import sequence ;
import regex ;
import set ;
    
module local all-attributes = 
    
    implicit    # features whose values alone identify the
                # feature. For example, a user is not required to
                # write "<toolset>gcc", but can simply write
                # "gcc". Implicit feature names also don't appear in
                # variant paths, although the values do. Thus:
                # bin/gcc/... as opposed to bin/toolset-gcc/.... There
                # should typically be only a few such features, to
                # avoid possible name clashes.

    executed    # the feature corresponds to the name of a module
                # containing an execute rule, used to actually prepare
                # the build. For example, the toolset feature would be
                # executed.
    

    composite   # features which actually correspond to groups of
                # properties. For example, a build variant is a
                # composite feature. When generating targets from a
                # set of build properties, composite features are
                # recursively expanded and /added/ to the build
                # property set, so rules can find them if
                # neccessary. Non-composite non-free features override
                # components of composite features in a build property
                # set.
    

    optional    # An optional feature is allowed to have no value at
                # all in a particular build. Normal non-free features
                # are always given the first of their values if no
                # value is otherwise specified.
    

    symmetric   # A symmetric feature has no default value, and is
        # therefore not automatically included in all
        # variants. A symmetric feature, when relevant to the
        # toolset, always generates a corresponding subvariant
        # directory.

    free        # as described in previous documentation

    path        # the (free) feature's value describes a path which
        # might be given relative to the directory of the
        # Jamfile.

    dependency  # the value of the (free) feature specifies a
        # dependency of the target.

    propagated  # when used in a build request, the (free) feature is
        # propagated to top-level targets which are
        # dependencies of the requested build. Propagated
        # features would be most useful for settings such as
        # warning levels, output message style, etc., which
        # don't affect the built products at all.
  ;

module local all-features ;
module local all-implicit-values ;
    
# Transform features by bracketing any elements which aren't already
# bracketed by "<>"
local rule grist ( features * )
{
    local empty = "" ;
    return $(empty:G=$(features)) ;
}

module local empty = "" ;

# declare a new feature with the given name, values, and attributes.
rule feature ( name : values * : attributes * )
{
    name = [ grist $(name) ] ;
    
    local error ;
    
    # if there are any unknown attributes...
    if ! ( $(attributes) in $(all-attributes) )
    {
        error = unknown attributes:
          [ set.difference $(attributes) : $(all-attributes) ] ;
    }
    else if $(name) in $(all-features)
    {
        error = feature already defined: ;
    }
    else if implicit in $(attributes)
    {
        if free in $(attributes)
        {
            error = free features cannot also be implicit ;
        }
    }
    
    if $(error)
    {
        error $(error)
          : "in" feature declaration:
          : feature [ errors.lol->list $(1) : $(2) : $(3) ] ;
    }

    module local $(name).values ;
    module local $(name).attributes = $(attributes) ;
    module local $(name).subfeatures = ;
    module local $(attributes).features ;
    $(attributes).features += $(name) ;
    
    all-features += $(name) ;
    extend $(name) : $(values) ;
}

# return the default property values for the given features.
rule defaults ( features * )
{
    local result ;
    for local f in [ grist $(features) ]
    {
        if free in $($(f).attributes)
        {
        }
        else if optional in $($(f).attributes)
        {
            result += $(f) ;
        }
        else
        {
            result += $(f)$($(f).values[1]) ;
        }
    }
    return $(result) ;
}

# returns true iff all elements of names are valid features.
rule valid ( names + )
{
    if [ grist $(names) ] in $(all-features)
    {
        return true ;
    }
}

# return the attibutes of the given feature
rule attributes ( feature )
{
    if ! [ valid $(feature) ]
    {
        error \"$(feature)\" is not a valid feature name ;
    }
    feature = [ grist $(feature) ] ;
    return $($(feature).attributes) ;
}

# return the values of the given feature
rule values ( feature )
{
    feature = [ grist $(feature) ] ;
    return $($(feature).values) ;
}

# return the implicit feature associated with the given implicit value.
rule implied-feature ( implicit-value )
{
    local feature = $($(implicit-value).implicit-feature) ;
    if ! $(feature)
    {
        error \"$(implicit-value)\" is not a value of an implicit feature ;
    }
    return $(feature) ;
}

local rule find-implied-subfeature ( feature subvalue : value-string ? )
{
    if $(feature) != $(feature:G)
    {
        error invalid feature $(feature) ;
    }
    
    local v
      = subfeature($(feature),$(subvalue)) 
        subfeature($(feature),$(value-string),$(subvalue)) ;
    
    # declaring these module local here prevents us from picking up
    # enclosing definitions.
    module local $(v) ;
    
    local subfeature = $($(v)) ;
    return $(subfeature[1]) ;
}

# Given a feature name and a subfeature value, find the associated
# subfeature.
rule implied-subfeature ( feature subvalue : value-string ? )
{
    feature = [ grist $(feature) ] ;
    local subfeature = [ find-implied-subfeature $(feature) $(subvalue)
      : $(value-string) ] ;
      
    if ! $(subfeature)
    {
        error \"$(subvalue)\" is not a known subfeature value of
          feature $(feature) ;
    }
    
    return $(subfeature) ;
}

# generate an error if the feature is unknown
local rule validate-feature ( feature )
{
    if ! [ grist $(feature) ] in $(all-features)
    {
        error unknown feature \"$(feature)\" ;
    }
}

# expand-subfeatures <toolset>gcc-2.95.2-linux-x86
#       -> <toolset>gcc <toolset-version>2.95.2 <toolset-os>linux <toolset-cpu>x86
#
# equivalent to:
#       expand-subfeatures gcc-2.95.2-linux-x86
local rule expand-subfeatures-aux ( feature ? : value )
{
    if $(feature)
    {
        feature = [ grist $(feature) ] ;
        validate-feature $(feature) ;
    }
    
    local components = [ regex.split $(value) "-" ] ;
    if ! $(feature)
    {
        feature = [ implied-feature $(components[1]) ] ;
    }
    else if ! $(feature) in $(all-features)
    {
        error unknown feature $(feature) ;
    }
    
    # get the top-level feature's value
    local value = $(components[1]:G=) ;
    
    local result = $(components[1]:G=$(feature)) ;
    for local subvalue in $(components[2-])
    {
        local subfeature = [ implied-subfeature $(feature) $(subvalue) : $(value) ] ;
        local f = [ SUBST $(feature) ^<(.*)>$ $1 ] ;
        result += $(subvalue:G=$(f)-$(subfeature)) ;
    }
    
    return $(result) ;
}

rule expand-subfeatures ( properties * )
{
    local result ;
    for local p in $(properties)
    {
        result += [ expand-subfeatures-aux $(p:G) : $(p:G=) ] ;
    }
    return $(result) ;
}

# Helper for extend, below. Handles the case feature case.
local rule extend-feature ( feature : values * )
{
    validate-feature $(feature) ;
    if implicit in $(attributes)
    {
        for local v in $(values)
        {
            module local $(v).implicit-feature ;
            if $($(v).implicit-feature)
            {
                error $(v) is already associated with the \"$($(v).implicit-feature)\" feature ;
            }
            $(v).implicit-feature = $(feature) ;
        }
        
        all-implicit-values += $(values) ;
    }
    $(feature).values += $(values) ;
}

# Checks that value-string is a valide value-string for the given feature.
local rule validate-value-string ( feature value-string )
{
    local values = $(value-string) ;
    if $($(feature).subfeatures)
    {
        values = [ regex.split $(value-string) - ] ;
    }
    
    if ! ( $(values[1]) in $($(feature).values) )
    {
        return \"$(values[1])\" is not a known value of feature $(feature) ;
    }
    
    if $(values[2])
    {
        # this will validate any subfeature values in value-string
        implied-subfeature $(feature) [ sequence.join $(values[2-]) - ]
          : $(values[1]) ;
    }
    
}

# Extends the given subfeature with the subvalues.  If the optional
# value-string is provided, the subvalues are specific to the given
# value of the feature. Thus, you could say that
# <target-platform>mingw is specifc to <toolset>gcc-2.95.2 as follows:
#
#       extend-subfeature toolset gcc-2.95.2 : target-platform : mingw ;
#
rule extend-subfeature ( feature value-string ? : subfeature : subvalues * )
{
    feature = [ grist $(feature) ] ;
    validate-feature $(feature) ;
    if $(value-string)
    {
        validate-value-string $(feature) $(value-string) ;
    }
    
    for local subvalue in $(subvalues)
    {
        local v
          = subfeature($(feature),$(value-string),$(subvalue)) 
            subfeature($(feature),$(subvalue)) ;
        module local $(v[1]) = $(subfeature) ;
    }
}

# Can be called three ways:
#
#    1. extend feature : values *
#    2. extend <feature> subfeature : values * 
#    3. extend <feature>value-string subfeature : values * 
#
# * Form 1 adds the given values to the given feature
# * Forms 2 and 3 add subfeature values to the given feature
# * Form 3 adds the subfeature values as specific to the given
#   property value-string.
#
rule extend ( feature-or-property subfeature ? : values * )
{
    local
      feature           # If a property was specified this is its feature
      value-string      # E.G., the gcc-2.95-2 part of <toolset>gcc-2.95.2
      ;

    # if a property was specified    
    if $(feature-or-property:G) && $(feature-or-property:G=)
    {
        # Extract the feature and value-string, if any.
        feature = $(feature-or-property:G) ;
        value-string = $(feature-or-property:G=) ;
    }
    else
    {
        feature = [ grist $(feature-or-property) ] ;
    }
    
    # Dispatch to the appropriate handler
    if $(subfeature)
    {
        extend-subfeature $(feature) $(value-string)
          : $(subfeature) : $(values) ;
    }
    else
    {
        # If no subfeature was specified, we didn't expect to see a
        # value-string
        if $(value-string)
        {
            error can only be specify a property as the first argument
              when extending a subfeature
              : usage:
              : "    extend" feature ":" values...
              : "  | extend" <feature>value-string subfeature ":" values...
              ;
        }
        
        extend-feature $(feature) : $(values) ;
    }
}

# subfeature
#
# subfeature toolset gcc-2.95.2 target-platform : aix linux mac cygwin
#
rule subfeature ( feature value-string ? : subfeature : subvalues * )
{
    feature = [ grist $(feature) ] ;
    validate-feature $(feature) ;
    if $(subfeature) in $($(feature).subfeatures)
    {
        error \"$(subfeature)\" already declared as a subfeature of \"$(feature)\" ;
    }
    $(feature).subfeatures += $(subfeature) ;
    extend-subfeature $(feature) $(value-string) : $(subfeature) : $(subvalues) ;
}

# Set the components of the given composite property
rule compose ( composite-property : component-properties * )
{
    local feature = $(composite-property:G) ;
    if ! ( composite in [ attributes $(feature) ] )
    {
        error "$(feature)" is not a composite feature ;
    }
    
    module local $(composite-property).components ;
    if $($(composite-property).components) 
    {
        error components of "$(composite-property)" already set:
                $($(composite-property).components) ;
    }
    
    $(composite-property).components = $(component-properties) ;
}

local rule has-attribute ( attribute property )
{
    if $(attribute) in [ attributes [ get-feature $(property) ] ]
    {
        return true ;
    }
}

local rule expand-composite ( property )
{
    return $(property)
      [ sequence.transform expand-composite : $($(property).components) ] ;
}

# return all values of the given feature specified by the given property set.
rule get-values ( feature : properties * )
{
    local result ;
    feature = [ grist $(feature) ] ;
    for local p in $(properties)
    {
        if $(p:G) = $(feature)
        {
            result += $(p:G=) ;
        }
    }
    return $(result) ;
}

rule free-features ( )
{
    return $(free.features) ;
}

rule expand-composites ( properties * )
{
    local explicit-features = $(properties:G) ;
    
    local result ;
    # now expand composite features
    for local p in $(properties)
    {
        for local x in [ expand-composite $(p) ]
        {
            if ! $(x) in $(result)
            {
                if $(x:G) in $(free.features)
                {
                    result += $(x) ;
                }
                else if $(x:G) in $(result:G)
                {
                    error explicitly-specified values of non-free feature
                      $(x:G) conflict : 
                        values: [ get-values $(x:G) : $(properties) ] ;
                }
                else if
                  # if it's not the result of composite expansion
                  $(x) in $(properties) 
                    # or it is, but it doesn't match any explicitly-specified feature
                    || ( ! $(x:G) in $(explicit-features) )
                {
                    result += $(x) ;
                }
            }
        }
    }
    return $(result) ;
}

# Given a property set which may consist of composite and implicit
# properties and combined subfeature values, returns an expanded,
# normalized property set with all implicit features expressed
# explicitly, all subfeature values individually expressed, and all
# components of composite properties expanded. Non-free features
# directly expressed in the input properties cause any values of
# those features due to composite feature expansion to be dropped. If
# two values of a given non-free feature are directly expressed in the
# input, an error is issued.
rule expand ( properties * )
{
    local expanded = [ expand-subfeatures $(properties) ] ;
    
    return [ expand-composites $(expanded) ] ;
}

# Given a property-set of the form
#       v1/v2/...vN-1/<fN>vN/<fN+1>vN+1/...<fM>vM
#
# Returns
#       v1 v2 ... vN-1 <fN>vN <fN+1>vN+1 ... <fM>vM
#
# Note that vN...vM may contain slashes. This is resilient to the
# substitution of backslashes for slashes, since Jam, unbidden,
# sometimes swaps slash direction on NT.
rule split ( property-set )
{
    local pieces = [ regex.split $(property-set) [\\/] ] ;
    local result ;
    
    for local x in $(pieces)
    {
        if ( ! $(x:G) ) && $(result[-1]:G)
        {
            result = $(result[1--2]) $(result[-1])/$(x) ;
        }
        else
        {
            result += $(x) ;
        }
    }
    
    return $(result) ;
}

}
class feature-space ;

# Tricky: makes this module into an instance of feature-space so that
# normally users work with the global feature-space without having to
# be aware that it's a class instance.
instance feature : feature-space ;

# tests of module feature
local rule __test__ ( )
{
    local test-space = [ new feature-space ] ;
    
    module $(test-space)
    {
        import errors : try catch ;
        import assert ;
    
        feature toolset : gcc : implicit ;
        feature define : : free ;
        feature runtime-link : dynamic static : symmetric ;
        feature optimization : on off ;
        feature variant : debug release : implicit composite ;
        
        compose <variant>debug : <define>_DEBUG <optimization>off ;
        compose <variant>release : <define>NDEBUG <optimization>on ;
        
        extend-feature toolset : msvc metrowerks ;
        subfeature toolset gcc : version : 2.95.2 2.95.3 2.95.4
          3.0 3.0.1 3.0.2 ;
        
        assert.result <toolset>gcc <toolset-version>3.0.1
          : expand-subfeatures <toolset>gcc-3.0.1 ;
        
        assert.result <toolset>gcc <toolset-version>3.0.1
          : expand-subfeatures gcc-3.0.1 ;
        
        feature dummy : dummy1 dummy2 ;
        subfeature dummy : subdummy : x y z ;
        
        assert.result a c e
          : get-values x : <x>a <y>b <x>c <y>d <x>e ;
        
        assert.result <toolset>gcc <toolset-version>3.0.1
          <variant>debug <define>_DEBUG <optimization>on
          : expand gcc-3.0.1 debug <optimization>on
          ;
        
        assert.result <variant>debug <define>_DEBUG <optimization>on
          : expand debug <optimization>on
          ;
        
        assert.result <x>y/z <a>b/c <d>e/f
          : split <x>y/z/<a>b/c/<d>e/f
          ;
        
        assert.result <x>y/z <a>b/c <d>e/f
          : split <x>y\\z\\<a>b\\c\\<d>e\\f
          ;
        
        assert.result a b c <d>e/f/g <h>i/j/k
          : split a/b/c/<d>e/f/g/<h>i/j/k
          ;
        
        assert.result a b c <d>e/f/g <h>i/j/k
          : split a\\b\\c\\<d>e\\f\\g\\<h>i\\j\\k
          ;
        
        # test error checking
        
        try ;
        {
            expand release <optimization>off <optimization>on ;
        }
        catch explicitly-specified values of non-free feature <optimization> conflict ;
        
        try ;
        {
            validate-feature foobar ;
        }
        catch unknown feature ;
        
        try ;
        {
            feature foobar : : baz ;
        }
        catch unknown attributes: baz ;
        
        feature feature1 ;
        try ;
        {
            feature feature1 ;
        }
        catch feature already defined: ;
        
        try ;
        {
            feature feature2 : : free implicit ;
        }
        catch free features cannot also be implicit ;
        
        try ;
        {
            implied-feature lackluster ;
        }
        catch \"lackluster\" is not a value of an implicit feature ;
        
        try ;
        {
            implied-subfeature toolset 3.0.1 ;
        }
        catch \"3.0.1\" is not a known subfeature value of
          feature <toolset> ;

        try ;
        {
            implied-subfeature toolset not-a-version : gcc ;
        }
        catch \"not-a-version\" is not a known subfeature value of
          feature <toolset> ;
    }
}