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

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
fxm
Moderator
Posts: 12197
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

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

Post by fxm »

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'
    
Post Reply