From 4a07bce1dde577422bfb24772c31c65802e8aabc Mon Sep 17 00:00:00 2001 From: Dave Abrahams Date: Mon, 17 Feb 2003 17:50:34 +0000 Subject: [PATCH] fix bogus removal [SVN r17492] --- new/feature.jam | 989 +++++++++++++++++++++++++++++++++++++++++++ v2/build/feature.jam | 989 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 1978 insertions(+) create mode 100644 new/feature.jam create mode 100644 v2/build/feature.jam diff --git a/new/feature.jam b/new/feature.jam new file mode 100644 index 000000000..f2864e7b5 --- /dev/null +++ b/new/feature.jam @@ -0,0 +1,989 @@ +# (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. + +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 + executed + composite + optional + symmetric + free + incidental + path + dependency + propagated + link-incompatible + ; + +.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) && free in $(attributes) + { + error = free features cannot also be implicit ; + } + else if free in $(attributes) && propagated in $(attributes) + { + error = free features cannot be propagated ; + } + + + 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-string' is a value-string of an implicit feature +rule is-implicit-value ( value-string ) +{ + local v = [ regex.split $(value-string) - ] ; + local failed ; + if ! $(v[1]) in $(.all-implicit-values) + { + failed = true ; + } + else + { + local feature = $($(v[1]).implicit-feature) ; + + for local subvalue in $(v[2-]) + { + if ! [ find-implied-subfeature $(feature) $(subvalue) : $(v[1]) ] + { + failed = true ; + } + } + } + + if ! $(failed) + { + return true ; + } +} + +# return the implicit feature associated with the given implicit value. +rule implied-feature ( implicit-value ) +{ + local components = [ regex.split $(implicit-value) "-" ] ; + + local feature = $($(components[1]).implicit-feature) ; + if ! $(feature) + { + error \"$(implicit-value)\" is not a value of an implicit feature ; + feature = "" ; # keep testing happy; it expects a result. + } + return $(feature) ; +} + +local rule find-implied-subfeature ( feature subvalue : value-string ? ) +{ + # feature should be of the form + 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 gcc-2.95.2-linux-x86 +# -> gcc 2.95.2 linux 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) ] ; + } + + if ! $(feature) + { + feature = [ implied-feature $(value) ] ; + } + else + { + validate-feature $(feature) ; + } + validate-value-string $(feature) $(value) ; + + local components = [ regex.split $(value) "-" ] ; + + # get the top-level feature's value + local value = $(components[1]:G=) ; + + local result = $(components[1]:G=$(feature)) ; + + local subvalues = $(components[2-]) ; + while $(subvalues) + { + local subvalue = $(subvalues[1]) ; # pop the head off of subvalues + subvalues = $(subvalues[2-]) ; + + local subfeature = [ find-implied-subfeature $(feature) $(subvalue) : $(value) ] ; + + # If no subfeature was found, reconstitute the value string and use that + if ! $(subfeature) + { + result = $(components:J=-) ; + result = $(result:G=$(feature)) ; + subvalues = ; # stop looping + } + else + { + 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 +# +# gcc 2.95.2 linux x86 +# +rule expand-subfeatures ( + properties * # property set with elements of the form + # 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 $($(feature).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. +rule validate-value-string ( feature value-string ) +{ + feature = [ grist $(feature) ] ; + + if ! ( + free in $($(feature).attributes) + || ( $(value-string) in $(feature).values ) + ) + { + local values = $(value-string) ; + + if $($(feature).subfeatures) + { + values = [ regex.split $(value-string) - ] ; + } + + if ! ( $(values[1]) in $($(feature).values) ) + { + error \"$(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 only valid for the given +# value of the feature. Thus, you could say that +# mingw is specifc to gcc-2.95.2 as follows: +# +# extend-subfeature toolset gcc-2.95.2 : target-platform : mingw ; +# +rule extend-subfeature ( + feature # The feature whose subfeature is being extended + + value-string ? # If supplied, specifies a specific value of the + # main feature for which the new subfeature values + # are valid + + : subfeature # The name of the subfeature + : subvalues * # The additional values of the subfeature being defined. +) +{ + 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 subfeature : values * +# 3. extend 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 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" value-string subfeature ":" values... + ; + } + + extend-feature $(feature) : $(values) ; + } +} + +# Declares a subfeature +rule subfeature ( + feature # Root feature that is not a subfeature + value-string ? # A value-string specifying which feature or + # subfeature values this subfeature is specific to, + # if any + + : subfeature # The name of the subfeature being declared + : subvalues * # The allowed values of this subfeature + : attributes * # The attributes of the subfeature +) +{ + 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) + { + local expanded = [ expand-composite $(p) ] ; + + for local x in $(expanded) + { + if ! $(x) in $(result) + { + local f = $(x:G) ; + + if $(f) in $(free.features) + { + result += $(x) ; + } + else if ! $(x) in $(properties) # x is the result of expansion + { + if ! $(f) in $(explicit-features) # not explicitly-specified + { + if $(f) in $(result:G) + { + error expansions of composite features result in conflicting + values for $(f) + : values: [ get-values $(f) : $(result) ] $(x:G=) + : one contributing composite property was $(p) ; + } + else + { + result += $(x) ; + } + } + } + else if $(f) in $(result:G) + { + error explicitly-specified values of non-free feature + $(f) conflict : + values: [ get-values $(f) : $(properties) ] $(x:G=) ; + } + else + { + 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. Non-symmetric properties equal to default values will be +# eliminated, unless the override a value from some composite property. +# 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) ; + local components ; + 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 ; + } + components += $($(p).components:G) ; + 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="") ; + } + + # eliminate properties which value is equal to feature's default + # and which are not symmetric + if $(p) = [ defaults $(f) ] && ! symmetric in [ attributes $(f) ] + # If the feature is not specified in any of composite ones, + # then removing it is OK, because adding defaults would bring that + # feature back --- there's 1-1 correspondence between minimized + # and full property set. + && ! $(f:G) in $(components) + { + x = $(x[2-]) ; + } + else + { + # 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/vN/vN+1/...vM +# +# Returns +# v1 v2 ... vN-1 vN vN+1 ... 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) ; +} + +# Appends a rule to the list of rules assigned to the given feature or property. +# That rules will be used in extending property sets by the 'run-actions' rule. +# The rule should accept two arguments: +# - the property which is registered +# - the list of all properties +# and return a set of additional +# properties to be added. Property should be specified in the usual way: +# value, and feature should be specified as . +rule action ( property-or-feature : rule-name ) +{ + # Is the name in global scope + if ! $(rule-name) in [ RULENAMES ] + { + # No, should be in caller's scope + local caller = [ CALLER_MODULE ] ; + if ! $(rule-name) in [ RULENAMES $(caller) ] + { + error "invalid rule name" ; + } + rule-name = $(caller).$(rule-name) ; + } + + .rules.$(property-or-feature) += $(rule-name) ; +} + +# Returns 'properties' augmented with results of calling rule associated with properties. +# If both a property and its feature have rules, only rules for the property are executed. +rule run-actions ( properties * ) +{ + local added = ; + for local e in $(properties) + { + local rules ; + if $(.rules.$(e)) + { + rules = $(.rules.$(e)) ; + } + else if $(.rules.$(e:G)) + { + rules = $(.rules.$(e:G)) ; + } + for local r in $(rules) + { + added += [ $(r) $(e) : $(properties) ] ; + } + } + return $(properties) $(added) ; +} + +} +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 ; + feature stdlib : native stlport ; + feature magic : : free ; + + compose debug : _DEBUG off ; + compose release : NDEBUG 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 ; + + rule handle-stlport ( property : properties * ) + { + return /path/to/stlport ; + } + + rule handle-magic ( property : properties * ) + { + return MAGIC=$(property:G=) ; + } + + rule handle-magic2 ( property : properties * ) + { + return MAGIC=BIG_MAGIC ; + } + + rule handle-magic3 ( property : properties * ) + { + return MAGIC=VERY_BIG_MAGIC ; + } + + + + action stlport : handle-stlport ; + action : handle-magic ; + action 17 : handle-magic2 ; + action 17 : handle-magic3 ; + + assert.result gcc 3.0.1 + : expand-subfeatures gcc-3.0.1 ; + + assert.result foo=x-y + : expand-subfeatures foo=x-y ; + + assert.result gcc 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 : a b c d e ; + + assert.result gcc 3.0.1 + debug _DEBUG on + : expand gcc-3.0.1 debug on + ; + + assert.result debug _DEBUG on + : expand debug on + ; + + assert.result on debug _DEBUG + : expand on debug + ; + + assert.result dynamic on + : defaults + ; + + assert.result static foobar on gcc debug + native dummy1 + : add-defaults static foobar on + ; + + assert.result gcc foo stlport 3 /path/to/stlport MAGIC=3 + : run-actions gcc foo stlport 3 + ; + + assert.result 17 MAGIC=BIG_MAGIC MAGIC=VERY_BIG_MAGIC + : run-actions 17 + ; + + + assert.result gcc-3.0.1 debug on + : minimize [ expand gcc-3.0.1 debug on native ] + ; + + assert.result gcc-3.0.1 debug dynamic + : minimize [ expand gcc-3.0.1 debug off dynamic ] + ; + + assert.result gcc-3.0.1 debug + : minimize [ expand gcc-3.0.1 debug off ] + ; + + assert.result debug on + : minimize [ expand debug on ] + ; + + assert.result y/z b/c e/f + : split y/z/b/c/e/f + ; + + assert.result y/z b/c e/f + : split y\\z\\b\\c\\e\\f + ; + + assert.result a b c e/f/g i/j/k + : split a/b/c/e/f/g/i/j/k + ; + + assert.result a b c e/f/g i/j/k + : split a\\b\\c\\e\\f\\g\\i\\j\\k + ; + + # test error checking + + try ; + { + expand release off on ; + } + catch explicitly-specified values of non-free feature conflict ; + + try ; + { + validate-feature foobar ; + } + catch unknown feature ; + + validate-value-string gcc ; + validate-value-string gcc-3.0.1 ; + + try ; + { + validate-value-string digital_mars ; + } + catch \"digital_mars\" is not a known value of ; + + 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 ; + { + feature feature3 : : free propagated ; + } + catch free features cannot be propagated ; + + 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 ; + + try ; + { + implied-subfeature toolset not-a-version : gcc ; + } + catch \"not-a-version\" is not a known subfeature value of + feature ; + } +} diff --git a/v2/build/feature.jam b/v2/build/feature.jam new file mode 100644 index 000000000..f2864e7b5 --- /dev/null +++ b/v2/build/feature.jam @@ -0,0 +1,989 @@ +# (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. + +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 + executed + composite + optional + symmetric + free + incidental + path + dependency + propagated + link-incompatible + ; + +.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) && free in $(attributes) + { + error = free features cannot also be implicit ; + } + else if free in $(attributes) && propagated in $(attributes) + { + error = free features cannot be propagated ; + } + + + 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-string' is a value-string of an implicit feature +rule is-implicit-value ( value-string ) +{ + local v = [ regex.split $(value-string) - ] ; + local failed ; + if ! $(v[1]) in $(.all-implicit-values) + { + failed = true ; + } + else + { + local feature = $($(v[1]).implicit-feature) ; + + for local subvalue in $(v[2-]) + { + if ! [ find-implied-subfeature $(feature) $(subvalue) : $(v[1]) ] + { + failed = true ; + } + } + } + + if ! $(failed) + { + return true ; + } +} + +# return the implicit feature associated with the given implicit value. +rule implied-feature ( implicit-value ) +{ + local components = [ regex.split $(implicit-value) "-" ] ; + + local feature = $($(components[1]).implicit-feature) ; + if ! $(feature) + { + error \"$(implicit-value)\" is not a value of an implicit feature ; + feature = "" ; # keep testing happy; it expects a result. + } + return $(feature) ; +} + +local rule find-implied-subfeature ( feature subvalue : value-string ? ) +{ + # feature should be of the form + 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 gcc-2.95.2-linux-x86 +# -> gcc 2.95.2 linux 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) ] ; + } + + if ! $(feature) + { + feature = [ implied-feature $(value) ] ; + } + else + { + validate-feature $(feature) ; + } + validate-value-string $(feature) $(value) ; + + local components = [ regex.split $(value) "-" ] ; + + # get the top-level feature's value + local value = $(components[1]:G=) ; + + local result = $(components[1]:G=$(feature)) ; + + local subvalues = $(components[2-]) ; + while $(subvalues) + { + local subvalue = $(subvalues[1]) ; # pop the head off of subvalues + subvalues = $(subvalues[2-]) ; + + local subfeature = [ find-implied-subfeature $(feature) $(subvalue) : $(value) ] ; + + # If no subfeature was found, reconstitute the value string and use that + if ! $(subfeature) + { + result = $(components:J=-) ; + result = $(result:G=$(feature)) ; + subvalues = ; # stop looping + } + else + { + 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 +# +# gcc 2.95.2 linux x86 +# +rule expand-subfeatures ( + properties * # property set with elements of the form + # 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 $($(feature).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. +rule validate-value-string ( feature value-string ) +{ + feature = [ grist $(feature) ] ; + + if ! ( + free in $($(feature).attributes) + || ( $(value-string) in $(feature).values ) + ) + { + local values = $(value-string) ; + + if $($(feature).subfeatures) + { + values = [ regex.split $(value-string) - ] ; + } + + if ! ( $(values[1]) in $($(feature).values) ) + { + error \"$(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 only valid for the given +# value of the feature. Thus, you could say that +# mingw is specifc to gcc-2.95.2 as follows: +# +# extend-subfeature toolset gcc-2.95.2 : target-platform : mingw ; +# +rule extend-subfeature ( + feature # The feature whose subfeature is being extended + + value-string ? # If supplied, specifies a specific value of the + # main feature for which the new subfeature values + # are valid + + : subfeature # The name of the subfeature + : subvalues * # The additional values of the subfeature being defined. +) +{ + 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 subfeature : values * +# 3. extend 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 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" value-string subfeature ":" values... + ; + } + + extend-feature $(feature) : $(values) ; + } +} + +# Declares a subfeature +rule subfeature ( + feature # Root feature that is not a subfeature + value-string ? # A value-string specifying which feature or + # subfeature values this subfeature is specific to, + # if any + + : subfeature # The name of the subfeature being declared + : subvalues * # The allowed values of this subfeature + : attributes * # The attributes of the subfeature +) +{ + 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) + { + local expanded = [ expand-composite $(p) ] ; + + for local x in $(expanded) + { + if ! $(x) in $(result) + { + local f = $(x:G) ; + + if $(f) in $(free.features) + { + result += $(x) ; + } + else if ! $(x) in $(properties) # x is the result of expansion + { + if ! $(f) in $(explicit-features) # not explicitly-specified + { + if $(f) in $(result:G) + { + error expansions of composite features result in conflicting + values for $(f) + : values: [ get-values $(f) : $(result) ] $(x:G=) + : one contributing composite property was $(p) ; + } + else + { + result += $(x) ; + } + } + } + else if $(f) in $(result:G) + { + error explicitly-specified values of non-free feature + $(f) conflict : + values: [ get-values $(f) : $(properties) ] $(x:G=) ; + } + else + { + 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. Non-symmetric properties equal to default values will be +# eliminated, unless the override a value from some composite property. +# 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) ; + local components ; + 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 ; + } + components += $($(p).components:G) ; + 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="") ; + } + + # eliminate properties which value is equal to feature's default + # and which are not symmetric + if $(p) = [ defaults $(f) ] && ! symmetric in [ attributes $(f) ] + # If the feature is not specified in any of composite ones, + # then removing it is OK, because adding defaults would bring that + # feature back --- there's 1-1 correspondence between minimized + # and full property set. + && ! $(f:G) in $(components) + { + x = $(x[2-]) ; + } + else + { + # 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/vN/vN+1/...vM +# +# Returns +# v1 v2 ... vN-1 vN vN+1 ... 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) ; +} + +# Appends a rule to the list of rules assigned to the given feature or property. +# That rules will be used in extending property sets by the 'run-actions' rule. +# The rule should accept two arguments: +# - the property which is registered +# - the list of all properties +# and return a set of additional +# properties to be added. Property should be specified in the usual way: +# value, and feature should be specified as . +rule action ( property-or-feature : rule-name ) +{ + # Is the name in global scope + if ! $(rule-name) in [ RULENAMES ] + { + # No, should be in caller's scope + local caller = [ CALLER_MODULE ] ; + if ! $(rule-name) in [ RULENAMES $(caller) ] + { + error "invalid rule name" ; + } + rule-name = $(caller).$(rule-name) ; + } + + .rules.$(property-or-feature) += $(rule-name) ; +} + +# Returns 'properties' augmented with results of calling rule associated with properties. +# If both a property and its feature have rules, only rules for the property are executed. +rule run-actions ( properties * ) +{ + local added = ; + for local e in $(properties) + { + local rules ; + if $(.rules.$(e)) + { + rules = $(.rules.$(e)) ; + } + else if $(.rules.$(e:G)) + { + rules = $(.rules.$(e:G)) ; + } + for local r in $(rules) + { + added += [ $(r) $(e) : $(properties) ] ; + } + } + return $(properties) $(added) ; +} + +} +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 ; + feature stdlib : native stlport ; + feature magic : : free ; + + compose debug : _DEBUG off ; + compose release : NDEBUG 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 ; + + rule handle-stlport ( property : properties * ) + { + return /path/to/stlport ; + } + + rule handle-magic ( property : properties * ) + { + return MAGIC=$(property:G=) ; + } + + rule handle-magic2 ( property : properties * ) + { + return MAGIC=BIG_MAGIC ; + } + + rule handle-magic3 ( property : properties * ) + { + return MAGIC=VERY_BIG_MAGIC ; + } + + + + action stlport : handle-stlport ; + action : handle-magic ; + action 17 : handle-magic2 ; + action 17 : handle-magic3 ; + + assert.result gcc 3.0.1 + : expand-subfeatures gcc-3.0.1 ; + + assert.result foo=x-y + : expand-subfeatures foo=x-y ; + + assert.result gcc 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 : a b c d e ; + + assert.result gcc 3.0.1 + debug _DEBUG on + : expand gcc-3.0.1 debug on + ; + + assert.result debug _DEBUG on + : expand debug on + ; + + assert.result on debug _DEBUG + : expand on debug + ; + + assert.result dynamic on + : defaults + ; + + assert.result static foobar on gcc debug + native dummy1 + : add-defaults static foobar on + ; + + assert.result gcc foo stlport 3 /path/to/stlport MAGIC=3 + : run-actions gcc foo stlport 3 + ; + + assert.result 17 MAGIC=BIG_MAGIC MAGIC=VERY_BIG_MAGIC + : run-actions 17 + ; + + + assert.result gcc-3.0.1 debug on + : minimize [ expand gcc-3.0.1 debug on native ] + ; + + assert.result gcc-3.0.1 debug dynamic + : minimize [ expand gcc-3.0.1 debug off dynamic ] + ; + + assert.result gcc-3.0.1 debug + : minimize [ expand gcc-3.0.1 debug off ] + ; + + assert.result debug on + : minimize [ expand debug on ] + ; + + assert.result y/z b/c e/f + : split y/z/b/c/e/f + ; + + assert.result y/z b/c e/f + : split y\\z\\b\\c\\e\\f + ; + + assert.result a b c e/f/g i/j/k + : split a/b/c/e/f/g/i/j/k + ; + + assert.result a b c e/f/g i/j/k + : split a\\b\\c\\e\\f\\g\\i\\j\\k + ; + + # test error checking + + try ; + { + expand release off on ; + } + catch explicitly-specified values of non-free feature conflict ; + + try ; + { + validate-feature foobar ; + } + catch unknown feature ; + + validate-value-string gcc ; + validate-value-string gcc-3.0.1 ; + + try ; + { + validate-value-string digital_mars ; + } + catch \"digital_mars\" is not a known value of ; + + 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 ; + { + feature feature3 : : free propagated ; + } + catch free features cannot be propagated ; + + 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 ; + + try ; + { + implied-subfeature toolset not-a-version : gcc ; + } + catch \"not-a-version\" is not a known subfeature value of + feature ; + } +}