This makes it possible to abstract the details of the specialized types of an object family, by masking them by a common interface which is the base-type.
For example a method 'moving()' will perform the appropriate movement according to the real derived-type of the instance referenced at the time of the call. This will allow the program to say 'instance.moving()' without having to worry about the real derived-type of 'instance'.
1) Let's remember sub-type polymorphism, true operating
- Sub-type polymorphism is the concept of providing a single interface to entities that can have different types (abstraction). More precisely, a same interface is implemented by a member routine having the same identifier in each type belonging to the same inheritance hierarchy.
Thanks to the abstract/virtual procedures, one can write a code using only the base-type that will automatically call the derived-type procedures.
By using the same procedure name for several different types, the polymorphism allows a much more generic programming (abstraction). The coder does not have to know, when calling a base procedure, the precise type of object on which the procedure will apply. He just needs to know that this type will implement the procedure.
- Designation of an object using a pointer or reference of more abstract type:- Considering a collection of objects whose instantiate types are derived-types from a base-type, then all these objects can be manipulated in an uniform way by considering them as objects of the base-type.
Better, certain behaviors can be specialized according to the instantiate type of each object. In other words, the use of distinct objects of the same inheritance hierarchy is homogeneous even if the behavior of these objects remains specific.
Thus, a base-type pointer or reference, pointing to an instance of a derived-type, can be use to manipulate such an object.
- To can declare abstract/virtual procedures in a type, this type must extends (directly or indirectly) the built-in Object type.
A derived-type can override an abstract/virtual procedure declared in its base-type, by declaring a procedure with the same identifier and signature, meaning same number and type of parameters, same calling convention, and if any, same return type (or a return of a derived-type for return by reference or by pointer):- Normally a base-type reference/pointer can access only a procedure in the same type or in a type upper in hierarchy (static binding at compile-time), even if this reference/pointer refers to an object of instantiate type derived from the base-type.
- But when the base-type procedure is abstract/virtual, this tells the running program to resolve the override procedure the most derived relating to the real object type (dynamic binding at run-time).
- Considering a collection of objects whose instantiate types are derived-types from a base-type, then all these objects can be manipulated in an uniform way by considering them as objects of the base-type.
- In the proposed example, the polymorphic part is simple to better bring out all the elements necessary for the mechanics of polymorphism.
The generic (base) type chosen is any 'animal' (abstraction).
The specialized (derived) types are a 'dog', a 'cat', and a 'bird' (each defining a non-static string member containing its type-name)
The abstract methods declared in the generic (base) type, and which must be defined in each specialized (derived) type, are:- - 'addr_override_fct()': returns the instance address,
- 'speak_override_fct()': returns the way of speaking,
- 'type_override_sub()': prints the type-name (from a string member with initialyser).
- - 'addr_override_fct()': returns the instance address,
- 'animal' type declaration (generic/base-type):
- Three public abstract methods ('addr_override_fct()', 'speak_override_fct()', 'type_override_sub()') are declared (but without any body defining them).
- This base-type is non-instantiable, because containing a abstract method at least.
Code: Select all
'Base-type animal: Type animal Extends Object Public: Declare Abstract Function addr_override_fct () As animal Ptr Declare Abstract Function speak_override_fct () As String Declare Abstract Sub type_override_sub () End Type
- 'dog', 'cat', 'bird' types declarations (specialized/derived-types):
- For each derived-type, the three same public method ('addr_override_fct()', 'speak_override_fct()', 'type_override_sub()') are declared virtual, and their bodies are specialized for each derived-type.
- For each derived-type, a non-static string member initialized with its type-name.
- Each derived-type is instantiable, because implementing all abstract methods declared in its base.
Code: Select all
'Derived-type dog: Type dog Extends animal Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override Private: Dim As String animal_type = "dog" End Type
Code: Select all
'Derived-type cat: Type cat Extends animal Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override Private: Dim As String animal_type = "cat" End Type
Code: Select all
'Derived-type bird: Type bird Extends animal Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override Private: Dim As String animal_type = "bird" End Type
- Full code of example:
- To be able to trigger polymorphism, a base-type pointer array ('animal_list') is declared then initialized with instances of different derived-types (a dog, a cat, a bird), in order to constitute a collection of objects from different types (but all having a common base-type).
- So, the same compiled code line, put in a loop (iterator 'I'), processes all instances from different types ('animal_list(I)->addr_override_fct()', 'animal_list(I)->speak_override_fct()', 'animal_list(I)->type_override_sub()'), because the polymorphism mechanic allows to call each specialized procedure at run-time.
Code: Select all
'Base-type animal: Type animal Extends Object Public: Declare Abstract Function addr_override_fct () As animal Ptr Declare Abstract Function speak_override_fct () As String Declare Abstract Sub type_override_sub () End Type 'Derived-type dog: Type dog Extends animal Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override Private: Dim As String animal_type = "dog" End Type 'override_sub methods for dog object: Virtual Function dog.addr_override_fct () As animal Ptr Return @This End Function Virtual Function dog.speak_override_fct () As String Return "Woof!" End Function Virtual Sub dog.type_override_sub () Print This.animal_type End Sub 'Derived-type cat: Type cat Extends animal Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override Private: Dim As String animal_type = "cat" End Type 'override_sub mehods for cat object: Virtual Function cat.addr_override_fct () As animal Ptr Return @This End Function Virtual Function cat.speak_override_fct () As String Return "Meow!" End Function Virtual Sub cat.type_override_sub () Print This.animal_type End Sub 'Derived-type bird: Type bird Extends animal Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override Private: Dim As String animal_type = "bird" End Type 'override_sub mehods for bird object: Virtual Function bird.addr_override_fct () As animal Ptr Return @This End Function Virtual Function bird.speak_override_fct () As String Return "Cheep!" End Function Virtual Sub bird.type_override_sub () Print This.animal_type End Sub 'Create a dog and cat and bird dynamic instances referred through an animal pointer list: Dim As dog Ptr p_my_dog = New dog Dim As cat Ptr p_my_cat = New cat Dim As bird Ptr p_my_bird = New bird Dim As animal Ptr animal_list (1 To ...) = {p_my_dog, p_my_cat, p_my_bird} 'Have the animals speak and eat: Print "SUB-TYPE POLYMORPHISM", "@object", "speak", "type" Print " true operating" For I As Integer = lBound(animal_list) To Ubound(animal_list) Print " animal #" & I & ":", Print animal_list(I)->addr_override_fct(), 'real polymorphism Print animal_list(I)->speak_override_fct(), 'real polymorphism animal_list(I)->type_override_sub() 'real polymorphism Next I Sleep Delete p_my_dog Delete p_my_cat Delete p_my_bird
Code: Select all
SUB-TYPE POLYMORPHISM @object speak type true operating animal #1: 2042528 Woof! dog animal #2: 2042600 Meow! cat animal #3: 2042672 Cheep! bird
- The abstract/virtual member procedures are implemented using virtual procedure tables (vtbl or vtable). vtbl is, simply explained, a table of static procedures pointers. The compiler fills a vtbl for each polymorphic type, i.e. a type defining at least an abstract/virtual procedure or a type derived from the former.
vtbl contains entries for all abstract/virtual procedures available in the type, including the abstract/virtual procedures defined in upper level of inheritance hierarchy (for abstract procedure not still implemented, a null pointer is set in the type vtbl).
Each vtbl contains the correct addresses of procedures for each abstract/virtual procedure in corresponding type. Here correct means the address of the corresponding procedure of the most derived-type that defines/overrides that procedure:- - When the type is instantiated, the instance will contain a pointer (vptr) to the virtual procedure table (vtbl) of the instantiated type.
- When an object of a derived types is referenced within a pointer/reference to a base type, then abstract/virtual procedure feature really performs. The call of a abstract/virtual procedure is somehow translated at run-time and the corresponding procedure from the virtual procedure table of the type of underlying object (not the pointer/reference type) is chosen.
- Thus, what procedure is called depends on what type of object the pointer/reference points to, which can't be known at compile-time, that is why the abstract/virtual procedure call is decided at run-time.
The abstract/virtual procedure call is converted by compiler to something else by using the proper vtbl addressed by the vptr value (located at offset 0 in the instance data):- In the above example, the three calls:
animal_list(I)->addr_override_fct()
animal_list(I)->speak_override_fct()
animal_list(I)->type_override_sub()
are about translated by the compiler into respectively:
Cptr(Function (Byref As animal) As animal Ptr, Cptr(Any Ptr Ptr Ptr, animal_list(I))[0][0])(*animal_list(I))
Cptr(Function (Byref As animal) As String, Cptr(Any Ptr Ptr Ptr, animal_list(I))[0][1])(*animal_list(I))
Cptr(Sub (Byref As animal), Cptr(Any Ptr Ptr Ptr, animal_list(I))[0][2])(*animal_list(I))- - The first indirection '[0]' allows to access to the value of the vptr from the address of the instance. This value correspond to the address of the vtbl.
- The second indirection '[0]' or '[1]' or '[2]' allows to access in the vtbl to the static address of the abstract procedures 'addr_override_fct()' or 'speak_override_fct()' or 'type_override_sub()' respectively (the declaration order of the abstract or virtual procedures in the Type).
- - The first indirection '[0]' allows to access to the value of the vptr from the address of the instance. This value correspond to the address of the vtbl.
- - The compiler generates some extra code in the constructor of each type (from the base-type up to the instantiated type), which it adds before the user code. Even if the user does not define a constructor, the compiler generates a default one, and the initialization of vptr is there (from the vtbl address of the base-type up to the one of the instantiated type). So each time an object of a polymorphic type is created, vptr is correctly initialized and finally points to the vtbl of that instantiated type.
- At the end, when the object is destructed, the destructors are called in the reverse order (from the instantiated type up to the base-type). The compiler also generates some extra code in the destructor of each type, which it adds after the user code. Even if the user does not define a destructor, the compiler generates a default one, and the de-initialization of vptr is there (from the vtbl address of the instantiated type up to the one of the base-type).
- This initialization/de-initialization of the vptr value by step is mandatory so that the user code in each constructor/destructor can call the polymorphic procedures at the correct type level during the successive steps of construction/destruction.
- - When the type is instantiated, the instance will contain a pointer (vptr) to the virtual procedure table (vtbl) of the instantiated type.
- This following emulation of sub-type polymorphism is very close to the real operating:
- a static procedure pointer table 'callback_table()' is defined for each derived-type to emulate the vtbl (an instance reference will be passed as first parameter to each static procedure to emulate the hidden 'This' reference passed to any non-static member procedure),
Code: Select all
'Derived-type dog: Type dog Extends animal Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As dog) As animal Ptr Declare Static Function speak_callback_fct (Byref As dog) As String Declare Static Sub type_callback_sub (Byref As dog) Declare Constructor () Private: Dim As String animal_type = "dog" End Type Static As Any Ptr dog.callback_table(0 To 2) _ = {@dog.addr_callback_fct, @dog.speak_callback_fct, @dog.type_callback_sub}
Code: Select all
'Derived-type cat: Type cat Extends animal Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As cat) As animal Ptr Declare Static Function speak_callback_fct (Byref As cat) As String Declare Static Sub type_callback_sub (Byref As cat) Declare Constructor () Private: Dim As String animal_type = "cat" End Type Static As Any Ptr cat.callback_table(0 To 2) _ = {@cat.addr_callback_fct, @cat.speak_callback_fct, @cat.type_callback_sub}
Code: Select all
'Derived-type bird: Type bird Extends animal Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As bird) As animal Ptr Declare Static Function speak_callback_fct (Byref As bird) As String Declare Static Sub type_callback_sub (Byref As bird) Declare Constructor () Private: Dim As String animal_type = "bird" End Type Static As Any Ptr bird.callback_table(0 To 2) _ = {@bird.addr_callback_fct, @bird.speak_callback_fct, @bird.type_callback_sub}
- at the base-type level, a non static pointer 'callback_ptr' is allocated for any derived-type instance to emulate the vptr (its value, initialized by the constructor, will depend on what derived-type is constructed: address of the following described table),
- at the base-type level, each abstract procedure is replaced by a member procedure calling the proper derived procedure through the 'callback_ptr'/'callback_table(I)' ('I' being the index inside the table corresponding to this procedure).
Code: Select all
'Base-type animal: Type animal Protected: Dim As Any Ptr Ptr callback_ptr Public: Declare Function addr_callback_fct () As animal Ptr Declare Function speak_callback_fct () As String Declare Sub type_callback_sub () End Type Function animal.addr_callback_fct () As animal Ptr Return Cptr(Function (Byref As animal) As animal Ptr, This.callback_ptr[0])(This) End Function Function animal.speak_callback_fct () As String Return Cptr(Function (Byref As animal) As String, This.callback_ptr[1])(This) End Function Sub animal.type_callback_sub () Cptr(Sub (Byref As animal), This.callback_ptr[2])(This) End Sub
- a static procedure pointer table 'callback_table()' is defined for each derived-type to emulate the vtbl (an instance reference will be passed as first parameter to each static procedure to emulate the hidden 'This' reference passed to any non-static member procedure),
- Full code of emulation:
Code: Select all
' Emulation of polymorphism is very close to the real operating: ' - a non static pointer is allocated for any derived-type instance to emulate the vptr ' (its value will depend on what derived-type is constructed: address of the following table) ' - a static procedure pointer table is defined for each derived type to emulate the vtable ' (an instance reference is passed as first parameter to each static procedure to emulate the hidden 'This' reference passed to any non-static member procedure) 'Base-type animal: Type animal Protected: Dim As Any Ptr Ptr callback_ptr Public: Declare Function addr_callback_fct () As animal Ptr Declare Function speak_callback_fct () As String Declare Sub type_callback_sub () End Type Function animal.addr_callback_fct () As animal Ptr Return Cptr(Function (Byref As animal) As animal Ptr, This.callback_ptr[0])(This) End Function Function animal.speak_callback_fct () As String Return Cptr(Function (Byref As animal) As String, This.callback_ptr[1])(This) End Function Sub animal.type_callback_sub () Cptr(Sub (Byref As animal), This.callback_ptr[2])(This) End Sub 'Derived-type dog: Type dog Extends animal Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As dog) As animal Ptr Declare Static Function speak_callback_fct (Byref As dog) As String Declare Static Sub type_callback_sub (Byref As dog) Declare Constructor () Private: Dim As String animal_type = "dog" End Type Static As Any Ptr dog.callback_table(0 To 2) _ = {@dog.addr_callback_fct, @dog.speak_callback_fct, @dog.type_callback_sub} 'callback_sub methods + constructor for dog object: Static Function dog.addr_callback_fct (Byref d As dog) As animal Ptr Return @d End Function Static Function dog.speak_callback_fct (Byref d As dog) As String Return "Woof!" End Function Static Sub dog.type_callback_sub (Byref d As dog) Print d.animal_type End Sub Constructor dog () This.callback_ptr = @callback_table(0) End Constructor 'Derived-type cat: Type cat Extends animal Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As cat) As animal Ptr Declare Static Function speak_callback_fct (Byref As cat) As String Declare Static Sub type_callback_sub (Byref As cat) Declare Constructor () Private: Dim As String animal_type = "cat" End Type Static As Any Ptr cat.callback_table(0 To 2) _ = {@cat.addr_callback_fct, @cat.speak_callback_fct, @cat.type_callback_sub} 'callback_sub mehods + constructor for cat object: Static Function cat.addr_callback_fct (Byref c As cat) As animal Ptr Return @c End Function Static Function cat.speak_callback_fct (Byref c As cat) As String Return "Meow!" End Function Static Sub cat.type_callback_sub (Byref c As cat) Print c.animal_type End Sub Constructor cat () This.callback_ptr = @callback_table(0) End Constructor 'Derived-type bird: Type bird Extends animal Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As bird) As animal Ptr Declare Static Function speak_callback_fct (Byref As bird) As String Declare Static Sub type_callback_sub (Byref As bird) Declare Constructor () Private: Dim As String animal_type = "bird" End Type Static As Any Ptr bird.callback_table(0 To 2) _ = {@bird.addr_callback_fct, @bird.speak_callback_fct, @bird.type_callback_sub} 'callback_sub mehods + constructor for bird object: Static Function bird.addr_callback_fct (Byref b As bird) As animal Ptr Return @b End Function Static Function bird.speak_callback_fct (Byref b As bird) As String Return "Cheep!" End Function Static Sub bird.type_callback_sub (Byref b As bird) Print b.animal_type End Sub Constructor bird () This.callback_ptr = @callback_table(0) End Constructor 'Create a dog and cat and bird dynamic instances referred through an animal pointer list: Dim As dog Ptr p_my_dog = New dog Dim As cat Ptr p_my_cat = New cat Dim As bird Ptr p_my_bird = New bird Dim As animal Ptr animal_list (1 To ...) = {p_my_dog, p_my_cat, p_my_bird} 'Have the animals speak and eat: Print "SUB-TYPE POLYMORPHISM", "@object", "speak", "type" Print " by emulation" For I As Integer = lBound(animal_list) To Ubound(animal_list) Print " animal #" & I & ":", Print animal_list(I)->addr_callback_fct(), 'emulated polymorphism Print animal_list(I)->speak_callback_fct(), 'emulated polymorphism animal_list(I)->type_callback_sub() 'emulated polymorphism Next I Sleep Delete p_my_dog Delete p_my_cat Delete p_my_bird
Code: Select all
SUB-TYPE POLYMORPHISM @object speak type by emulation animal #1: 9841312 Woof! dog animal #2: 9841384 Meow! cat animal #3: 9841456 Cheep! bird
Code: Select all
' Emulated polymorphism (with explicit callback member procedures) ' and ' True polymorphism (with abstract/virtual member procedures), ' both in an inheritance structure. 'Base-type animal: Type animal Extends Object 'Extends Object' useful for true polymorphism only ' for true polymorphism: Public: Declare Abstract Function addr_override_fct () As animal Ptr Declare Abstract Function speak_override_fct () As String Declare Abstract Sub type_override_sub () ' for polymorphism emulation: Protected: Dim As Any Ptr Ptr callback_ptr Public: Declare Function addr_callback_fct () As animal Ptr Declare Function speak_callback_fct () As String Declare Sub type_callback_sub () End Type ' for polymorphism emulation: Function animal.addr_callback_fct () As animal Ptr Return Cptr(Function (Byref As animal) As animal Ptr, This.callback_ptr[0])(This) End Function Function animal.speak_callback_fct () As String Return Cptr(Function (Byref As animal) As String, This.callback_ptr[1])(This) End Function Sub animal.type_callback_sub () Cptr(Sub (Byref As animal), This.callback_ptr[2])(This) End Sub 'Derived-type dog: Type dog Extends animal ' for true polymorphism: Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override ' for polymorphism emulation: Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As dog) As animal Ptr Declare Static Function speak_callback_fct (Byref As dog) As String Declare Static Sub type_callback_sub (Byref As dog) Declare Constructor () ' for all: Private: Dim As String animal_type = "dog" End Type ' for true polymorphism: 'override_sub methods for dog object: Virtual Function dog.addr_override_fct () As animal Ptr Return @This End Function Virtual Function dog.speak_override_fct () As String Return "Woof!" End Function Virtual Sub dog.type_override_sub () Print This.animal_type End Sub ' for polymorphism emulation: Static As Any Ptr dog.callback_table(0 To 2) _ = {@dog.addr_callback_fct, @dog.speak_callback_fct, @dog.type_callback_sub} 'callback_sub methods + constructor for dog object: Static Function dog.addr_callback_fct (Byref d As dog) As animal Ptr Return @d End Function Static Function dog.speak_callback_fct (Byref d As dog) As String Return "Woof!" End Function Static Sub dog.type_callback_sub (Byref d As dog) Print d.animal_type End Sub Constructor dog () This.callback_ptr = @callback_table(0) End Constructor 'Derived-type cat: Type cat Extends animal ' for true polymorphism: Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override ' for polymorphism emulation: Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As cat) As animal Ptr Declare Static Function speak_callback_fct (Byref As cat) As String Declare Static Sub type_callback_sub (Byref As cat) Declare Constructor () ' for all: Private: Dim As String animal_type = "cat" End Type ' for true polymorphism: 'override_sub mehods for cat object: Virtual Function cat.addr_override_fct () As animal Ptr Return @This End Function Virtual Function cat.speak_override_fct () As String Return "Meow!" End Function Virtual Sub cat.type_override_sub () Print This.animal_type End Sub ' for polymorphism emulation: Static As Any Ptr cat.callback_table(0 To 2) _ = {@cat.addr_callback_fct, @cat.speak_callback_fct, @cat.type_callback_sub} 'callback_sub mehods + constructor for cat object: Static Function cat.addr_callback_fct (Byref c As cat) As animal Ptr Return @c End Function Static Function cat.speak_callback_fct (Byref c As cat) As String Return "Meow!" End Function Static Sub cat.type_callback_sub (Byref c As cat) Print c.animal_type End Sub Constructor cat () This.callback_ptr = @callback_table(0) End Constructor 'Derived-type bird: Type bird Extends animal ' for true polymorphism: Public: Declare Virtual Function addr_override_fct () As animal Ptr Override Declare Virtual Function speak_override_fct () As String Override Declare Virtual Sub type_override_sub () Override ' for polymorphism emulation: Private: Static As Any Ptr callback_table(0 To 2) Public: Declare Static Function addr_callback_fct (Byref As bird) As animal Ptr Declare Static Function speak_callback_fct (Byref As bird) As String Declare Static Sub type_callback_sub (Byref As bird) Declare Constructor () ' for all: Private: Dim As String animal_type = "bird" End Type ' for true polymorphism: 'override_sub mehods for bird object: Virtual Function bird.addr_override_fct () As animal Ptr Return @This End Function Virtual Function bird.speak_override_fct () As String Return "Cheep!" End Function Virtual Sub bird.type_override_sub () Print This.animal_type End Sub ' for polymorphism emulation: Static As Any Ptr bird.callback_table(0 To 2) _ = {@bird.addr_callback_fct, @bird.speak_callback_fct, @bird.type_callback_sub} 'callback_sub mehods + constructor for bird object: Static Function bird.addr_callback_fct (Byref b As bird) As animal Ptr Return @b End Function Static Function bird.speak_callback_fct (Byref b As bird) As String Return "Cheep!" End Function Static Sub bird.type_callback_sub (Byref b As bird) Print b.animal_type End Sub Constructor bird () This.callback_ptr = @callback_table(0) End Constructor 'Create a dog and cat and bird dynamic instances referred through an animal pointer list: Dim As dog Ptr p_my_dog = New dog Dim As cat Ptr p_my_cat = New cat Dim As bird Ptr p_my_bird = New bird Dim As animal Ptr animal_list (1 To ...) = {p_my_dog, p_my_cat, p_my_bird} 'Have the animals speak and eat: Print "SUB-TYPE POLYMORPHISM", "@object", "speak", "type" For I As Integer = lBound(animal_list) To Ubound(animal_list) Print " animal #" & I & ":" ' for override_sub: Print " true operating:", Print animal_list(I)->addr_override_fct(), 'real polymorphism Print animal_list(I)->speak_override_fct(), 'real polymorphism animal_list(I)->type_override_sub() 'real polymorphism ' for polymorphism emulation: Print " by emulation:", Print animal_list(I)->addr_callback_fct(), 'emulated polymorphism Print animal_list(I)->speak_callback_fct(), 'emulated polymorphism animal_list(I)->type_callback_sub() 'emulated polymorphism Next I Sleep Delete p_my_dog Delete p_my_cat Delete p_my_bird
Code: Select all
SUB-TYPE POLYMORPHISM @object speak type animal #1: true operating: 4663968 Woof! dog by emulation: 4663968 Woof! dog animal #2: true operating: 4664048 Meow! cat by emulation: 4664048 Meow! cat animal #3: true operating: 4664128 Cheep! bird by emulation: 4664128 Cheep! bird
- How and Why to make Abstraction by Subtype Polymorphism, with FB Syntax in UDTs (advanced)