diff options
Diffstat (limited to 'tools/build/v2/kernel/class.jam')
| -rw-r--r-- | tools/build/v2/kernel/class.jam | 420 |
1 files changed, 420 insertions, 0 deletions
diff --git a/tools/build/v2/kernel/class.jam b/tools/build/v2/kernel/class.jam new file mode 100644 index 0000000000..b8e55af355 --- /dev/null +++ b/tools/build/v2/kernel/class.jam @@ -0,0 +1,420 @@ +# Copyright 2001, 2002, 2003 Dave Abrahams +# Copyright 2002, 2005 Rene Rivera +# Copyright 2002, 2003 Vladimir Prus +# Distributed under the Boost Software License, Version 1.0. +# (See accompanying file LICENSE_1_0.txt or http://www.boost.org/LICENSE_1_0.txt) + +# Polymorphic class system built on top of core Jam facilities. +# +# Classes are defined by 'class' keywords:: +# +# class myclass +# { +# rule __init__ ( arg1 ) # constructor +# { +# self.attribute = $(arg1) ; +# } +# +# rule method1 ( ) # method +# { +# return [ method2 ] ; +# } +# +# rule method2 ( ) # method +# { +# return $(self.attribute) ; +# } +# } +# +# The __init__ rule is the constructor, and sets member variables. +# +# New instances are created by invoking [ new <class> <args...> ]: +# +# local x = [ new myclass foo ] ; # x is a new myclass object +# assert.result foo : [ $(x).method1 ] ; # $(x).method1 returns "foo" +# +# Derived class are created by mentioning base classes in the declaration:: +# +# class derived : myclass +# { +# rule __init__ ( arg ) +# { +# myclass.__init__ $(arg) ; # call base __init__ +# +# } +# +# rule method2 ( ) # method override +# { +# return $(self.attribute)XXX ; +# } +# } +# +# All methods operate virtually, replacing behavior in the base classes. For +# example:: +# +# local y = [ new derived foo ] ; # y is a new derived object +# assert.result fooXXX : [ $(y).method1 ] ; # $(y).method1 returns "foo" +# +# Each class instance is its own core Jam module. All instance attributes and +# methods are accessible without additional qualification from within the class +# instance. All rules imported in class declaration, or visible in base classses +# are also visible. Base methods are available in qualified form: +# base-name.method-name. By convention, attribute names are prefixed with +# "self.". + +import modules ; +import numbers ; + + +rule xinit ( instance : class ) +{ + module $(instance) + { + __class__ = $(2) ; + __name__ = $(1) ; + } +} + + +rule new ( class args * : * ) +{ + .next-instance ?= 1 ; + local id = object($(class))@$(.next-instance) ; + + xinit $(id) : $(class) ; + + INSTANCE $(id) : class@$(class) ; + IMPORT_MODULE $(id) ; + $(id).__init__ $(args) : $(2) : $(3) : $(4) : $(5) : $(6) : $(7) : $(8) : $(9) ; + + # Bump the next unique object name. + .next-instance = [ numbers.increment $(.next-instance) ] ; + + # Return the name of the new instance. + return $(id) ; +} + + +rule bases ( class ) +{ + module class@$(class) + { + return $(__bases__) ; + } +} + + +rule is-derived ( class : bases + ) +{ + local stack = $(class) ; + local visited found ; + while ! $(found) && $(stack) + { + local top = $(stack[1]) ; + stack = $(stack[2-]) ; + if ! ( $(top) in $(visited) ) + { + visited += $(top) ; + stack += [ bases $(top) ] ; + + if $(bases) in $(visited) + { + found = true ; + } + } + } + return $(found) ; +} + + +# Returns true if the 'value' is a class instance. +# +rule is-instance ( value ) +{ + return [ MATCH "^(object\\()[^@]+\\)@.*" : $(value) ] ; +} + + +# Check if the given value is of the given type. +# +rule is-a ( + instance # The value to check. + : type # The type to test for. +) +{ + if [ is-instance $(instance) ] + { + return [ class.is-derived [ modules.peek $(instance) : __class__ ] : $(type) ] ; + } +} + + +local rule typecheck ( x ) +{ + local class-name = [ MATCH "^\\[(.*)\\]$" : [ BACKTRACE 1 ] ] ; + if ! [ is-a $(x) : $(class-name) ] + { + return "Expected an instance of "$(class-name)" but got \""$(x)"\" for argument" ; + } +} + + +rule __test__ ( ) +{ + import assert ; + import "class" : new ; + + # This will be the construction function for a class called 'myclass'. + # + class myclass + { + import assert ; + + rule __init__ ( x_ * : y_ * ) + { + # Set some instance variables. + x = $(x_) ; + y = $(y_) ; + foo += 10 ; + } + + rule set-x ( newx * ) + { + x = $(newx) ; + } + + rule get-x ( ) + { + return $(x) ; + } + + rule set-y ( newy * ) + { + y = $(newy) ; + } + + rule get-y ( ) + { + return $(y) ; + } + + rule f ( ) + { + return [ g $(x) ] ; + } + + rule g ( args * ) + { + if $(x) in $(y) + { + return $(x) ; + } + else if $(y) in $(x) + { + return $(y) ; + } + else + { + return ; + } + } + + rule get-class ( ) + { + return $(__class__) ; + } + + rule get-instance ( ) + { + return $(__name__) ; + } + + rule invariant ( ) + { + assert.equal 1 : 1 ; + } + + rule get-foo ( ) + { + return $(foo) ; + } + } +# class myclass ; + + class derived1 : myclass + { + rule __init__ ( z_ ) + { + myclass.__init__ $(z_) : X ; + z = $(z_) ; + } + + # Override g. + # + rule g ( args * ) + { + return derived1.g ; + } + + rule h ( ) + { + return derived1.h ; + } + + rule get-z ( ) + { + return $(z) ; + } + + # Check that 'assert.equal' visible in base class is visible here. + # + rule invariant2 ( ) + { + assert.equal 2 : 2 ; + } + + # Check that 'assert.variable-not-empty' visible in base class is + # visible here. + # + rule invariant3 ( ) + { + local v = 10 ; + assert.variable-not-empty v ; + } + } +# class derived1 : myclass ; + + class derived2 : myclass + { + rule __init__ ( ) + { + myclass.__init__ 1 : 2 ; + } + + # Override g. + # + rule g ( args * ) + { + return derived2.g ; + } + + # Test the ability to call base class functions with qualification. + # + rule get-x ( ) + { + return [ myclass.get-x ] ; + } + } +# class derived2 : myclass ; + + class derived2a : derived2 + { + rule __init__ + { + derived2.__init__ ; + } + } +# class derived2a : derived2 ; + + local rule expect_derived2 ( [derived2] x ) { } + + local a = [ new myclass 3 4 5 : 4 5 ] ; + local b = [ new derived1 4 ] ; + local b2 = [ new derived1 4 ] ; + local c = [ new derived2 ] ; + local d = [ new derived2 ] ; + local e = [ new derived2a ] ; + + expect_derived2 $(d) ; + expect_derived2 $(e) ; + + # Argument checking is set up to call exit(1) directly on failure, and we + # can not hijack that with try, so we should better not do this test by + # default. We could fix this by having errors look up and invoke the EXIT + # rule instead; EXIT can be hijacked (;-) + if --fail-typecheck in [ modules.peek : ARGV ] + { + try ; + { + expect_derived2 $(a) ; + } + catch + "Expected an instance of derived2 but got" instead + ; + } + + #try ; + #{ + # new bad_subclass ; + #} + #catch + # bad_subclass.bad_subclass failed to call base class constructor myclass.__init__ + # ; + + #try ; + #{ + # class bad_subclass ; + #} + #catch bad_subclass has already been declared ; + + assert.result 3 4 5 : $(a).get-x ; + assert.result 4 5 : $(a).get-y ; + assert.result 4 : $(b).get-x ; + assert.result X : $(b).get-y ; + assert.result 4 : $(b).get-z ; + assert.result 1 : $(c).get-x ; + assert.result 2 : $(c).get-y ; + assert.result 4 5 : $(a).f ; + assert.result derived1.g : $(b).f ; + assert.result derived2.g : $(c).f ; + assert.result derived2.g : $(d).f ; + + assert.result 10 : $(b).get-foo ; + + $(a).invariant ; + $(b).invariant2 ; + $(b).invariant3 ; + + # Check that the __class__ attribute is getting properly set. + assert.result myclass : $(a).get-class ; + assert.result derived1 : $(b).get-class ; + assert.result $(a) : $(a).get-instance ; + + $(a).set-x a.x ; + $(b).set-x b.x ; + $(c).set-x c.x ; + $(d).set-x d.x ; + assert.result a.x : $(a).get-x ; + assert.result b.x : $(b).get-x ; + assert.result c.x : $(c).get-x ; + assert.result d.x : $(d).get-x ; + + class derived3 : derived1 derived2 + { + rule __init__ ( ) + { + } + } + + assert.result : bases myclass ; + assert.result myclass : bases derived1 ; + assert.result myclass : bases derived2 ; + assert.result derived1 derived2 : bases derived3 ; + + assert.true is-derived derived1 : myclass ; + assert.true is-derived derived2 : myclass ; + assert.true is-derived derived3 : derived1 ; + assert.true is-derived derived3 : derived2 ; + assert.true is-derived derived3 : derived1 derived2 myclass ; + assert.true is-derived derived3 : myclass ; + + assert.false is-derived myclass : derived1 ; + + assert.true is-instance $(a) ; + assert.false is-instance bar ; + + assert.true is-a $(a) : myclass ; + assert.true is-a $(c) : derived2 ; + assert.true is-a $(d) : myclass ; + assert.false is-a literal : myclass ; +} |