Overriding standard library with macros together with modules

[tored]

You can override a standard library procedure with your own macro and then let the macro call your own custom procedure and from your custom procedure call the real library procedure, like the decorator pattern.

Code: Select all

Procedure MessageRequesterDecorator(Title$, Text$ , Flags = #Null)
  Debug "Hello from decorator!"
  MessageRequester(Title$, Text$, Flags)
EndProcedure

Macro MessageRequester(Title, Text , Flags = #Null)
  MessageRequesterDecorator(Title, Text, Flags)
EndMacro

MessageRequester("Info", "Hello, World!")

This is however dependent on the order you define your procedure and macro, moving the macro definition before the procedure definition will result in an endless loop, because the decorator will use the macro instead of the standard library procedure.

However when using modules, you can't call your own global procedure from within a module and procedures within modules can't be defined before a macro definition (only procedure declarations are allowed in the module declaration)

Thus the following code will not use the decorator because of global scoping

Code: Select all

Procedure MessageRequesterDecorator(Title$, Text$ , Flags = #Null)
  Debug "Hello from decorator!"
  MessageRequester(Title$, Text$, Flags)
EndProcedure

Macro MessageRequester(Title, Text , Flags = #Null)
  MessageRequesterDecorator(Title, Text, Flags)
EndMacro

DeclareModule MyModule
  Declare Run()
EndDeclareModule

Module MyModule
  Procedure Run()
    MessageRequester("Info", "Hello, World!")
    EndProcedure
EndModule

MyModule::Run() ; decorator not called

And the following will result in an endless loop.

Code: Select all

DeclareModule Decorator
  Declare MessageRequesterDecorator(Title$, Text$ , Flags = #Null) 
  
  Macro MessageRequester(Title, Text , Flags = #Null)
    MessageRequesterDecorator(Title, Text, Flags)
  EndMacro
EndDeclareModule

Module Decorator
  Procedure MessageRequesterDecorator(Title$, Text$ , Flags = #Null)
    Debug "Hello from decorator!"
    MessageRequester(Title$, Text$, Flags)
  EndProcedure
EndModule


DeclareModule MyModule
  Declare Run()
EndDeclareModule

Module MyModule
  UseModule Decorator
  
  Procedure Run()
    MessageRequester("Info", "Hello, World!")
  EndProcedure
EndModule

MyModule::Run() ; endless loop

If I split the Decorator into two modules, where the decorator procedure is in the first and the macro in the second it does work

Code: Select all

DeclareModule Decorator
  Declare MessageRequesterDecorator(Title$, Text$ , Flags = #Null) 
EndDeclareModule

Module Decorator
  Procedure MessageRequesterDecorator(Title$, Text$ , Flags = #Null)
    Debug "Hello from decorator!"
    MessageRequester(Title$, Text$, Flags)
  EndProcedure
EndModule

DeclareModule Override
  Macro MessageRequester(Title, Text , Flags = #Null)
    Decorator::MessageRequesterDecorator(Title, Text, Flags)
  EndMacro
EndDeclareModule

Module Override
EndModule

DeclareModule MyModule
  Declare Run()
EndDeclareModule

Module MyModule
  UseModule Override
  
  Procedure Run()
    MessageRequester("Info", "Hello, World!")
  EndProcedure
EndModule

MyModule::Run()

This is however really convoluted. Is there any other way?

Reason why I'm asking is that there are some memory leak tracking code posted on this forum that uses this override technique but without modules

https://www.purebasic.fr/english/viewtopic.php?t=39168

Simplified
https://www.purebasic.fr/english/viewtopic.php?t=56737

Modifying this code to using two modules and compiler directives everywhere is quite messy. It is easier to just call the decorator directly, but then your code will be less portable if other projects does not have the same decorator.

[tored]

Code: Select all

CompilerIf #PB_Compiler_Debugger
  
  DeclareModule MemoryTracker
    Structure MemoryAllocation
      *mem
      file.s
      line.i
    EndStructure
    
    Global NewList memoryAllocations.MemoryAllocation()
    
    Declare TrackAllocateMemory(size, flags, file.s, line.i)
    Declare TrackFreeMemory(*mem)
  EndDeclareModule
  
  Module MemoryTracker
    Procedure TrackAllocateMemory(size, flags, file.s, line.i)
      Protected *mem = AllocateMemory(size, flags)
      If *mem And AddElement(memoryAllocations())
        memoryAllocations()\mem = *mem
        memoryAllocations()\file = file
        memoryAllocations()\line = line
      EndIf
      ProcedureReturn *mem
    EndProcedure
    
    Procedure TrackFreeMemory(*mem)
      ForEach memoryAllocations()
        If memoryAllocations()\mem = *mem
          DeleteElement(memoryAllocations())
          Break
        EndIf
      Next
      FreeMemory(*mem)
    EndProcedure  
  EndModule
  
CompilerEndIf

DeclareModule Memory
  CompilerIf #PB_Compiler_Debugger
    Macro AllocateMemory(size, flags = #Null)
      MemoryTracker::TrackAllocateMemory(size, flags, #PB_Compiler_File, #PB_Compiler_Line)
    EndMacro
    
    Macro FreeMemory(mem)
      MemoryTracker::TrackFreeMemory(mem)
    EndMacro
  CompilerEndIf
  
  Declare PrintAllocations()  
EndDeclareModule

Module Memory
  Procedure PrintAllocations()
    CompilerIf #PB_Compiler_Debugger
      If ListSize(MemoryTracker::memoryAllocations())
        Debug "-[ Allocated Memory ]------"
        ForEach MemoryTracker::memoryAllocations()
          Debug "File: " + MemoryTracker::memoryAllocations()\file +  " Line: " + MemoryTracker::memoryAllocations()\line + " Memory Handle: " + MemoryTracker::memoryAllocations()\mem
        Next
        Debug "---------------------------"
      Else
        Debug "-[ No memory allocated ]-"
      EndIf
    CompilerEndIf
  EndProcedure
EndModule

DeclareModule MyModule
  Declare Run()  
EndDeclareModule

Module MyModule
  UseModule Memory
  
  Procedure Run()
    Protected *mem = AllocateMemory(100)
    Debug *mem
    *mem = AllocateMemory(200)
    FreeMemory(*mem)
  EndProcedure
EndModule


MyModule::Run()
Memory::PrintAllocations()

Kind of works, but I still need to add UseModule Memory in every module I'm allocating memory, which pretty much defats the purpose of overriding.

[Little John]

Hi,

this works. The trick is in the private macro MessageRequesterDecoratorUtility():
“MessageRequester” as default value of a macro parameter is not touched by another macro with the same name, even if the definition of that macro is before the assignment of that default value.

Code: Select all

; tested with PB 6.00 LTS on Windows

DeclareModule My
   Macro MessageRequester (_title_, _text_, _flags_=0)
      My::MessageRequesterDecorator(_title_, _text_, _flags_)
   EndMacro
   
   Declare.i MessageRequesterDecorator (title$, text$, flags.i)
EndDeclareModule   


Module My
   Macro MessageRequesterDecoratorUtility (_title_, _text_, _flags_, _command_=MessageRequester)
      _command_(_title_, _text_, _flags_)
   EndMacro
   
   Procedure.i MessageRequesterDecorator (title$, text$, flags.i)
      title$ + " - MessageRequesterDecorator()"
      ProcedureReturn MessageRequesterDecoratorUtility(title$, text$, flags)
   EndProcedure
EndModule   


; -- Demo
MessageRequester("Test 1", "Hi")

My::MessageRequester("Test 2", "Foo")

UseModule My
MessageRequester("Test 3", "Bar")

[tored]

Hi,

this works. The trick is in the private macro MessageRequesterDecoratorUtility():
“MessageRequester” as default value of a macro parameter is not touched by another macro with the same name, even if the definition of that macro is before the assignment of that default value.

Haha, nice trick! That removes the need for the extra module, great!

[tored]

Code: Select all

DeclareModule Memory
  CompilerIf #PB_Compiler_Debugger
    
    Macro AllocateMemory(size, flags = #Null)
      TrackAllocateMemory(size, flags, #PB_Compiler_File, #PB_Compiler_Line)
    EndMacro
    
    Macro ReAllocateMemory(mem, size, flags = #Null)
      TrackReAllocateMemory(mem, size, flags, #PB_Compiler_File, #PB_Compiler_Line)
    EndMacro
    
    Macro FreeMemory(mem)
      TrackFreeMemory(mem)
    EndMacro
    
    Declare TrackAllocateMemory(size.i, flags, file.s, line.i)
    Declare TrackReAllocateMemory(*mem, size.i, flags, file.s, line.i)
    Declare TrackFreeMemory(*mem)
  CompilerEndIf
  
  Declare PrintAllocations()
EndDeclareModule

Module Memory
  CompilerIf #PB_Compiler_Debugger
    Macro AllocateMemoryProxy(size, flags, proxy = AllocateMemory)
      proxy(size, flags)
    EndMacro
    
    Macro ReAllocateMemoryProxy(mem, size, flags, proxy = ReAllocateMemory)
      proxy(mem, size, flags)
    EndMacro
    
    Macro FreeMemoryProxy(mem, proxy = FreeMemory)
      proxy(mem)
    EndMacro
    
    Structure MemoryAllocation
      *mem
      size.i
      file.s
      line.i
    EndStructure
    
    Global NewList memoryAllocations.MemoryAllocation()
    
    Procedure TrackAllocateMemory(size.i, flags, file.s, line.i)
      Protected *mem = AllocateMemoryProxy(size, flags)
      If *mem And AddElement(memoryAllocations())
        memoryAllocations()\mem = *mem
        memoryAllocations()\size = size
        memoryAllocations()\file = file
        memoryAllocations()\line = line
      EndIf
      ProcedureReturn *mem
    EndProcedure
    
    Procedure TrackReAllocateMemory(*mem, size, flags, file.s, line.i)
      Protected *new
      
      *new = ReAllocateMemoryProxy(*mem, size, flags)
      If *new
        ForEach memoryAllocations()
          If memoryAllocations()\mem = *mem
            DeleteElement(memoryAllocations())
            Break
          EndIf
        Next
      EndIf  
      
      If AddElement(memoryAllocations())
        memoryAllocations()\mem = *new
        memoryAllocations()\size = size
        memoryAllocations()\file = file
        memoryAllocations()\line = line
      EndIf
      ProcedureReturn *new
    EndProcedure
    
    Procedure TrackFreeMemory(*mem)
      ForEach memoryAllocations()
        If memoryAllocations()\mem = *mem
          DeleteElement(memoryAllocations())
          Break
        EndIf
      Next
      FreeMemoryProxy(*mem)
    EndProcedure
  CompilerEndIf
  
  Procedure PrintAllocations()
    CompilerIf #PB_Compiler_Debugger
      If ListSize(memoryAllocations())
        Debug "-[ Allocated Memory ]------"
        ForEach memoryAllocations()
          Debug memoryAllocations()\file + 
                ":" + memoryAllocations()\line + 
                " Size: " + memoryAllocations()\size + 
                " Address: " + memoryAllocations()\mem
        Next
        Debug "---------------------------"
      EndIf
    CompilerEndIf
  EndProcedure
EndModule