Ticket #33: type.jam

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

#  Deals with target type declaration and defines target class which supports
#  typed targets.

import feature ;
import generators : * ;
import "class" : new ;
import errors ;
import property ;
import scanner ;
import project ;

# This creates a circular dependency
# project-test1 -> project -> project-root -> builtin -> type -> targets -> project
# import targets ; 

# The feature is optional so that it never implicitly added.
# It's used only for internal purposes, and in all cases we
# want to explicitly use it.
feature.feature target-type : : composite optional ;

# feature.feature base-target-type : : composite optional ;
feature.feature main-target-type : : optional incidental ;
feature.feature base-target-type : : composite optional free ;
# feature.feature main-target-type : : composite optional incidental ;

# Store suffixes for generated targets
.suffixes = [ new property-map ] ;

# Registers a target type, possible derived from a 'base-type'. 
# If 'suffixes' are provided, they given all the suffixes that mean a file is of 'type'.
# Also, the first element gives the suffix to be used when constructing and object of
# 'type'.
rule register ( type : suffixes * : base-type ? )
{
    # Type names cannot contain hyphens, because when used as
    # feature-values they will be interpreted as composite features
    # which need to be decomposed.
    switch $(type)
    {
        case *-* : errors.error "type name \"$(type)\" contains a hyphen" ;
    }
    
    if $(type) in $(.types)
    {
        errors.error "Type $(type) is already registered." ;
    }
    else
    {
        .types += $(type) ;
        .bases.$(type) = $(base-type) ;
        .derived.$(base-type) += $(type) ;        

        if $(suffixes)-not-empty
        {            
            # Generated targets of 'type' will use the first of 'suffixes'
            # (this may be overriden)            
            $(.suffixes).insert <target-type>$(type) : $(suffixes[1]) ;
            # Specify mapping from suffixes to type
            register-suffixes $(suffixes) : $(type) ;
        }
        
        feature.extend target-type : $(type) ;
        feature.extend main-target-type : $(type) ;
        
        feature.compose <target-type>$(type) : $(base-type:G=<base-target-type>) ; 
        feature.extend base-target-type : $(type) ;
#        feature.compose <target-type>$(type) : <base-target-type>$(type) ;
        feature.compose <base-target-type>$(type) : <base-target-type>$(base-type) ;

        # We used to declare main target rule only when 'main' parameter
        # is specified. However, it's hard to decide that a type *never*
        # will need a main target rule and so from time to time we needed
        # to make yet another type 'main'. So, now main target rule is defined
        # for each type.
        main-rule-name = [ type-to-rule-name $(type) ] ;            
        .main-target-type.$(main-rule-name) = $(type) ;    
            
        IMPORT $(__name__) : main-target-rule : : $(main-rule-name) ;
    }
}

# Given type, returns name of main target rule which creates
# targets of that type.
rule type-to-rule-name ( type )
{
    # Lowercase everything. Convert underscores to dashes.ame.
    import regex ;
    local n = [ regex.split $(type:L) "_" ] ;
    n = $(n:J=-) ;
    return $(n) ;
}

# Returns a type, given the name of a main rule.
rule type-from-rule-name ( main-target-name )
{
    return $(.main-target-type.$(main-target-name)) ;
}



# Specifies that targets with suffix from 'suffixes' has the type 'type'. 
# If different type is already specified for any of syffixes,
# issues an error.
rule register-suffixes ( suffixes + : type )
{
    for local s in $(suffixes)
    {        
        if ! $(.type.$(s)) 
        {
            .type.$(s) = $(type) ; 
        }
        else if $(.type.$(s)) != type 
        {
            errors.error Attempting to specify type for suffix \"$(s)\" 
              : "Old type $(.type.$(s)), New type $(type)" ;
        }
    }            
}


# Returns true iff type has been registered.
rule registered ( type )
{
    if $(type) in $(.types)
    {
        return true ;
    }
}

# Issues an error if 'type' is unknown.
rule validate ( type )
{
    if ! $(type) in $(.types)
    {
        errors.error "Unknown target type $(type)" ;
    }    
}


# Sets a scanner class that will be used for this 'type'.
rule set-scanner ( type : scanner )
{
    if ! $(type) in $(.types)
    {
        error "Type" $(type) "is not declared" ;
    }    
    .scanner.$(type) = $(scanner) ;
}

# Returns a scanner instance appropriate to 'type' and 'properties'.
rule get-scanner ( type : property-set )
{
    if $(.scanner.$(type)) {
        return [ scanner.get $(.scanner.$(type)) : $(property-set) ] ;
    }    
}

# returns  type and all of its bases in order of their distance from type.
rule all-bases ( type )
{
    local result = $(type) ;
    while $(type)
    {
        type = $(.bases.$(type)) ;
        result += $(type) ;
    }
    return $(result) ;
}

rule all-derived ( type )
{
    local result = $(type) ;
    for local d in $(.derived.$(type))
    {
        result += [ all-derived $(d) ] ;
    }
    return $(result) ;      
}


# Returns true if 'type' has 'base' as its direct or
# indirect base.
rule is-derived ( type base )
{
    if $(base) in [ all-bases $(type) ]
    {
        return true ;
    }
}

# Returns true if 'type' is either derived from 'base',
# or 'type' is equal to 'base'.
rule is-subtype ( type base )
{
    if $(type) = $(base)
    {
        return true ;
    }
    else
    {
        return [ is-derived $(type) $(base) ] ;
    }    
}


