Macros for up/down cast in a user inheritance structure extending 'Object'

Post by **fxm** » Feb 12, 2024 17:22

1. Macro for static up/down cast to a temporary reference (in a user inheritance structure extending 'Object')

This macro allows to define a temporary reference to an instance in an inheritance structure (deriving from 'Object'), while choosing its static (compile-time) type among the different types available in the user inheritance structure.
If the requested static type is not compatible with the instance, a null temporary reference is defined, otherwise a temporary reference to the provided instance is defined.
In the inheritance structure, the user base must extends 'Object'.

Code: Select all

#define OOP_static_cast(instance, type) (*Cast(Type Ptr, -(Cast(Object, instance) IS type) * Cast(Uinteger, @instance)))
    ' In the inheritance structure, the user base must extends 'Object'.
    ' This macro provides a typed ('type') temporary reference to the passed instance ('instance').
    ' If the cast fails, @OOP_static_cast = 0

- Complete test example with the following inheritance structure:

Code: Select all

'                          <-- cat <-- supercat   (derived from animal)
'    ( Object ) <-- animal 
'                          <-- dog                (derived from animal)

Code: Select all

#define OOP_static_cast(instance, type) (*Cast(Type Ptr, -(Cast(Object, instance) IS type) * Cast(Uinteger, @instance)))
    ' In the inheritance structure, the user base must extends 'Object'.
    ' This macro provides a typed ('type') temporary reference to the passed instance ('instance').
    ' If the cast fails, @OOP_static_cast = 0


Type animal Extends Object
    Declare Sub compile_time_IS()
    Declare Virtual Sub run_time_IS()
End Type

Sub animal.compile_time_IS()
    Print "   compile-time type is an animal"
End Sub

Sub animal.run_time_IS()
    Print "   run-time type is an animal"
End Sub


Type cat Extends animal
    Declare Sub compile_time_IS()
    Declare Virtual Sub run_time_IS()
End Type

Sub cat.compile_time_IS()
    Print "   compile-time type is a cat"
End Sub

Sub cat.run_time_IS()
    Print "   run-time type is a cat"
End Sub


Type dog Extends animal
    Declare Sub compile_time_IS()
    Declare Virtual Sub run_time_IS()
End Type

Sub dog.compile_time_IS()
    Print "   compile-time type is a dog"
End Sub

Sub dog.run_time_IS()
    Print "   run-time type is a dog"
End Sub


Type supercat Extends cat
    Declare Sub compile_time_IS()
    Declare Virtual Sub run_time_IS()
End Type

Sub supercat.compile_time_IS()
    Print "   compile-time type is a supercat"
End Sub

Sub supercat.run_time_IS()
    Print "   run-time type is a supercat"
End Sub


Print "'Dim Byref As animal ac = *New cat()'"
Dim Byref As animal ac = *New cat()
ac.compile_time_IS()
ac.run_time_IS()

Print "'OOP_static_cast(ac, cat)' :"
If @OOP_static_cast(ac, cat) > 0 Then
    OOP_static_cast(ac, cat).compile_time_IS()
    OOP_static_cast(ac, cat).run_time_IS()
Else
    Print "invalid cast"
End If
Print "'OOP_static_cast(ac, animal)' :"
IF @OOP_static_cast(ac, animal) > 0 Then
    OOP_static_cast(ac, animal).compile_time_IS()
    OOP_static_cast(ac, animal).run_time_IS()
Else
    Print "   invalid cast"
End If
Print "'OOP_static_cast(ac, dog)' :"
If @OOP_static_cast(ac, dog) > 0 Then
    OOP_static_cast(ac, dog).compile_time_IS()
    OOP_static_cast(ac, dog).run_time_IS()
Else
    Print "   invalid cast"
End If
Print "'OOP_static_cast(ac, supercat)' :"
If @OOP_static_cast(ac, supercat) > 0 Then
    OOP_static_cast(ac, supercat).compile_time_IS()
    OOP_static_cast(ac, supercat).run_time_IS()
Else
    Print "   invalid cast"
End If
Print

Print "'Dim Byref As Cat cc = *New cat' :"
Dim Byref As Cat cc = *New cat
cc.compile_time_IS()
cc.run_time_IS()

Print "'OOP_static_cast(cc, animal)' :"
IF @OOP_static_cast(cc, animal) > 0 Then
    OOP_static_cast(cc, animal).compile_time_IS()
    OOP_static_cast(cc, animal).run_time_IS()
Else
    Print "   invalid cast"
End If
Print "'OOP_static_cast(cc, cat)' :"
If @OOP_static_cast(cc, cat) > 0 Then
    OOP_static_cast(cc, cat).compile_time_IS()
    OOP_static_cast(cc, cat).run_time_IS()
Else
    Print "   invalid cast"
