Forum > FPC development

A Generic Inheriting a Generic in a Generic Way - 1

(1/1)

IndigoBoy83:
Hi.  I've written a bit and I may be on the wrong track completely so take what follows this with a heaping cup of salt.

___A Generic Inheriting a Generic in a Generic Way___

Hello.  I've been working on a project which I will not delve into as its details are not necessary at this moment.  What is needed to know is that I require the use of a generic class inheriting from a generic class.  This problem led me to consider the possibility of using templates.  Now, I have an idea which I call a "interjections".  It is a way of making templates elegant, easier to use and more readable.  It basically inserts code wherever the interjection is called (that's really it! :) ).  In that way, it is kind of like an inline procedure, but not really at all... 

An interjection is defined very much in the way a method is defined, e.g:


--- Code: ---Interjection AnInterjection;
start
  { ... Code goes here ... }
stop;

--- End code ---

To use this interjection in code, you'd use the following:


--- Code: ---{$Interject AnInterjection}

--- End code ---

The code within a interjection declaration should be *full* code, not snippets of code, i.e. each line should be compilable on their own (assuming that all variables are defined, there are no invalid typecasts, etc..)

I feel that the best way to describe its uses are by examples.  So here are a few:

------
#1: How hard can it get? 
   Well, we can use an interjection to insert code just like using the {$Include} directive:

------Example #1

--- Code: ---Interjection AAA;
start
  writeln( 'My name is ', name );
stop;

--- End code ---

With the above interjection AAA, I give the following two programs as examples, the first compiles, not the second:

// This program writes my name

--- Code: ---var
   name : string;
begin
  name := 'IndigoBoy83';
  {$Interject AAA}
end;

--- End code ---

// This program does not compile

--- Code: ---begin
  {$Interject AAA} // Error! since "name" has not been defined
end;
--- End code ---

------
#2: Yeah, that's baby stuff..
   Okay..  Well how 'bout using an interjection to define a type?
We can do that!:

------Example #2

--- Code: ---Interjection BBB;
start
  TIdentity = record
    name : string;
    age : integer;
  end;
stop;

--- End code ---

With the above interjection BBB, I give two snippets of code, the first compiles, not the second:

// This snippet compiles

--- Code: ---type
    {$Interject BBB}
    TPerson = object
      identity : TIdentity;
    end; 

--- End code ---

// This snippet does not compile

--- Code: ---type
    TPerson = object
      identity : TIdentity; // Error! since TIdentity has not been defined yet
    end; 
    {$Interject BBB}

--- End code ---

------
#3: Come on!  That's easy stuff..
   Okay.. Well how 'bout using an interjection on a function?
We can't do that, at least not directly.  This is a workaround!:
   
Suppose we want an interjection to return some integer after it completes.  Well, then we'd need to set up a variable *before*  the interjection as follows:

------Example #3

--- Code: ---Interjection CCC;
start
  writeln( 'How many hairs are on Indigo Boy''s head?' );
  readln( hairs );
stop;

var
   hairs : integer;
begin
  {$Interject CCC}
  writeln( 'Indigo Boy has ', hairs, ' hairs on his head!' );
end.

--- End code ---

Note:  A significant drawback to this is that *anybody* who uses the interjection CCC has to make sure hairs is a variable of the appropriate type.  (Notice that the variable "hairs" could just as well have been a string and a possibly desirable program would still result.)
------

Before we move on to something more complex, some rules to be gleaned from the above:

1) -The definition of an interjection and the interject call itself can be made at any place in a program so long as the previous character in the code is a ';' or it is at the start of a program.  And the identifier given to an interject call must be in the scope of that interjection's definition. 
2) -It is up to the programmer to make sure that no problems arise with the names of variables, types, etc., etc..
3) -The definition of an interjection should start with the word 'start' and end with 'stop;'

So, far pretty easy stuff..
Okay, well how 'bout this:

We can now replace Templates with Interjections in a desirable manner!

I got this snippet of a program from http://wiki.freepascal.org/Templates
I will rewrite it using interjections, in three drafts, each successively getting more simple and elegant.

But first, here is the original code as taken from the website, with one correction:

----START OF CODE using templates-----------------------------------
Base generic class definition: GenericList.inc:
-----