# Sets a target suffix that should be used when generating target 
# of 'type' with the specified properties. Can be called with
# empty properties if no suffix for 'type' was specified yet.
# This does not automatically specify that files 'suffix' have
# 'type' --- two different types can use the same suffix for
# generating, but only one type should be auto-detected for
# a file with that suffix. User should explicitly specify which
# one.
#
# The 'suffix' parameter can be empty string ("") to indicate that
# no suffix should be used.
rule set-generated-target-suffix ( type : properties * : suffix )
{
    set-generated-target-ps $(type) : $(properties) : suffix : $(suffix) ;
}    

# Change the suffix previously registered for this type/properties 
# combination. If suffix is not yet specified, sets it.
rule change-generated-target-suffix ( type : properties * : suffix )
{        
    change-generated-target-ps $(type) : $(properties) : suffix : $(suffix) ;
}


# Returns suffix that should be used when generating target of 'type',
# with the specified properties. If not suffix were specified for
# 'type', returns suffix for base type, if any.
rule generated-target-suffix-real ( type : properties * )
{
    return [ generated-target-ps-real $(type) : $(properties) : suffix ] ;
}

rule generated-target-suffix ( type : property-set )
{
    return [ generated-target-ps $(type) : $(property-set) : suffix ] ;
}


# Returns file type given it's name. If there are several dots in filename,
# tries each suffix. E.g. for name of "file.so.1.2" suffixes "2", "1", and 
# "so"  will be tried.
rule type ( filename ) 
{
    local type ;
    while ! $(type) && $(filename:S) 
    {
        local suffix = $(filename:S) ;
        type = $(.type$(suffix)) ;
        filename = $(filename:S=) ;
    }
    return $(type) ;
}



rule main-target-rule ( name : sources * : requirements * : default-build * 
                        : usage-requirements * )
{
    # First find required target type, which is equal to the name used
    # to invoke us.
    local bt = [ BACKTRACE 1 ] ;
    local rulename = $(bt[4]) ;
    
    # This rule may be only called from Jamfile, and therefore, 
    # CALLER_MODULE is Jamfile module, which is used to denote 
    # a project.
    local project = [ project.current ] ;
        
    # This is a circular module dependency, so it must be imported here
    import targets ;
    return [ targets.create-typed-target $(.main-target-type.$(rulename)) : $(project)
      : $(name) : $(sources) : $(requirements) 
      : $(default-build) : $(usage-requirements) ] ;        
}

# These prefix provisioning rules were derived from suffix provisioning
# rules almost by just changing "suffix" to "prefix" in the suffix rules.
# Then they were refactored by moving duplicate code into 
# rules that apply to prefix and suffix provisioning.

# Store prefixes for generated targets (e.g. "lib" for library)
.prefixes = [ new property-map ] ;

# Sets a target prefix that should be used when generating target 
# of 'type' with the specified properties. Can be called with
# empty properties if no prefix for 'type' was specified yet.
#
# The 'prefix' parameter can be empty string ("") to indicate that
# no prefix should be used.
#
# Example usage is for library names that have to have a "lib"
# prefix as in unix.
rule set-generated-target-prefix ( type : properties * : prefix )
{
    set-generated-target-ps $(type) : $(properties) : prefix : $(prefix) ;
}    

# Change the prefix previously registered for this type/properties 
# combination. If prefix is not yet specified, sets it.
rule change-generated-target-prefix ( type : properties * : prefix )
{        
    change-generated-target-ps $(type) : $(properties) : prefix : $(prefix) ;
}

# Returns prefix that should be used when generating target of 'type',
# with the specified properties. If no prefix is specified for
# 'type', returns prefix for base type, if any.
rule generated-target-prefix-real ( type : properties * )
{
    return [ generated-target-ps-real $(type) : $(properties) : prefix ] ;
}

rule generated-target-prefix ( type : property-set )
{
    return [ generated-target-ps $(type) : $(property-set) : prefix ] ;
}

# Common rules for prefix/suffix provisioning follow

rule set-generated-target-ps ( type : properties * : ps : psval )
{
    properties = <target-type>$(type) $(properties) ;
    $(.$(ps)es).insert $(properties) : $(psval) ;
}    

rule change-generated-target-ps ( type : properties * : ps : psval )
{        
    properties = <target-type>$(type) $(properties) ;    
    local prev = [ $(.$(ps)es).find-replace $(properties) : $(psval) ] ;
    if ! $(prev)
    {
        set-generated-target-prefix $(type) : $(properties) : $(psval) ;
    }    
}

rule generated-target-ps-real ( type : properties * : psn )
{
    local result ;
    local found ;
    while $(type) && ! $(found)
    {
        result = [ $(.$(ps)es).find <target-type>$(type) $(properties) ] ;
        # If the property (prefix/suffix) is explicitly set to empty string, 
        # we consider prefix to be found. If we did not compare with "", 
        # there would be no way for user to set empty prefix.
        if $(result)-is-not-empty
        {
            found = true ;
        }
        type = $(.bases.$(type)) ;
    }
    if $(result) = "" 
    {
        result = ;
    }
    return $(result) ;
}

rule generated-target-ps ( type : property-set : ps )
{
    local key = .$(ps).$(type).$(property-set) ;
    local v = $($(key)) ;
    if ! $(v)
    {
        v = [ generated-target-prefix-real $(type) 
          : [ $(property-set).raw ] ] ;
        if ! $(v)
        {
            v = none ;
        }
        $(key) = $(v) ;
    }
    
    if $(v) != none
    {
        return $(v) ;
    }        
}