Pointer Stack

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Pointer Stack

Post by sancho3 »

Here is a very small pointer stack. Only push and pop methods. Only pointer to last item and previous item.
There is no item counter and no bounds check so it will crater if you pop once too many. This is deliberate decision.
This stack is only used if you know the amount of items you are stacking.
This code is enclosed in a macro to allow any kind of pointers to be stacked.
There is some sample code at the end. I will post a reply with code that is more 'real world' as a reply.

Code: Select all

#Macro __Make_pStack__(V, T)

#Ifndef __null__
	#Define __null__ 0
#EndIf 

Type V			' note the lack of a next_item ptr   
	As T Ptr item
	As V Ptr prev_item, last_item
	Declare Sub push(ByVal pm As T Ptr)
	Declare Function pop() As T Ptr
	Declare Destructor     
End Type
Destructor V()
	'
	Dim As V Ptr p = this.last_item
	While p <> __null__ 
		Dim As V Ptr temp = p 
		p = p->prev_item
		Delete temp 
		temp = 0
	Wend 
End Destructor
'---------------------------------------------------------
Sub V.push(ByVal mi As T ptr)
	'
	Dim As V Ptr ptemp = this.last_item  
	this.last_item = New V
	this.last_item->item = mi				' store the item
	this.last_item->prev_item = pTemp		' point the new last item->prev item to the old last item
End Sub
Function  V.pop() As T Ptr 
	'
	Dim As V Ptr p = this.last_item
	If p = __null__ Then Return __null__ 
	this.last_item = p->prev_item
	Function = p->item
	Delete p
	p = 0
End Function  

#EndMacro 
'-------------------------------------
' example code 
Dim As Integer a=12, b=13, c=14,d=15, e=16

__Make_pStack__(TIntStack, Integer)
Dim As TIntStack mystack 
mystack.push(@a)
mystack.push(@b)
mystack.push(@c)
mystack.push(@d)
mystack.push(@e)
For x As Integer = 1 To 5
	? "x: "; x, *(mystack.pop())
Next
 
Sleep 
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: Pointer Stack

Post by sancho3 »

There are two examples of using the stack here. They both build a deck of cards and print them out. __Make_pStack__ is used to create the type TStack.
The first example creates a TStack variable and loads it with cards and prints them out.
The second example create a Type called TDeck that extends TStack. In the default constructor it loads the deck.
It then prints it out again.

Code: Select all

#Include Once "./Stack/PStack.bas"
#macro _sleep( args... )
    While InKey() <> "" : Wend
    Sleep args
#endmacro

type TCard
	Public: 
		Dim as Ubyte _value 
		Dim as Ubyte _suit
		Declare Property suit() As String 
		Declare Property value() As String 
		Declare Operator Cast () As String	
		Declare Constructor
		Declare Constructor(Byval card_value As Ubyte,  Byval card_suit As Ubyte)
end Type
Constructor TCard():End Constructor
Constructor TCard(Byval card_value As Ubyte,  Byval card_suit_index As Ubyte)
	'
	this._value = card_value: this._suit = card_suit_index
End Constructor
Property TCard.value() As String 
	 If this._value = 1 Then Return "A"
	 If this._value < 11 Then Return Str(this._value)
	 Return mid("JQK", this._value - 10,1) 
End Property

Property TCard.suit() As String 
	'                              
	Dim As String s = "Clubs   DiamondsHearts  Spades  "
	Return Trim(Mid(s, ((this._suit-1)*8) + 1, 8)	)
End Property

Operator TCard.Cast() As String 
	'
	return Str(this.value) & " " & ">" &  this.suit & "<"
End Operator


__Make_pStack__(TStack, TCard)

''========================================
' example A - declares a variable of the newly create TStack type
''========================================
? "Example A "
dim As TStack deckA

For s As Integer = 1 To 4
	For v as Integer = 1 To 13
		deckA.push(New TCard(v,s))
	Next
Next