--- Code: ---{$IFDEF INTERFACE}     
  // TGList<TListIndex, TListItem> = class
  TGList = class
    Items: array[TListIndex] of TListItem;
    procedure Add(Item: TListItem);
  end;
{$UNDEF INTERFACE}
{$ENDIF}
 
{$IFDEF IMPLEMENTATION}
procedure TGList.Add(Item: TListItem);
begin
  SetLength(Items, Length(Items) + 1); 
  Items[Length(Items) - 1] := Item;
end;
{$UNDEF IMPLEMENTATION}
{$ENDIF}

--- End code ---
-----

Definition for enhanced generic class: GenericAdvancedList.inc:
-----

--- Code: ---{$IFDEF INTERFACE}     
  TListIndex = TAdvancedListIndex;
  TListItem = TAdvancedListItem;
{$DEFINE INTERFACE}     
{$INCLUDE 'GenericList.inc'}
  // TGAdvancedList<TAdvancedListIndex, TAdvancedListItem> = class(TGList)
  TGAdvancedList = class(TGList) // <- correction! the "(TGList)" was strangely ommited
    Capacity: TAdvancedListIndex;
  end;
{$UNDEF INTERFACE}
{$ENDIF}
 
{$IFDEF IMPLEMENTATION}
{$INCLUDE 'GenericList.inc'}
{$UNDEF IMPLEMENTATION}
{$ENDIF}

--- End code ---
-----

Now some specialization example: AdvancedListInteger.pas:
-----

--- Code: ---unit AdvancedListInteger;
 
interface
 
uses
  Classes;
 
type
  TAdvancedListIndex = Integer; // specified to some exact type
  TAdvancedListItem = Integer; // specified to some exact type
{$DEFINE INTERFACE}
{$INCLUDE 'GenericAdvancedList.inc'}
 
type
  // TAdvancedListInteger<Integer, Integer> = class(TGAdvancedList)
  TAdvancedListInteger = class(TGAdvancedList)
    // Additional fields and methods can be added here
  end;
 
implementation
 
{$DEFINE IMPLEMENTATION}
{$INCLUDE 'GenericAdvancedList.inc'}
 
end.

--- End code ---
----END OF CODE using templates-------------------------------------------

Now, to rewrite the above in a simpler and more intuitive form using interjections, we must also use macros.  In fact, we are going to have to change how macros work a bit because how it is right now creates a problem.  The problem occurs with recursive statements; we don't want them.

Right now macros work using the following rules, which was taken out of the Free Pascal Programmer's Guide: (http://www.freepascal.org/docs-html/prog/progse5.html#x138-1390002.2)


--- Code: ---{$define sum:=a:=a+b;} 
... 
sum          { will be expanded to ’a:=a+b;’ 
               remark the absence of the semicolon} 
... 
{$define b:=sum} { DON’T do this !!!} 
sum          { Will be infinitely recursively expanded... } 
...

--- End code ---

For our purposes, each "word" that we use on both sides of the equal sign will be identifiers.  So, we would like it if an identifier will replace another identifier only so long as it replaces the *whole* identifier.  So, we will make use of a new directive, named the "$extdef" directive, which defines a new type of macros: "extended macros".  It will act similar to the "$define" directive but we will make both sides of the := sign in a "$extdef" directive using string-quotes, for a reason that we will required later on.  Also, it won't be subject to be recursive, rather, it will go through all extmacros in LIFO order.

So the above code should be written as:


--- Code: ---{$extdef 'sum' := 'a:=a+b;'} 
... 
sum          { will be expanded to ’a:=a+b;’ 
               remark the absence of the semicolon} 
... 
{$extdef 'b' := 'sum'} { yep.. do this all you like !!!} 
sum             { Will be expanded to 'a:=a+b' and will NOT be expanded recursively } 
...

--- End code ---

Here's my first draft of the code:

----START OF CODE first draft-----------------------------------------

--- Code: ---{ In this unit we will construct the classes: TGList, TGAdvancedList, TAdvancedListInteger }

unit AdvancedListInteger;
 
interface
 
uses
  Classes;
 
type

Interjection TGList_interface;
start
  // TGList<TListIndex, TListItem> = class
  TGList = class
    Items: array[TListIndex] of TListItem;
    procedure Add(Item: TListItem);
  end;
stop;