End If
Print "'OOP_static_cast(cc, dog)' :"
If @OOP_static_cast(cc, dog) > 0 Then
    OOP_static_cast(cc, dog).compile_time_IS()
    OOP_static_cast(cc, dog).run_time_IS()
Else
    Print "   invalid cast"
End If
Print "'OOP_static_cast(cc, supercat)' :"
If @OOP_static_cast(cc, supercat) > 0 Then
    OOP_static_cast(cc, supercat).compile_time_IS()
    OOP_static_cast(cc, supercat).run_time_IS()
Else
    Print "   invalid cast"
End If
Print

Delete @ac
Delete @cc
Sleep

Output:

Code: Select all

'Dim Byref As animal ac = *New cat()'
   compile-time type is an animal
   run-time type is a cat
'OOP_static_cast(ac, cat)' :
   compile-time type is a cat
   run-time type is a cat
'OOP_static_cast(ac, animal)' :
   compile-time type is an animal
   run-time type is a cat
'OOP_static_cast(ac, dog)' :
   invalid cast
'OOP_static_cast(ac, supercat)' :
   invalid cast

'Dim Byref As Cat cc = *New cat' :
   compile-time type is a cat
   run-time type is a cat
'OOP_static_cast(cc, animal)' :
   compile-time type is an animal
   run-time type is a cat
'OOP_static_cast(cc, cat)' :
   compile-time type is a cat
   run-time type is a cat
'OOP_static_cast(cc, dog)' :
   invalid cast
'OOP_static_cast(cc, supercat)' :
   invalid cast

2. Macro for static up/down cast to a reference (in a user inheritance structure extending 'Object')

This macro allows to declare and define a reference to an instance in an inheritance structure (deriving from 'Object'), while choosing its static (compile-time) type among the different types available in the user inheritance structure.
If the requested static type is not compatible with the instance, a null reference is defined, otherwise a reference to the provided instance is defined.
In the inheritance structure, the user base must extends 'Object'.

Code: Select all

#macro OOP_static_cast_to_reference(input_instance, to_cast_type, output_reference)
    ' In the inheritance structure, the user base must extends 'Object'.
    ' From an undeclared reserved name ('output_reference'),
    '    this macro provides a typed ('to_cast_type') reference to the passed instance ('input_instance').
    ' If the cast succeeds, @output_reference = @input_instance.
    ' Yf the cast fails, @output_reference = 0
    
    Dim Byref As to_cast_type output_reference = *Cptr(to_cast_type Ptr, 0)
    If Cast(Object, input_instance) Is to_cast_type Then
        @output_reference = Cptr(to_cast_type Ptr, @input_instance)
    End If
#endmacro

- Complete test example with the following inheritance structure:

Code: Select all

'                          <-- cat <-- supercat   (derived from animal)
'    ( Object ) <-- animal 
'                          <-- dog                (derived from animal)

Code: Select all

#macro OOP_static_cast_to_reference(input_instance, to_cast_type, output_reference)
    ' In the inheritance structure, the user base must extends 'Object'.
    ' From an undeclared reserved name ('output_reference'),
    '    this macro provides a typed ('to_cast_type') reference to the passed instance ('input_instance').
    ' If the cast succeeds, @output_reference = @input_instance.
    ' Yf the cast fails, @output_reference = 0
    
    Dim Byref As to_cast_type output_reference = *Cptr(to_cast_type Ptr, 0)
    If Cast(Object, input_instance) Is to_cast_type Then
        @output_reference = Cptr(to_cast_type Ptr, @input_instance)
    End If
#endmacro


Type animal Extends Object
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function animal.compile_time_IS() As String
    Return "compile-time type is an 'animal'"
End Function

Function animal.run_time_IS() As String
    Return "run-time type is an 'animal'"
End Function

Type cat Extends animal
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function cat.compile_time_IS() As String
    Return "compile-time type is a 'cat'"
End Function

Function cat.run_time_IS() As String
    Return "run-time type is a 'cat'"
End Function

Type dog Extends animal
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function dog.compile_time_IS() As String
    Return "compile-time type is a 'dog'"
End Function

Function dog.run_time_IS() As String
    Return "run-time type is a 'dog'"
End Function

Type supercat Extends cat
    Declare Function compile_time_IS() As String
    Declare Virtual Function run_time_IS() As String
End Type

Function supercat.compile_time_IS() As String
    Return "compile-time type is a 'supercat'"
End Function

Function supercat.run_time_IS() As String
    Return "run-time type is a 'supercat'"
End Function


Dim As animal a
Print "'Dim As animal a':"
Print "   instance a: " & a.compile_time_IS()
Print "   instance a: " & a.run_time_IS()
OOP_static_cast_to_reference(a, cat, rca)
Print "'OOP_static_cast(a, cat, rca)':"
If @rca = @a Then
    Print "   reference rca: " & rca.compile_time_IS()
    Print "   reference rca: " & rca.run_time_IS()
