#  (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 sequence ;
import regex ;
import set ;
import utility ;

.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.


    link-incompatible # targets with different values of this feature
                      # cannot be linked together under any circumstances.

  ;

.all-features = ;
.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)) ;
}

empty = "" ;

# declare a new feature with the given name, values, and attributes.
rule feature ( 
    name         # feature name
  : values *     # the allowable values - may be extended later with feature.extend
  : attributes * # The feature's attributes (e.g. implicit, free, propagated...)
)
{
    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) ] ;
    }

    $(name).values ?= ;
    $(name).attributes = $(attributes) ;
    $(name).subfeatures ?= ;
    $(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) ]
    {
        local a = $($(f).attributes) ;
        if ( free in $(a) ) || ( optional in $(a) )
        {
        }
        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) ;
}

# returns true iff 'value' is a value of an implicit feature
rule is-implicit-value ( value )
{
    if $(value) in $(.all-implicit-values) 
    {
        return true ;
    }
}

# 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 ? )
{
    # feature should be of the form <feature-name>
    if $(feature) != $(feature:G)
    {
        error invalid feature $(feature) ;
    }

    value-string ?= "" ;

    return $($(feature)$(value-string)<>$(subvalue).subfeature) ;
}

# Given a feature and a value of one of its subfeatures, find the name
# of the subfeature. If value-string is supplied, looks for implied
# subfeatures that are specific to that value of feature
rule implied-subfeature ( 
  feature               # The main feature name
    subvalue            # The value of one of its subfeatures
    : value-string ?    # The value of the main feature
)
{
    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)\" ;
    }
}

# Given a feature and value, or just a value corresponding to an
# implicit feature, returns a property set consisting of all component
# subfeatures and their values. For example:
#
#   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 ? # The name of the feature, or empty if value corresponds to an implicit property
  : value     # The value of the feature.
)
{
    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 = [ MATCH ^<(.*)>$ : $(feature) ] ;
        result += $(subvalue:G=$(f)-$(subfeature)) ;
    }

    return $(result) ;
}

# Make all elements of properties corresponding to implicit features
# explicit, and express all subfeature values as separate properties
# in their own right. For example, the property
#
#    gcc-2.95.2-linux-x86
#
# might expand to
#
#   <toolset>gcc <toolset-version>2.95.2 <toolset-os>linux <toolset-cpu>x86
#
rule expand-subfeatures ( 
  properties * # property set with elements of the form
	       # <feature>value-string or just value-string in the
	       # case of implicit features.
)
{
    local result ;
    for local p in $(properties)
    {
        result += [ expand-subfeatures-aux $(p:G) : $(p:G=) ] ;
    }
    return $(result) ;
}

# Helper for extend, below. Handles the feature case.
local rule extend-feature ( feature : values * )
{
    validate-feature $(feature) ;
    if implicit in $(attributes)
    {
        for local v in $(values)
        {
            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 valid 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) ;
    }

    # provide a way to get from the given feature or property and
    # subfeature value to the subfeature name.
    value-string ?= "" ;
    for local subvalue in $(subvalues)
    {
        $(feature)$(value-string)<>$(subvalue).subfeature = $(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 * : attributes * )
{
    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) ;
    local f = [ utility.ungrist $(feature) ] ;
    feature $(f)-$(subfeature) : $(subvalues) : $(attributes) ;
}

# 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 ;
    }

    $(composite-property).components ?= ;
    if $($(composite-property).components)
    {
        error components of "$(composite-property)" already set:
                $($(composite-property).components) ;
    }

    if $(composite-property) in $(components)
    {
        errror composite property "$(composite-property)" cannot have itself as a component ;
    }
    $(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) ;
}

# Expand all composite properties in the set so that all components
# are explicitly expressed.
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) ] ;
}


# Helper rule for minimize, below - return true iff property's feature
# is present in the contents of the variable named by feature-set-var.
local rule in-features ( feature-set-var property )
{
    if $(property:G) in $($(feature-set-var))
    {
        return true ;
    }
}

# Given an expanded property set, eliminate all redundancy: properties
# which are elements of other (composite) properties in the set will
# be eliminated, implicit properties will be expressed without feature
# grist, and sub-property values will be expressed as elements joined
# to the corresponding main property.
rule minimize ( properties * )
{
    # remove properties implied by composite features
    local x = $(properties) ;
    for local p in $(properties)
    {
        if ! $(p:G)
        {
            error minimize requires an expanded property set, but \"$(p)\"
              appears to be the value of an un-expanded implicit feature ;
        }
        x = [ set.difference $(x) : $($(p).components) ] ;
    }
    
    # handle subfeatures and implicit features
    local result ;
    while $(x)
    {
        local p = $(x[1]) ;
        local f = $(p:G) ;
        
        # eliminate features in implicit properties.
        if implicit in [ attributes $(f) ]
        {
            p = $(p:G="") ;
        }
        
        # locate all subproperties of f in the property set
        local subproperties ;
        local subfeatures = $($(f).subfeatures) ;
        if $(subfeatures)
        {
            local f_ = [ utility.ungrist $(f) ] ;
            subfeatures = [ grist $(f_)-$(subfeatures) ] ;
            subproperties = [ sequence.filter in-features subfeatures : $(x) ] ;
        }
        
        if $(subproperties)
        {
            # reconstitute the joined property name
            local sorted = [ sequence.insertion-sort $(subproperties) ] ;
            result += $(p)-$(sorted:G="":J=-) ;
              
            x = [ set.difference $(x[2-]) : $(subproperties) ] ;
        }
        else
        {
            result += $(p) ;
            x = $(x[2-]) ;
        }
    }
    return $(result) ;
}

# Given a set of properties, add default values for features not
# represented in the set.
rule add-defaults ( properties * )
{
    for local v in $(properties:G=)
    {
        if $(v) in $(properties)
        {
            error add-defaults requires explicitly specified features,
                but \"$(v)\" appears to be the value of an un-expanded implicit feature ;
        }
    }
    local missing = [ set.difference $(.all-features) : $(properties:G) ] ;
    return $(properties) [ defaults $(missing) ] ;
}

# 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 : optional ;

        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 : optional ;

        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 <runtime-link>dynamic <optimization>on
          : defaults <runtime-link> <define> <optimization>
          ;

        assert.result <runtime-link>static <define>foobar <optimization>on <toolset>gcc <variant>debug <dummy>dummy1
          : add-defaults <runtime-link>static <define>foobar <optimization>on
          ;

        assert.result gcc-3.0.1 debug <optimization>on
          : minimize [ expand gcc-3.0.1 debug <optimization>on ]
          ;
        
        assert.result gcc-3.0.1 debug
          : minimize [ expand gcc-3.0.1 debug <optimization>off ]
          ;
        
        assert.result debug <optimization>on
          : minimize [ 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> ;
    }
}