Interjection TGAdvancedList_interface;
start
  // TGAdvancedList<TAdvancedListIndex, TAdvancedListItem> = class(TGList)
  TGAdvancedList = class(TGList)
    Capacity: TAdvancedListIndex;
  end;
stop;

Interjection TAdvancedListInteger_interface;
start
  // TAdvancedListInteger<Integer, Integer> = class(TGAdvancedList)
  TAdvancedListInteger = class(TGAdvancedList)
    // Additional fields and methods can be added here
  end;
stop;

{$extdef 'TAdvancedListIndex' := 'Integer'}  // specified to some exact type
{$extdef 'TAdvancedListItem' := 'Integer'}  // specified to some exact type
{$extdef 'TListIndex' := 'TAdvancedListIndex'}
{$extdef 'TListItem' := 'TAdvancedListItem'} 
  {$Interject TGList_interface}
  {$Interject TGAdvancedList_interface}
  {$Interject TAdvancedListInteger_interface}
{$unextdef 'TAdvancedListIndex'} 
{$unextdef 'TAdvancedListItem'} 
{$unextdef 'TListIndex'}
{$unextdef 'TListItem'}

implementation

Interjection TGList_implementation;
start
  procedure TGList.Add(Item: TListItem);
  begin
    SetLength(Items, Length(Items) + 1); 
    Items[Length(Items) - 1] := Item;
  end;
stop;

Interjection TAdvancedListInteger_implementation;
start
  // Additional fields and methods can be added here
stop;

{$extdef 'TAdvancedListIndex' := 'Integer'}  // specified to some exact type
{$extdef 'TAdvancedListItem' := 'Integer'}  // specified to some exact type
{$extdef 'TListIndex' := 'TAdvancedListIndex'}
{$extdef 'TListItem' := 'TAdvancedListItem'} 
  {$Interject TGList_implementation}
  {$Interject TAdvancedListInteger_implementation}
{$unextdef 'TAdvancedListIndex'} 
{$unextdef 'TAdvancedListItem'} 
{$unextdef 'TListIndex'}
{$unextdef 'TListItem'}

end.

--- End code ---
----END OF CODE first draft----------------------------------------

The above first draft already is looking simpler than using templates.  The following code generalizes the above.  But instead of making just TAdvancedListInteger we will also make TAdvancedListString.

----START OF CODE second draft-----------------------------------------

--- Code: ---{ In this unit we will construct the classes:
  TAdvancedListExtendedInteger,  TAdvancedListInteger, TListInteger
and
  TAdvancedListExtendedString, TAdvancedListString, TListString }

unit AdvancedLists;
 
interface
 
uses
  Classes;
 
type

Interjection TGList_interface;
start
  // TGList<TListIndex, TListItem> = class
  TGList = class
    Items: array[TListIndex] of TListItem;
    procedure Add(Item: TListItem);
  end;
stop;

Interjection TGAdvancedList_interface;
start
  // TGAdvancedList<TAdvancedListIndex, TAdvancedListItem> = class(TGList)
  TGAdvancedList = class(TGlist)
    Capacity: TAdvancedListIndex;
  end;
stop;

Interjection TGAdvancedListExtended_interface;
start
  // TAdvancedListExtended<TAdvancedListIndex, TAdvancedListItem> = class
  TAdvancedListExtended = class(TGAdvancedList)
    // Additional fields and methods can be added here
  end;
stop;

Interjection Interface_Code;
start
  {$extdef 'TListIndex' := 'TAdvancedListIndex'}
  {$extdef 'TListItem' := 'TAdvancedListItem'} 
    {$Interject TGList_interface}
    {$Interject TGAdvancedList_interface}
    {$Interject TGAdvancedListExtended_interface}
  {$unextdef 'TListIndex'}
  {$unextdef 'TListItem'}