Elseif @rca = 0 Then
    Print "   null reference rca (@rca = 0)"
End If
Print

Dim Byref As animal ac = *New cat()
Print "'Dim Byref As animal ac = *New cat()':"
Print "   reference ac: " & ac.compile_time_IS()
Print "   reference ac: " & ac.run_time_IS()
OOP_static_cast_to_reference(ac, cat, rcc)
Print "'OOP_static_cast(ac, cat, rcc)':"
If @rcc = @ac Then
    Print "   reference rcc: " & rcc.compile_time_IS()
    Print "   reference rcc: " & rcc.run_time_IS()
Elseif @rcc = 0 Then
    Print "   null reference rcc (@rcc = 0)"
End If
OOP_static_cast_to_reference(ac, animal, rac)
Print "'OOP_static_cast(ac, animal, rac)':"
If @rac = @ac Then
    Print "   reference rac: " & rac.compile_time_IS()
    Print "   reference rac: " & rac.run_time_IS()
Elseif @rac = 0 Then
    Print "   null reference rac (@rac = 0)"
End If
OOP_static_cast_to_reference(ac, supercat, rsc)
Print "'OOP_static_cast(ac, dog, rsc)':"
If @rsc = @ac Then
    Print "   reference rsc: " & rsc.compile_time_IS()
    Print "   reference rsc: " & rsc.run_time_IS()
Elseif @rsc = 0 Then
    Print "   null reference rsc (@rsc = 0)"
End If
OOP_static_cast_to_reference(ac, dog, rdc)
Print "'OOP_static_cast(ac, supercat, rdc)':"
If @rdc = @ac Then
    Print "   reference rdc: " & rdc.compile_time_IS()
    Print "   reference rdc: " & rdc.run_time_IS()
Elseif @rdc = 0 Then
    Print "   null reference rdc (@rdc = 0)"
End If
Print

Delete @ac
Sleep

Output:

Code: Select all

'Dim As animal a':
   instance a: compile-time type is an 'animal'
   instance a: run-time type is an 'animal'
'OOP_static_cast(a, cat, rca)':
   null reference rca (@rca = 0)

'Dim Byref As animal ac = *New cat()':
   reference ac: compile-time type is an 'animal'
   reference ac: run-time type is a 'cat'
'OOP_static_cast(ac, cat, rcc)':
   reference rcc: compile-time type is a 'cat'
   reference rcc: run-time type is a 'cat'
'OOP_static_cast(ac, animal, rac)':
   reference rac: compile-time type is an 'animal'
   reference rac: run-time type is a 'cat'
'OOP_static_cast(ac, dog, rsc)':
   null reference rsc (@rsc = 0)
'OOP_static_cast(ac, supercat, rdc)':
   null reference rdc (@rdc = 0)

- Very simple example:

Code: Select all

#macro OOP_static_cast_to_reference(input_instance, to_cast_type, output_reference)
    ' In the inheritance structure, the user base must extends 'Object'.
    ' From an undeclared reserved name ('output_reference'),
    '    this macro provides a typed ('to_cast_type') reference to the passed instance ('input_instance').
    ' If the cast succeeds, @output_reference = @input_instance.
    ' Yf the cast fails, @output_reference = 0
    
    Dim Byref As to_cast_type output_reference = *Cptr(to_cast_type Ptr, 0)
    If Cast(Object, input_instance) Is to_cast_type Then
        @output_reference = Cptr(to_cast_type Ptr, @input_instance)
    End If
#endmacro


Type animal Extends Object
    Dim As String s = "compile-time type is an 'animal'"
End Type

Type cat Extends animal
    Dim As String s = "compile-time type is a 'cat'"
End Type


Dim Byref As animal ac = *New cat()
Print "'Dim Byref As animal ac = *New cat()':"
Print "   reference ac: " & ac.s
Print
OOP_static_cast_to_reference(ac, cat, rcc)
Print "'OOP_static_cast(ac, cat, rcc)':"
If @rcc = @ac Then
    Print "   reference rcc: " & rcc.s
Elseif @rcc = 0 Then
    Print "   null reference rcc (@rcc = 0)"
End If
Print
OOP_static_cast_to_reference(rcc, animal, rac)
Print "'OOP_static_cast(rcc, animal, rac)':"
If @rac = @ac Then
    Print "   reference rac: " & rac.s
Elseif @rac = 0 Then
    Print "   null reference rac (@rac = 0)"
End If
Print

Delete @ac
Sleep

Output:

Code: Select all

'Dim Byref As animal ac = *New cat()':
   reference ac: compile-time type is an 'animal'

'OOP_static_cast(ac, cat, rcc)':
   reference rcc: compile-time type is a 'cat'

'OOP_static_cast(rcc, animal, rac)':
   reference rac: compile-time type is an 'animal'