Scope 
Dim As Integer col = 1, row = 1
For x As Integer = 1 To 52 
	Dim As TCard Ptr card = deckA.pop()
	Locate row+2,col: ? *card
	row +=1 
	If row = 14 Then  col += 20: row = 1
	Delete card  
Next
End Scope 

_sleep()
Cls 
''========================================
' example B - declares a type that extends the stack type 
''========================================
?"Example B"
Type TDeck Extends TStack
	Declare Function deal_a_card() As TCard 
	Declare Constructor 
End Type
Constructor TDeck()
	For s As Integer = 1 To 4
		For v as Integer = 1 To 13
			this.push(New TCard(v,s))
		Next
	Next
End Constructor
Function TDeck.deal_a_card() As TCard
	'
	Dim As TCard Ptr c = this.pop()
	Function = *c
	Delete c
End Function

Dim As TDeck deckB 

Dim As Integer col = 1, row = 1
For x As Integer = 1 To 52 
	Dim As TCard card = deckB.deal_a_card()
	Locate row+2,col: ? card
	row +=1 
	If row = 14 Then  col += 20: row = 1
Next

_sleep()

paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Pointer Stack

Post by paul doe »

Very nice. I also favor the 'fully abstract data structures' approach. However, I tend to prefer decoration over templates (especially since in FB you can't do proper templating):

Code: Select all

/'
   Simple Stack
   
   This will be the base object to decorate
'/
type Stack extends Object
   public:
      declare constructor( byval as uinteger = 256 )
      declare destructor()
      
      declare sub push( byval as any ptr )
      declare function pop() as any ptr
      
      declare property count() as uinteger
      declare property size() as uinteger
      
   protected:
      declare constructor()
      declare constructor( byref as Stack )
      declare operator let( byref as Stack )
      
   private:
      m_items( any )   as any ptr
      m_size               as uinteger
      m_count               as uinteger
end type

constructor Stack( byval pSize as uinteger = 256 )
   ? "Stack::Stack()"
   m_size = iif( pSize < 1, 1, pSize )
   m_count = 0
   
   redim m_items( 0 to m_size - 1 )
end constructor

destructor Stack()
   ? "Stack::~Stack()"
end destructor

sub Stack.push( byval value as any ptr )
   if( m_count < m_size - 1 ) then
      m_count += 1
      
      m_items( m_count - 1 ) = value
   else
      '' Handle stack overflow
   end if
end sub

function Stack.pop() as any ptr
   if( m_count > 0 ) then
      dim as any ptr ret = m_items( m_count - 1 )
      
      m_count -= 1

      return( ret )
   else
      '' Handle stack underflow
   end if
end function

property Stack.count() as uinteger
   return( m_count )
end property

property Stack.size() as uinteger
   return( m_size )
end property

/'
   This is a decorator class for the Stack
   
   It accepts a single argument in its constructor, another
   object to decorate (change or augment it's functionality).
   In this case, since FB doesn't allow to overload a function's
   based only on it's return parameter, this can be a cool
   alternative.
   
   Decorator classes modify the run-time behavior of an object, and
   add/remove some functionality from the decorated class. In this
   case, all it does is decoration of a Stack instance to push() and
   pop() only integers.
'/
type DecoratedStack extends Object
   public:
      declare constructor( byval as Stack ptr )
      declare destructor()
      
      declare sub push( byval as integer )
      declare function pop() as integer
      
      declare property size() as uinteger
      declare property count() as uinteger
   
   protected:
      declare constructor( byref as DecoratedStack )
      declare operator let( byref as DecoratedStack )
      
   private:
      m_instance      as Stack ptr
end type

constructor DecoratedStack( byval instance as Stack ptr )
   ? "DecoratedStack::DecoratedStack()"
   
   m_instance = instance
end constructor

destructor DecoratedStack()
   ? "DecoratedStack::~DecoratedStack()"   
end destructor

sub DecoratedStack.push( byval value as integer )
   dim as integer ptr i = new integer
   
   *i = value
   
   m_instance->push( i )
end sub

function DecoratedStack.pop() as integer
   dim as integer ptr p = m_instance->pop()
   dim as integer i = *p
   
   '' Dispose of the pointer here
   delete( p )
   
   return( i )
end function

property DecoratedStack.count() as uinteger
   return( m_instance->count )
end property

property DecoratedStack.size() as uinteger
   return( m_instance->size )
end property

/'
   Main program
   
   Creates a Stack object and then decorates it with another
   object called DecoratedStack. In this example, all it does
   is storing and retrieving integers from the pointer stack,
   but of course all kinds of complex functionality can be
   implemented in the decorator.
'/
dim as Stack ptr myStack = new Stack( 10 )

dim as DecoratedStack ptr myDecoratedStack = _
   new DecoratedStack( myStack )

myDecoratedStack->push( 3 )
myDecoratedStack->push( 5 )
myDecoratedStack->push( 8 )

?
? myDecoratedStack->pop()
? myDecoratedStack->pop()
? myDecoratedStack->pop()
?
/'
   Note that the unhandled dereference in DecoratedStack.pop() will
   cause the app to crash on overflows and underflows.
   This may or may not be the desired behavior, so if you want the
   app to fail gracefully, handle them.

   ? myDecoratedStack->pop() <-- this will crash
'/

/'
   Normally, decorating classes don't delete the objects they
   decorate, as they're only meant to provide ad-hoc functionality.   
   So, you need to manually delete the decorated object.
'/
delete( myDecoratedStack )
delete( myStack )

sleep()
sancho3
Posts: 358
Joined: Sep 30, 2017 3:22

Re: Pointer Stack

Post by sancho3 »

That decorator type would work with either of our stacks.
I stayed away from any ptrs. thinking that the user would have to cast them to their original type, but that does not appear to be the case in your code.
I just test my stack using any ptrs and indeed it does need casting.

The one thing though is if the stack is not emptied, and the decorator goes out of scope, then your decorator leaks the memory of those items left.
Don't you think you should loop through the remaining items and pop them in the decorator.destructor?
Neither the stack nor the decorator should free memory that they don't create, but they should free that which they do.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Pointer Stack

Post by paul doe »

sancho3 wrote:That decorator type would work with either of our stacks.
Indeed, but they should both derive from another intermediate class (called an interface) that declares the relevant methods (push() and pop() in this case) as abstract. Like this:

Code: Select all

type IStack extends Object
	declare abstract sub push( byval as any ptr )
	declare abstract function pop() as any ptr
	declare abstract property count() as uinteger
end type

Type SanchoStack extends IStack   
   As any Ptr item
   As SanchoStack Ptr prev_item, last_item
   Declare Sub push(ByVal pm As any Ptr) override
   Declare Function pop() As any Ptr override
   declare property count() as uinteger override
   
   Declare Destructor
   
	private:
		m_count		as uinteger     
End Type

Destructor SanchoStack()
   '
   Dim As SanchoStack Ptr p = this.last_item
   While p <> 0
      Dim As SanchoStack Ptr temp = p
      p = p->prev_item
      Delete temp
      temp = 0
   Wend
End Destructor
'---------------------------------------------------------
property SanchoStack.count() as uinteger
	return( m_count )
end property

Sub SanchoStack.push(ByVal mi As any ptr)
   '
   ? "Now pushing to Sancho's Stack"
   Dim As SanchoStack Ptr ptemp = this.last_item 
   this.last_item = New SanchoStack
   this.last_item->item = mi            ' store the item
   this.last_item->prev_item = pTemp      ' point the new last item->prev item to the old last item
   
   m_count += 1
End Sub
Function  SanchoStack.pop() As any Ptr
   '
   ? "Now poping from Sancho's Stack"
   Dim As SanchoStack Ptr p = this.last_item
   If p = 0 Then Return 0
   this.last_item = p->prev_item
   Function = p->item
   Delete p
   p = 0
   
   m_count -= 1
End Function 

/'
	Simple Stack
	
	This will be the base object to decorate
'/
type Stack extends IStack
	public:
		declare constructor( byval as uinteger = 256 )
		declare destructor()
		
		declare sub push( byval as any ptr ) override
		declare function pop() as any ptr override
		
		declare property count() as uinteger override
		declare property size() as uinteger
		
	protected:
		declare constructor()
		declare constructor( byref as Stack )
		declare operator let( byref as Stack )
		
	private:
		m_items( any )	as any ptr
		m_size					as uinteger
		m_count					as uinteger
end type

constructor Stack( byval pSize as uinteger = 256 )
	? "Stack::Stack()"
	m_size = iif( pSize < 1, 1, pSize )
	m_count = 0
	
	redim m_items( 0 to m_size - 1 )
end constructor

destructor Stack()
	? "Stack::~Stack()"
	
end destructor

sub Stack.push( byval value as any ptr )
  ? "Now pushing to Paul's Stack"
	if( m_count < m_size - 1 ) then
		m_count += 1
		
		m_items( m_count - 1 ) = value
	else
		'' Handle stack overflow
	end if
end sub

function Stack.pop() as any ptr
  ? "Now poping from Paul's Stack"
	if( m_count > 0 ) then
		dim as any ptr ret = m_items( m_count - 1 )
		
		m_count -= 1

		return( ret )
	else
		'' Handle stack underflow
	end if
end function

property Stack.count() as uinteger
	return( m_count )
end property

property Stack.size() as uinteger
	return( m_size )
end property

/'
	This is a decorator class for the Stack
	
	It accepts a single argument in its constructor, another
	object to decorate (change or augment it's functionality).
	In this case, since FB doesn'any allow to overload a function's
	based only on it's return parameter, this can be a cool
	alternative.
	
	Decorator class modify the run-time behavior of an object, and
	add/remove some functionality from the decorated class. In this
	case, all it does is decorate a Stack instance to push() and
	pop() only integers.
'/
type DecoratedStack extends Object
	public:
		declare constructor( byval as IStack ptr )
		declare destructor()
		
		declare sub push( byval as integer )
		declare function pop() as integer		
		declare property count() as uinteger
	
		declare property stack( byval as IStack ptr )
		
	protected:
		declare constructor( byref as DecoratedStack )
		declare operator let( byref as DecoratedStack )
		
	private:
		m_instance		as IStack ptr
end type

constructor DecoratedStack( byval instance as IStack ptr )
	? "DecoratedStack::DecoratedStack()"
	
	m_instance = instance
end constructor

destructor DecoratedStack()
	? "DecoratedStack::~DecoratedStack()"	
end destructor

property DecoratedStack.stack( byval instance as IStack ptr )
	m_instance = instance
end property

sub DecoratedStack.push( byval value as integer )
	dim as integer ptr i = new integer
	
	*i = value
	
	m_instance->push( i )
end sub

function DecoratedStack.pop() as integer
	dim as integer ptr p = m_instance->pop()
	dim as integer i = *p
	
	'' Dispose of the pointer here
	delete( p )
	
	return( i )
end function

property DecoratedStack.count() as uinteger
	return( m_instance->count )
end property

/'
	Main program
	
	Creates a Stack object and then decorates it with another
	object called DecoratedStack. In this example, all it does
	is storing and retrieving integers from the pointer stack,
	but of course all kinds of complex functionality can be
	implemented in the decorator.
'/
dim as Stack ptr myStack = new Stack( 10 )
dim as SanchoStack ptr otherStack = new SanchoStack()
 
dim as DecoratedStack ptr myDecoratedStack = _
	new DecoratedStack( myStack ) 

?
myDecoratedStack->push( 3 )
myDecoratedStack->push( 5 )
myDecoratedStack->push( 8 )

?
myDecoratedStack->stack = otherStack

myDecoratedStack->push( 9 )
myDecoratedStack->push( 4 )
myDecoratedStack->push( 2 )

?
? myDecoratedStack->pop()
? myDecoratedStack->pop()
? myDecoratedStack->pop()
?

myDecoratedStack->stack = myStack
? myDecoratedStack->pop()
? myDecoratedStack->pop()
? myDecoratedStack->pop()
?

/'
	Note that the unhandled dereference in DecoratedStack.pop() will
	cause the app to crash on overflows and underflows.
	This may or may not be the desired behavior, so if you want the
	app to fail gracefully, handle them.

	? myDecoratedStack->pop() <-- this will crash
'/

/'
	Normally, decorating classes don'any delete the objects they
	decorate, as they're only meant to provide ad-hoc functionality.	
	So, you need to manually delete the decorated object.
'/
delete( myDecoratedStack )
delete( otherStack )
delete( myStack )

sleep()
In this code, you can see that the decorator uses the IStack interface to use both implementations of the stack transparently.
sancho3 wrote:I stayed away from any ptrs. thinking that the user would have to cast them to their original type, but that does not appear to be the case in your code. I just test my stack using any ptrs and indeed it does need casting.
Yes, of course, you need to cast an any ptr to be able to dereference it. But, have a closer look inside the push() method of the decorator:

Code: Select all

sub DecoratedStack.push( byval value as integer )
	dim as integer ptr i = new integer
	
	*i = value
	
	m_instance->push( i )
end sub
The IStack interface expects a pointer, so while the decorated stack accepts an integer, inside we create an integer ptr, assign it the value passed through push(), and push it to the underlying stack implementation (whichever it is).
sancho3 wrote:The one thing though is if the stack is not emptied, and the decorator goes out of scope, then your decorator leaks the memory of those items left.
No. The decorator only maintains a pointer to an interface, so it doesn't need to deallocate anything. If you do, you'll destroy the decorated object, and that is not always the desired result. Look at the code example to see what I mean.
sancho3 wrote:Don't you think you should loop through the remaining items and pop them in the decorator.destructor?
Neither the stack nor the decorator should free memory that they don't create, but they should free that which they do.
Yes, that's why I provided a 'count' method in my implementation. However, the example code doesn't need to, because poping from the stack through the decorator deletes it (but return the value it contained to the caller). If we were to do this with the bare stack implementation, we should first cast it to a datatype to be able to delete it. Look:

Code: Select all

function DecoratedStack.pop() as integer
	dim as integer ptr p = m_instance->pop()
	dim as integer i = *p
	
	'' Dispose of the pointer here
	delete( p )
	
	return( i )
end function
So you see, no leak, as long as you pop through the decorator. Should you want to delete remaining items in the stack, you can do it like this:

Code: Select all

myDecoratedStack->stack = myStack '' Switch to my implementation of the stack

do while myDecoratedStack->count > 0
	myDecoratedStack->pop()
loop
In the example is not necessary, since the stack remains empty. But it's a good point nonetheless.

You can of course raise a runtime error when popping, but that's also easy to avoid, and I intentionally left it untouched. Look at my implementation of the stack, it does indeed check for underflows and overflows. The decorator doesn't, it provides different functionality. In this particular case, wrapping the IStack interface (that accepts any ptrs) into one that accepts integers. If you want to implement this in the decorator, simply check against a null pointer, and don't do anything if there's no pointer returned.

Bottom line: the responsibility for memory deallocation is a question of convention (and of course, usability issues). Since I segregate data from the data structures that act on it, there's another object that takes care of the deallocation of data, just not the data structures. Think of an object that only contains data (or collections of it) that other data structures manipulate in a way similar to what's shown here. That way, data is immutable, whereas data structures are not. And also, you can use the same data with the data structure that you deem the most convenient, at any time, without the need to move data in any way, you just work with pointers to that data.

This is a very flexible and powerful concept, that you'll find very useful, but one does need time to get accustomed to it.
Post Reply