stop.

  {$extdef 'TAdvancedListIndex' := 'Integer'}  // specified to some exact type
  {$extdef 'TAdvancedListItem' := 'Integer'}  // specified to some exact type
  {$extdef 'TGList' := 'TListInteger'}
  {$extdef 'TGAdvancedList' := 'TAdvancedListInteger'}
  {$extdef 'TGAdvancedListExtended' := 'TAdvancedListExtendedInteger'}
    {Interject Interface_Code}
  {$unextdef 'TAdvancedListIndex'} 
  {$unextdef 'TAdvancedListItem'} 
  {$unextdef 'TGList'}
  {$unextdef 'TGAdvancedListExtended'}

  {$extdef 'TAdvancedListIndex' := 'Byte'}  // specified to some exact type
  {$extdef 'TAdvancedListItem' := 'String'}  // specified to some exact type
  {$extdef 'TGList' := 'TListString'}
  {$extdef 'TGAdvancedList' := 'TAdvancedListString'}
  {$extdef 'TGAdvancedListExtended' := 'TAdvancedListExtendedString'}
    {Interject Interface_Code}
  {$unextdef 'TAdvancedListIndex'} 
  {$unextdef 'TAdvancedListItem'} 
  {$unextdef 'TGList'}
  {$unextdef 'TGAdvancedListExtended'}

implementation

Interjection TGList_implementation;
start
  procedure TGList.Add(Item: TListItem);
  begin
    SetLength(Items, Length(Items) + 1); 
    Items[Length(Items) - 1] := Item;
  end;
stop;

Interjection TGAdvancedListExtended_implementation;
start
  // Methods of TGAdvancedListExtended
  // common to TAdvancedListExtendedInteger and TAdvancedListExtendedString
  // go here
stop;

Interjection Implementation_Code;
start
  {$extdef 'TListIndex' := 'TAdvancedListIndex'}
  {$extdef 'TListItem' := 'TAdvancedListItem'} 
    {$Interject TGList_implementation}
    {$Interject TGAdvancedListExtended_implementation}
  {$unextdef 'TListIndex'}
  {$unextdef 'TListItem'}
stop;

  {$extdef 'TAdvancedListIndex' := 'Integer'}  // specified to some exact type
  {$extdef 'TAdvancedListItem' := 'Integer'}  // specified to some exact type
  {$extdef 'TGList' := 'TListInteger'}
  {$extdef 'TGAdvancedListExtended' := 'TAdvancedListExtendedInteger'}
    {Interject Implementation_Code}
  {$unextdef 'TAdvancedListIndex'}
  {$unextdef 'TAdvancedListItem'}
  {$unextdef 'TGList'}
  {$unextdef 'TGAdvancedListExtended'}

  {$extdef 'TAdvancedListIndex' := 'Byte'}  // specified to some exact type
  {$extdef 'TAdvancedListItem' := 'String'}  // specified to some exact type
  {$extdef 'TGList' := 'TListString'}
  {$extdef 'TGAdvancedListExtended' := 'TAdvancedListExtendedString'}
    {Interject Implementation_Code}
  {$unextdef 'TAdvancedListIndex'}
  {$unextdef 'TAdvancedListItem'}
  {$unextdef 'TGList'}
  {$unextdef 'TGAdvancedListExtended'}

end.

--- End code ---
----END OF CODE second draft---------------------------------------

But now I introduce another twist; I am going to allow an interjection to have a parameter list!  This greatly simplifies and beautifies everything! 

In general, this parameter list can be *anything* that can be determined at compile-time. 

Below, we are going to send types (as pointers) to an interjection and we will need to invent a new method call "NameThatType" which can be executed at compile-time and returns a string to represent that type.  It is in this that we will then see the benefit from having both sides of the := in a "$extdef" directive to use quotations '', because then we can use string concatenation!

Again, I will explain by example.  Here is the above program in simpler form, and without unnecessary comments and duplication of terms.

----START OF CODE third draft------------------------------------------

--- Code: ---{ In this unit we will construct the classes:
  TAdvancedListExtendedInteger,  TAdvancedListInteger, TListInteger
and
  TAdvancedListExtendedString, TAdvancedListString, TListString }

unit AdvancedLists;
 
interface
 
uses
  Classes;
 
type

Interjection TGList_interface;
start
  TGList = class
    Items: array[TListIndex] of TListItem;
    procedure Add(Item: TListItem);
  end;
stop;

Interjection TGAdvancedList_interface;
start
  TGAdvancedList = class(TGList)
    Capacity: TAdvancedListIndex;
    // Additional fields and methods can be added here
  end;
stop;

Interjection TGAdvancedListExtended_interface;
start
  TAdvancedListExtended = class(TGAdvancedList)
    // Additional fields and methods can be added here
  end;
stop;

Interjection Interface_Code( TypePtr1, TypePtr2 : pointer );
start
  {$extdef 'TListIndex := NameThatType(TypePtr1)}
  {$extdef 'TListItem := NameThatType(TypePtr2)} 
  {$extdef 'TGList' := 'TList' + NameThatType(TypePtr2)}
  {$extdef 'TGAdvancedList' := 'TAdvancedList' + NameThatType(TypePtr2)}
  {$extdef 'TGAdvancedListExtended' := 'TAdvancedListExtended' + NameThatType(TypePtr2)}
    {$Interject TGList_interface}
    {$Interject TGAdvancedList_interface}
    {$Interject TGAdvancedListExtended_interface}
  {$unextdef 'TListIndex'}
  {$unextdef 'TListItem'}
  {$unextdef 'TGList'}
  {$unextdef 'TGAdvancedList'}
  {$unextdef 'TGAdvancedListExtended'}
stop;

  {$Interject Interface_Code( integer, integer )}
  {$Interject Interface_Code( byte, string )}

implementation

Interjection TGList_implementation;
start
  procedure TGList.Add(Item: TListItem);
  begin
    SetLength(Items, Length(Items) + 1); 
    Items[Length(Items) - 1] := Item;
  end;
stop;

Interjection TGAdvancedList_implementation;
start
    // Additional methods can be defined here
stop;

Interjection TGAdvancedListExtended_implementation;
start
  // Methods of TGAdvancedListExtended
  // common to TAdvancedListExtendedInteger and TAdvancedListExtendedString
  // go here
stop;

Interjection Implementation_Code( TypePtr1, TypePtr2 : pointer );
start
  {$extdef 'TListIndex' := NameThatType(TypePtr1)}
  {$extdef 'TListItem' := NameThatType(TypePtr2)} 
  {$extdef 'TGList' := 'TGList' + NameThatType(TypePtr2)}
  {$extdef 'TGAdvancedList' := 'TAdvancedList' + NameThatType(TypePtr2)}
  {$extdef 'TGAdvancedListExtended' := 'TAdvancedListExtended' + NameThatType(TypePtr2)}
    {$Interject TGList_implementation}
    {$Interject TGAdvancedList_implementation}
    {$Interject TGAdvancedListExtended_implementation };
  {$unextdef 'TListIndex'}
  {$unextdef 'TListItem'}
  {$unextdef 'TGList'}
  {$unextdef 'TGAdvancedList'}
  {$unextdef 'TGAdvancedListExtended'}
stop;

  {$Interject Implementation_Code( integer, integer )}
  {$Interject Implementation_Code( byte, string )}

end.

--- End code ---
----END OF CODE third draft------------------------------------------

Note: The generics TGList, TGAdvancedList and TGAdvancedListExtended do not exist as final types.  I suggest we adopt this as a general convention when using interjections, that is, a type with a name starting "TG" should *never* exist as an actual type, rather, it is used as a "placeholder" to hold the name of the type.

Also note: there is kind of no point to right now having both TGAdvancedList and TGAdvancedListExtended except that it mimics the same "pattern" as the original template program was coded.  At this point, one can merge the two TGAdvancedList and TGAdvancedListExtended and lose nothing and gain simplicity.

One thing about the parameter list in the interjections Interface_Code and Implementation_Code:  I don't exactly know technically how to pass a type as a pointer in a parameter and then from that parameter get a type.  I leave the details to the avid reader.

- I'M ABOVE 20000 CHARS! - I'M GOING TO HAVE TO CUT THIS MESSAGE SO IT POSTS! -  STAY TUNED -

marcov:
Well, I can summarize it much shorter:  You rename macros to interjection, change the declaration from preprocessor to normal parser, but keep calling them in the preprocessor (very weird, and logically parser wise).

This is strange because the preprocessor {$ xxx} runs before the normal parser that would be able to parse your interjection.

(that being said, IMHO standarized macro functionality is not really desired, since it will only lead to abuse)

Leledumbo:
Looks like pre-real generics somewhere 8-10 years ago. IMO, it's a hack, and thus ugly. And yes, as marco said, it looks like an attempt to implement a full fledged macros, which is easily abused to lead to hard-to-debug-even-at-compile-time code.

Navigation

[0] Message Index

Go to full version