Writing better TTreeView code

RAD (rapid application development) has its bright side as well as a dark side. The bright side is that you can assemble and construct the architecture of a program very quickly using components — the dark side is that, over time, RAD programmers tend to lose sight of more direct and elegant approaches.

TTreeView component

A component that is very much miss-treated by RAD is good old TTreeView. Under vanilla Delphi TTreeView is just a wrapper around the built-in Windows component of the same name, available to all languages who chose to use it. But for some reason people tend to avoid almost 50% of its functionality – opting only for adding nodes, setting image-indexes manually, and using the data property to store a pointer to a record.

While this is all fine and dandy, it does little to help you write clean, object-oriented and maintainable code. I have worked with a ton of codebases over the years, and one of the common clutters you find in all of them – is code to populate, update, search and initialize TTreeView controls.

People use lists to keep track of thumbnail images (glyphs) for TTreeView, they stuff code for that into functions, they spread everything over a gazillion units –before they top it all off with a custom undocumented record pointer in the data property.

A better way

Instead of having X number of methods spread about the main-form, with loads of event handling hooks, typecasts and the spaghetti we are all to acustomed to — why not approach TTreeView like C# does it? With a controller class and proper node classes?

NodeJS designer uses TTreeView as explained

“Wow, that sounds like a lot of coding” I hear you think, but it’s actually not. It’s minimalistic, easy to use, easy to expand and best of all – child’s play to maintain. If you work in a company where more than one person is in contact with your code, or odds are that a new employee will sooner or later maintain your codebase, then doing it like this is a god send. It will save you all so much time, especially when training new staff members.

So what would this look like? Well here is a small example from my upcoming NodeJS service designer:

type

  (* Base TTreeView node class *)
  TInfoNode = Class(TTreeNode)
  private
    FModel:   TNSObject;
  protected
    property  Data;
  public
    property  ModelObject:TNSObject read FModel write FModel;
  end;

  (* Folder TTreeView class *)
  TInfoNodeFolder = Class(TInfoNode)
  public
    constructor Create(AOwner: TTreeNodes); override;
  end;

  TInfoNodeType = Class of TInfoNode; 

  (* Node controller, we pertain to this and it takes
     care of the rest *)
  TInfoNodeController = Class(TObject)
  private
    FParent:    TTreeView;
    FToCreate:  TInfoNodeType;
  protected
    procedure   HandleGetNodeClass(Sender: TCustomTreeView;
                var NodeClass: TTreeNodeClass);virtual;
  public
    Property    Parent:TTreeView read FParent;

    function    AddFolderTo(aParent:TTreeNode;
                Caption:String):TInfoNodeFolder;overload;

    function    AddFolderTo(aParent:TTreeNode;Caption:String;
                aModelObject:TNSObject):TInfoNodeFolder;overload;

    Constructor Create(aList:TTreeView);virtual;
    Destructor  Destroy;Override;
  end;

As you can see, rather than stuffing a record of information into the data property, or defining an enum of various node-types that I assign to each node — I am in fact creating full custom nodes. This allows me to customize each and every node type that my treeview will display.

In my case it will display a project node, which contains X number of service nodes, which in turn contains X number of method nodes. Each node also has a reference to it’s internal object (the object the node actually represents). Rather than stuffing this in a record, like most people do, It’s simply exposed as a normal property, called “ModelObject”.

So everything that has to do with nodes, including the image-index and selected-index properties, are handled and set by the node-class itself, rather than having some large-list of image index numbers you have to keep track of.

If someone wants to alter the glyphs used for a treeview node class, they simply locate the class and alter the numbers in the constructor. Easy, efficient and straight to the point.

The code

This is where things get interesting. Did you know that TTreeView has a special event called “OnCreateNodeClass”? This is called whenever a node is being allocated. What people dont realize is that you can alter this whenever you want, and as such each node can be of a distinctly different class-type. As long as it inherits from TTreeNode, it’s all good.

So the first thing we do in our controller, is to take ownership of that event. Our own “add node” mechanics ensures that the node you want to create (which is reflected by the method name) is returned by OnCreateNodeClass. Voila, we now have an ordinary OOP approach to an otherwise procedural API.

//#############################################################################
// TInfoNodeFolder
//#############################################################################

Constructor TInfoNodeFolder.Create(AOwner: TTreeNodes);
Begin
  inherited Create(AOwner);
  ImageIndex:=0;
  SelectedIndex:=1;
end;

//#############################################################################
// TInfoNodeController
//#############################################################################

Constructor TInfoNodeController.Create(aList:TTreeView);
Begin
  inherited Create;
  FParent:=AList;
  FParent.OnCreateNodeClass:=HandleGetNodeClass;
end;

Destructor TInfoNodeController.Destroy;
Begin
  If assigned(FParent) then
  begin
    if not (csDestroying in FParent.ComponentState) then
    FParent.OnCreateNodeClass:=NIL;
  end;
  inherited;
end;    

function TInfoNodeController.AddFolderTo(aParent:TTreeNode;
         caption:String):TInfoNodeFolder;
begin
  result:=AddFolderTo(aParent,Caption,NIL);
end;    

function TInfoNodeController.AddFolderTo(aParent:TTreeNode;Caption:String;
         aModelObject:TNSObject):TInfoNodeFolder;
var
  mNode:  TTreeNode;
begin
  (* Set class to create *)
  FToCreate:=TInfoNodeFolder;

  (* Create node *)
  mNode:=FParent.Items.AddChildObject(aParent,Caption,aModelObject);

  (* Return node of type *)
  result:=TInfoNodeFolder(mNode);
end;    

procedure TInfoNodeController.HandleGetNodeClass(Sender: TCustomTreeView;
          var NodeClass: TTreeNodeClass);
Begin
  (* Default back to root-node type if none set *)
  if FToCreate=NIL then
  FToCreate:=TInfoNode;
  NodeClass:=FToCreate;
end;                

Using the controller

Naturally you have to expand the controller with as many methods you need, making sure you isolate all the property initialization there. The point is, once you have written the base-classes – extending your treeview with other types is a breeze. And should something need to be adjusted, you know exactly where to look and what to do.

You can now do funny stuff like..

  FFolder:=FController.AddFolderTo(FRootNode,'My methods',mMethodObject);

..and completely forget about glyph indexes while working on model representation. It may take 15 minutes extra to setup, but in a living, breathing product that is constantly under development and evolution, you will earn back those 15 minutes a hundred-fold.

And should your product have several TTreeView’s, it quickly makes sense to compartmentalize and de-couple things like this. The mess of dealing with 3 or 4 TTreeViews of inter-connected objects and data-elements is troublesome to make, and even worse to maintain or understand for new employees. Teaching them to go to a single unit and look for a class of a specific name saves you a lot of time.

Practical use

If you have ever coded a typical file / folder treeview, consider this: Instead of having a function which scans a folder and populate the list-node with the content — you can now isolate this functionality in the folder class instead. So the code to manage and work on the folder data is now a part of the actual folder node. Which is fundamental object orientation thinking.

And once again it means less clutter and greater maintainability.

Expanding the idea

The above code works great and it allows you to de-couple your data from it’s visual representation. But can we make it even better than this? Well it depends. If you shun generics then the above code is as good as it gets (which is more than enough if you ask me), but yes we can indeed expand the controller using <T> types.

So instead of “AddFolderTo” which is exclusively bound to the named task, we could have a more generic:

  FFolder:=FController.Add(<TInfoNodeFolder>,FRootNode,
         'My methods',mMethodObject);

The above idea takes a new parameter, where the node-type is provided first. The rest of the parameters are like before. This is the benefit of isolating all initialization of a node in it’s constructor.

The only downside to this is that you are back doing typecasts for every node (or those nodes you want to adjust after creation). This sort of kills some of the beauty and elegance of the initial solution.

Either way, using a controller class to de-couple your code like this is very helpful! And if you expand the idea to also include TListView (and indeed other components which allows custom child classes) your programming life will become much easier!

N++ context parser, part 2

nodeJS rocks!

Right. In my last article on parsing I introduced a basic buffer class and skeleton parser. In this article I introduce a working 2 level parser, meaning recursive, which implements both the program() and execute() code blocks. Being recursive means that you can now nest several execute() sections inside each other. But at this stage that’s pretty much all I’ve had time to implement — so consider it a rough sketch.

Support

At the moment we have a program parser, which naturally parses a program block which looks like this:

program("name") {
}

Registered for the program parser, is a single sub-parser for the “execute” keyword, this is the class TQTXExecuteParser class. This allows you to have execute() sections within a program block, as such:

program("name") {
  execute (scope) {
    /* Code goes heres */
  }
}

To avoid recursive stack errors (stack overflow), the execute class does a trick. Namely that it registers support for itself (execute keyword) at parse-time, meaning that an execute block will support execute child blocks, like this:

program("name") {
  execute (scope) {
    /* Sub execute block */
    execute (scope) {
      /* your code here */
    }
  }
}

Well, basically this is the base system in place. Adding new keywords and features is now a matter of creating sub parser classes and registering them to either the execute class or the program parser class. The benefit of such a simple system is that it’s fast, easy to understand and use – and easy to maintain. Concrete rules for parsing can be defined, and a lot of code re-cycled between the base-class (TQTXCustomParser) and it’s decendants.
With a bit of work you will have a fine-tuned, fast and efficient language parser.

Supporting other languages

As you probably guessed it’s not that hard to add support for other languages. I mean once you take the time to implement the basic form of a language unit or program-file. But it’s always a time consuming task, where even the tiniest detail matters. If you miss a single language rule (like say, not skippig a comma after it’s been consumed) the error will spread into the next parser and so on – until an exception occurs.

But, once you get the hang of chewing through a source-buffer, supporting enough parsers and keywords (and for Delphi also states, like the “Inerface” keyword state and the “implementation” keyword state) you can pretty much mix and match all you want.

Well, without going to far into the code — here is the updated source. You may want to drop memo control on your form and add the following code:

procedure TForm1.W3Button1Click(Sender: TObject);
var
  mContext: TQTXContext;
  mParser:  TQTXLPPParser;
begin
  mContext:=TQTXContext.Create;
  try
    mParser:=TQTXLPPParser.Create(mContext);
    try
      mContext.Buffer.LoadFromString(w3memo1.text);

      try
        mParser.Parse;
      except
        on e: exception do
        writeln(e.message);
      end;

    finally
      mParser.free;
    end;
  finally
    mContext.free;
  end;
end;

And set the content of the memo to:

procedure TForm1.InitializeForm;
begin
  inherited;
  w3memo1.Text:=#'program("test") {
          execute (*) {
            /* Code here */
          }
        }';
end;

Ok — here is the updated parser code:

 

unit qtxparser;

interface

uses
  SmartCL.System;


const
  TOK_ROUNDOPEN   = 1;  //  "("
  TOK_ROUNDCLOSE  = 2;  //  ")"
  TOK_CUROPEN     = 3;  //  "{"
  TOK_CURCLOSE    = 4;  //  "}"
  TOK_SPACE       = 5;  //  " "

  TOK_ADD         = 6;  //  "+"
  TOK_SUBTRACT    = 7;  //  "-"
  TOK_DIVIDE      = 8;  //  "/"
  TOK_POWER       = 9;  //  "^"

  TOK_COMMA       =10;  //  ","
  TOK_COLON       =11;  //  ";"

  Numeric_Operators: Array [0..3] of Integer =
    (TOK_ADD,TOK_SUBTRACT,TOK_DIVIDE,TOK_POWER);

type

  ENPPException = Class(EW3Exception);

  TLPPApplicationObject = Class;

  TQTXBuffer = Class(TObject)
  private
    FData:    String;
    FIndex:   Integer;
    FLineNr:  Integer;
  protected
    function  getCurrent:String;virtual;
  public

    Property  LineNr:Integer read FLineNr;

    Property  Current:String read getCurrent;
    Function  Back:Boolean;
    function  Next:Boolean;
    function  BOF:Boolean;
    function  EOF:Boolean;

    procedure SkipJunk;

    function  ReadTo(Const aChars:array of string;
              var text:String):Boolean;overload;
    function  ReadTo(aValue:String):Boolean;overload;
    function  ReadTo(aValue:String;var inner:String):Boolean;overload;

    function  ReadWord(var Text:String):Boolean;

    function  ReadToEOL(var text:String):Boolean;

    function  PeekAhead(aCount:Integer;var Text:String):Boolean;
    function  Compare(aText:String):Boolean;

    Property  TextFromCurrent:String read ( Copy(FData,FIndex,length(FData)-FIndex) );

    procedure First;

    procedure LoadFromString(Text:String);

    procedure Clear;
  End;

  TQTXContext = Class(TObject)
  Private
    FBuffer:    TQTXBuffer;
  public
    Property    Buffer:TQTXBuffer read FBuffer;
    Property    ApplicationObject:TLPPApplicationObject;
    Constructor Create;virtual;
    Destructor  Destroy;Override;
  end;

  TQTXCustomParser      = Class;
  TQTXCustomParserClass = Class of TQTXCustomParser;

  TQTXParserInfo = Class(TObject)
  public
    property  Instance: TQTXCustomParser;
    Property  Keyword:String;
  end;

  TQTXCustomParser = Class(TObject)
  private
    FContext:   TQTXContext;
    FParsers:   Array of TQTXParserInfo;
  protected
    function    getParserIndexFor(keyword:String;
                var aIndex:Integer):Boolean;
    function    getParserInstanceFor(keyword:String;
                var aParser:TQTXCustomParser):Boolean;
    procedure   RegisterParser(keyword:String;
                const aParser:TQTXCustomParser);
  protected
    procedure   ParseAsExecuteBlock;virtual;
  protected
    Procedure   ClearParserInstances;virtual;
  public
    Property    Context:TQTXContext read FContext;
    procedure   Parse;virtual;
    Constructor Create(aContext:TQTXContext);virtual;
    Destructor  Destroy;Override;
  end;

  (* Parser for the keyword "program" *)
  TQTXProgramParser = Class(TQTXCustomParser)
  protected
    procedure   ParseProgramName;
    procedure   Parse;override;
  public
    Constructor Create(aContext:TQTXContext);override;
  end;

  TQTXExecuteParser = class(TQTXCustomParser)
  protected
    procedure   ParseScope;
    procedure   Parse;override;
  public
    Constructor Create(aContext:TQTXContext);override;
  end;

  TQTXLPPParser = Class(TQTXCustomParser)
  protected
    procedure   Parse;override;
  public
    Constructor Create(aContext:TQTXContext);override;
  end;

  //##########################################################################
  // In-memory program model classes
  //##########################################################################

  TLPPObject = Class(Tobject)
  end;

  TLPPModule = Class(TLPPObject)
  public
    Property  Name:String;
  end;
  TLPPModuleList = Array of TLPPModule;

  TLPPApplicationObject = Class(TLPPObject)
  private
    FModules: TLPPModuleList;
  public
    Property    ApplicationName:String;
    Property    Modules:TLPPModuleList read FModules;
    function    IndexOfModule(aModuleName:String):Integer;
    Procedure   Clear;
    Constructor Create;virtual;
    Destructor  Destroy;Override;
  end;

implementation

var
  TOK_SYM: Array[TOK_ROUNDOPEN..TOK_COLON] of string =
  ('(',')','{','}',' ','+','-','/','^',',',';');

//###########################################################################
// TLPPApplicationObject
//###########################################################################

Constructor TLPPApplicationObject.Create;
begin
  inherited Create;
end;

Destructor TLPPApplicationObject.Destroy;
Begin
  clear;
  inherited Destroy;
end;

function TLPPApplicationObject.IndexOfModule(aModuleName:String):Integer;
var
  x:  Integer;
Begin
  result:=-1;
  aModulename:=trim(lowercase(aModuleName));
  if length(aModuleName)>0 then
  begin
    for x:=0 to FModules.Count-1 do
    Begin
      if lowercase(FModules[x].Name)=aModuleName then
      begin
        result:=x;
        break;
      end;
    end;
  end;
end;

Procedure TLPPApplicationObject.Clear;
begin
  ApplicationName:='';
  while FModules.Count>0 do
  begin
    FModules[0].free;
    FModules[0]:=NIL;
    FModules.Delete(0,1);
  end;
end;

//###########################################################################
// TQTXLPPParser
//###########################################################################

Constructor TQTXLPPParser.Create(aContext:TQTXContext);
begin
  inherited Create(aContext);
  (* Register the "program" keyword-parser *)
  RegisterParser('program',TQTXProgramParser.Create(context));
end;

procedure TQTXLPPParser.Parse;
var
  mCache: String;
  mSubParser: TQTXCustomParser;
Begin

  repeat
    case Context.Buffer.Current of
    ' ':  Begin
            self.Context.Buffer.SkipJunk;
          end;
    '/':  Begin
            if context.buffer.Compare('//') then
            begin
              self.context.buffer.SkipJunk;
            end;
          end;
    '(':  Begin
            if Context.Buffer.Compare('(*') then
            Context.buffer.SkipJunk else
            Begin

              if getParserInstanceFor(mCache,mSubParser) then
              begin

                (* Invoke sub parser *)
                mSubParser.Parse;

                (* SKip trailing junk if any *)
                Context.Buffer.SkipJunk;

                (* clear cache *)
                mCache:='';

              end else
              raise ENPPException.CreateFmt
              ('Syntax error [%s]',[mCache]);

            end;
          end;
    else
      Begin
        mCache += Context.Buffer.Current;
      end;
    end;

    if not Context.buffer.next then
    break;
  until Context.buffer.EOF;
end;

//###########################################################################
// TQTXExecuteParser
//###########################################################################

Constructor TQTXExecuteParser.Create(aContext:TQTXContext);
Begin
  inherited Create(AContext);
end;

procedure TQTXExecuteParser.Parse;
var
  mDummy: Integer;
Begin
  if not self.getParserIndexFor('execute',mDummy) then
  Begin
    self.RegisterParser('execute',TQTXExecuteParser.Create(Context));
  end;


  (* Expects: Scope param list (), with a bare minumum of (STAR) *)
  //writeln(context.buffer.TextFromCurrent);
  writeln('Enters execute parser');
  context.buffer.SkipJunk;

  (* Check for "(" *)
  if Context.Buffer.Current=TOK_SYM[TOK_ROUNDOPEN] then
  Begin
    // Skip the "(" char
    Context.Buffer.Next;
    ParseScope;
  end;

  if context.buffer.ReadTo('{') then
  Begin
    Context.buffer.next;

    (* Parse content as an execute block *)
    self.ParseAsExecuteBlock;


  end else
  Raise Exception.Create('Syntax error, expected code-block entry error');


  writeln('leaves execute parser');
end;

procedure TQTXExecuteParser.ParseScope;
var
  mScope: String;
Begin
  (* Keep reading until we find ")", or break on others *)
  if context.buffer.ReadTo([')',';','{','}'],mScope) then
  Begin
    (* Valid stop? or one of the breakers? *)
    if context.buffer.Current=')' then
    Begin
      writeln('Defined scope for this execute block is:' + mScope);

      //skip ")" char
      context.buffer.next;

    end else
    Raise Exception.Create('Syntax error, expected scope terminator error');
  end;
end;

//###########################################################################
// TQTXProgramParser
//###########################################################################

Constructor TQTXProgramParser.Create(aContext:TQTXContext);
begin
  inherited Create(aContext);
  RegisterParser('execute',TQTXExecuteParser.Create(context));
end;

procedure  TQTXProgramParser.ParseProgramName;
var
  mTemp:  String;
Begin
  (* Expects:  ("NAME")
     As in Name of program *)
  mtemp:='';

  if Context.Buffer.Current='(' then
  begin
    Context.buffer.next;
    if Context.buffer.current='"' then
    begin
      Context.Buffer.next;

      if Context.buffer.readTo('"',mTemp) then
      begin
        Context.ApplicationObject.ApplicationName:=mTemp;

        Context.Buffer.next;

        Context.Buffer.SkipJunk;
        if Context.buffer.Current=TOK_SYM[TOK_ROUNDCLOSE] then
        Begin
          Context.Buffer.next;


        end else
        Raise Exception.Create('Syntax error, expected ")" param error');
      end else
      Raise Exception.Create('Syntax error, expected string termination error');

      //showmessage(mName);
    end else
    Raise Exception.Create('Syntax error, expected string identifier');
  end else
  Raise Exception.Create('Syntax error, expected parameter');

end;

procedure TQTXProgramParser.Parse;
Begin
  writeln(ClassName);
  context.buffer.SkipJunk;

  (* Check for "(" *)
  if Context.Buffer.Current=TOK_SYM[TOK_ROUNDOPEN] then
  Begin
    ParseProgramName;
    writeln('Program name:' + Context.ApplicationObject.ApplicationName);

    context.Buffer.SkipJunk;
    if context.Buffer.Current=TOK_SYM[TOK_CUROPEN] then
    Begin
      context.buffer.next;

      repeat
        ParseAsExecuteBlock;

        Context.buffer.SkipJunk;
        if context.buffer.Current=TOK_SYM[TOK_CURCLOSE] then
        break;
      until Context.Buffer.EOF;

    end else
    raise exception.create('Syntax error, expected program-block entry');
  end;

  writeln("Exiting TQTXProgramParer");

end;

//###########################################################################
// TQTXCustomParser
//###########################################################################

Constructor TQTXCustomParser.Create(aContext:TQTXContext);
Begin
  inherited Create;
  FContext:=aContext;

end;

Procedure TQTXCustomParser.ClearParserInstances;
Begin
  (* Release sub-parser instances if any *)
  while FParsers.Count>0 do
  Begin
    if FParsers[0].Instance<>NIL then
    Begin
      FParsers[0].Instance.free;
      FParsers[0].Instance:=NIL;
    end;
    FParsers[0].free;
    FParsers.Delete(0,1);
  end;
end;

Destructor TQTXCustomParser.destroy;
begin
  ClearParserInstances;
  inherited;
end;

function TQTXCustomParser.getParserIndexFor(keyword:String;
         var aIndex:Integer):Boolean;
var
  x:  Integer;
begin
  result:=False;
  aIndex:=-1;
  keyword:=lowercase(trim(keyword));
  if keyword.length>0 then
  Begin
    //if FParsers.Count>0 then
    //begin
      for x:=0 to FParsers.count-1 do
      Begin
        if sameText(FParsers[x].Keyword,keyword) then
        begin
          result:=true;
          aIndex:=x;
          break;
        end;
      end;
    //end;
  end;
end;

function TQTXCustomParser.getParserInstanceFor(keyword:String;
         var aParser:TQTXCustomParser):Boolean;
var
  x:  Integer;
begin
  result:=False;
  aParser:=NIL;
  keyword:=lowercase(trim(keyword));
  if keyword.length>0 then
  Begin
    //if FParsers.Count>0 then
    //begin
      for x:=0 to FParsers.count-1 do
      Begin
        if sameText(FParsers[x].Keyword,keyword) then
        begin
          result:=true;
          aParser:=FParsers[x].Instance;
          break;
        end;
      end;
    //end;
  end;
end;

procedure TQTXCustomParser.RegisterParser(keyword:String;
          const aParser:TQTXCustomParser);
var
  mIndex: Integer;
  mInfo:  TQTXParserInfo;
Begin
  keyword:=lowercase(trim(keyword));
  if keyword.length>0 then
  Begin
    if aParser<>NIL then
    begin
      if not getParserIndexFor(keyword,mIndex) then
      Begin
        (* register sub parser *)
        mInfo:=TQTXParserInfo.Create;
        mInfo.Instance:=aParser;
        mInfo.Keyword:=keyword;
        FParsers.Add(mInfo);
      end else
      raise ENPPException.createFmt
      ('Parser for keyword [%s] already registered',[keyword]);
    end else
    raise ENPPException.CreateFmt
    ('Parser class for keyword [%s] was NIL error',[keyword]);
  end;
end;

procedure TQTXCustomParser.Parse;
begin
  raise ENPPException.CreateFmt
  ('No parser implemented for class %s',[classname]);
end;

(* About:
   This method continues the parsing process as if it's parsing from
   within an execute() code block.
   This means that all the rules of  normal 'Execute( * ) "
   applies. After Program() this is the default parsing mode, which
   makes it the fallback of more or less all parse-objects which allows
   ordinary code (e.g "case/switch" sections and more) *)

procedure TQTXCustomParser.ParseAsExecuteBlock;
var
  mCache: String;
  mTemp:  String;
  mParser: TQTXCustomParser;
Begin

  while not Context.Buffer.EOF do
  Begin
     case Context.Buffer.Current of
     ' ',
     #9:  begin
            //Context.buffer.SkipJunk;
          end;
     '(': If context.Buffer.Compare('(*')
          and not Context.buffer.compare('(*)') then
          Begin
            Context.buffer.next;
            context.buffer.next;
            Context.Buffer.ReadTo('*)');
            Context.Buffer.Next;
            Context.Buffer.Next;
          end else
          Begin
            if mCache.length>0 then
            Begin
              writeln('Command is: "' + mCache + '"');

              if getParserInstanceFor(lowercase(mCache),mParser) then
              Begin
                writeln('Parser ' + mParser.classname + ' is registered for keyword ' + mCache);
                try
                  mParser.Parse;
                except
                  on e: exception do
                  raise Exception.Create(e.message);
                end;
              end else
              Raise Exception.create('Syntax error, unknown token:' + mCache);

              mCache :='';

              exit;
            end else
            Raise Exception.Create('Syntax error, unsuspected character');
          end;
     '/': If Context.buffer.compare('//') then
          begin
            Context.buffer.ReadToEOL(mTemp);
          end else
          if Context.buffer.compare('/*') then
          Begin
            Context.buffer.next;
            Context.buffer.Next;
            Context.buffer.ReadTo('*/');
          end;
     '{': Begin
            if mCache.length>0 then
            Begin
              if getParserInstanceFor(lowercase(mCache),mParser) then
              Begin
                showmessage('over here!');

              end else
              Raise Exception.create('Syntax error, unknown token:' + mCache);

            end else
            Raise Exception.Create('Syntax error, unexpected character');
          end;
     '}': Begin
          end;
     else
        Begin
          mCache += Context.buffer.Current;
        end;

     end;

    if not context.buffer.next then
    break;
  end;

  writeln('Exiting CodeBlock parser at:' + mCache);

end;

//###########################################################################
// TQTXContext
//###########################################################################

Constructor TQTXContext.Create;
begin
  inherited Create;
  FBuffer:=TQTXBuffer.create;
  ApplicationObject:=TLPPApplicationObject.Create;
end;

Destructor TQTXContext.destroy;
Begin
  FBuffer.free;
  ApplicationObject.free;
  inherited;
end;

//###########################################################################
// TQTXBuffer
//###########################################################################


procedure TQTXBuffer.First;
Begin
  If FData.length>0 then
  begin
    FLineNr:=1;
    FIndex:=0;
  end;
end;

procedure TQTXBuffer.SkipJunk;
var
  mTemp:  String;
begin
  repeat
    case Current of
    ' ',
    #9  :  Begin
            (* We treat TAB as space *)
            //if not next then
            //break;

          end;
    '/':  Begin
            (* Skip C style remark *)
            if Compare('/*') then
            begin
              if readTo('*/') then
              Begin
                Next;
                Next;
              end else
              raise ENPPException.Create('Comment not closed error');
            end else
            Begin
              (* Skip Pascal style remark *)
              if Compare('//') then
              begin
                if ReadToEOL(mTemp) then
                next else
                raise ENPPException.Create('Expected end of line error');
              end;
            end;
          end;
    '(':  Begin
            (* Skip pascal style remark *)
            if compare('(*')
            and not compare('(*)') then
            Begin
              if readTo('*)') then
              begin
                Next;
                Next;
              end else
              raise ENPPException.Create('Comment not closed error');
            end else
            break;
          end;
    #13:
        begin
          //
        end;
    else
      begin
        Break;
      end;
    end;
    next;
  until EOF;
end;

Procedure TQTXBuffer.Clear;
begin
  FData:='';
  FLineNr:=1;
  FIndex:=0;
end;

procedure TQTXBuffer.LoadFromString(Text:String);
Begin
  FLineNr:=1;
  FData:=trim(text);
  FData:=StrReplace(FData,#10,#13);
  FData:=StrReplace(FData,#13#13,#13);
  FIndex:=1;
  if length(FData)<1 then
  FIndex:=-1;
end;

function TQTXBuffer.getCurrent:String;
Begin
  result:=FData[FIndex];
end;

function TQTXBuffer.ReadWord(var Text:String):Boolean;
begin
  result:=False;
  Text:='';
  if not EOF then
  begin
    repeat
      if (current in ['A'..'Z','a'..'z','0'..'9']) then
      Text += current else
      break;
    until not next;
    result:=length(Text)>0;
  end;
end;

function TQTXBuffer.Compare(aText:String):Boolean;
var
  mData:  String;
Begin
  result:=PeekAhead(length(aText),mData)
  and SameText(lowercase(mData),lowercase(aText));
end;

function TQTXBuffer.PeekAhead(aCount:Integer;var Text:String):Boolean;
var
  mPos: Integer;
Begin
  result:=False;
  Text:='';

  if not EOF then
  Begin
    mPos:=FIndex;
    try
      while aCount>0 do
      begin
        Text+=Current;
        if not Next then
        break;
        dec(aCount);
      end;
      result:=length(text)>0;
    finally
      FIndex:=mPos;
    end;
  end;
end;

function TQTXBuffer.ReadToEOL(var text:String):Boolean;
Begin
  result:=ReadTo([#13,#10],text);
end;

function TQTXBuffer.ReadTo(aValue:String;var inner:String):Boolean;
var
  mText:  String;
begin
  inner:='';
  result:=False;

  aValue:=lowercase(aValue);
  if aValue.length>0 then
  begin

    repeat
      if PeekAhead(aValue.length,mText) then
      begin
        mText:=lowercase(mText);
        result:=SameText(mText,aValue);
        if result then
        break else
        inner += Current;
      end else
      inner += Current;
      Next;
    until EOF;

  end;
end;

function TQTXBuffer.readTo(aValue:String):Boolean;
var
  mText:  String;
begin
  result:=False;
  aValue:=lowercase(aValue);
  if aValue.length>0 then
  begin

    repeat
      if PeekAhead(aValue.length,mText) then
      begin
        mText:=lowercase(mText);
        result:=SameText(mText,aValue);
        if result then
        break;
      end;
      if not Next then
      break;
    until EOF;

    (* repeat
      if PeekAhead(aValue.length,mText)
      and SameText(lowercase(mtext),aValue) then
      Begin
        result:=true;
        break;
      end else
      if not next then
      break;
    until EOF; *)

  end else
  Raise ENPPException.Create
  ('ReadTo() failed, invalid target value error');
end;

function TQTXBuffer.ReadTo(Const aChars:Array of string;
         var text:String):Boolean;
var
  x:  Integer;
Begin
  result:=False;
  text:='';
  if aChars.Length>0 then
  begin
    for x:=FIndex to FData.length do
    Begin
      if (Current in aChars) then
      Begin
        result:=true;
        break;
      end else
      text+=Current;

      if not Next then
      break;
    end;
  end;
end;

Function TQTXBuffer.Back:Boolean;
begin
  result:=FIndex>1;
  if result then
  dec(FIndex);
end;

function TQTXBuffer.Next:Boolean;
begin
  Result:=FIndex<fdata.length; if="" result="" then="" begin="" inc(findex);="" (current="" in="" [#13,#10])="" inc(flinenr);="" end;="" function="" tqtxbuffer.bof:boolean;="" result:="FIndex=1;" tqtxbuffer.eof:boolean;="">=FData.Length;
end;


end.

N++ execution model

When creating programming languages or translation-modules, it’s very important to allow the thought to grow and mature before you jump in and build the final product.

program("service_test") {

  handshake {

    input {
      /* Consume WSDL Web-Service Endpoint */
      service1 @ service[URI:"http://www.test.com/SOAP/myService/WSDL/",
                 serviceType:SoapService];
    }

    output {
        myProcess @ process("self");
        stdio @ pipe("stdout");
      }
  }

  /* Execute RPC call */
  execute (stdio,service1)  {
    stdio:writeln("Calling webservice");
    execute (*)  {
      var int32 result = 0;
      set result = service1:getUserId("quartex","secret");
      stdio:writelnF("UserID on server={0}", result);
    } fail (e) {
      stdio.writelnF("Calling soap service failed: {0}",e);
      proceed;
    }
  }

  /* Exit code for process */
  set myProcess:exitCode = 0;
}

The smallest detail can become either a strength or a weakness for the language. For instance, in the past couple of days I have realized the following:

First: Using “:” instead of “.” as class or method accessor saves time when parsing. Traditionally the dot character is used when accessing a member of a class or object, for example: “myobject.mymethod(<params>);” is how you would call a procedure in nearly all languages. By altering this to “myobject:mymethod(<params>);” we are able to reserve the dot character for other things.

Second: Originally the combination of => and <= (arrow heads) was used to denote direction of data-flow inside the input() and output() blocks (handshake section). This turned out to be a bad idea because web-services and pure objects does not follow the concept of “consumer” or “producer”. A web-service contains both functions and procedures, and as such using data-flow arrowheads would require two registrations rather than one. Replacing the arrow-head symbolism with “@” (meaning “at”) makes more sense, since services and channels are also bi-directional.

The “@” at character is also used to denote “memory address of” (same as object-pascal) and “reference to”. For instance when passing an anonymous-procedure as a parameter you must prefix the in-place execute-block with “@”. See notes on anonymous procedures further down.

Third: To date the execute() program block allows you to define the variables visible to the block and shared between the module and the code inside the block. This has been poorly understood by commenters on this blog. The reason the execute() exists at all, as opposed to just typing the code in it’s place, is because a code block can execute in 4 different modes:

• Blocking
• Async
• Threaded
• Anonymous

An execute block is by definition anonymous since you cant apply a name to it as you would a method. However the data-scope (the variables visible to the block, or “known” by the block) can also be used when the block is threaded. This is why you have to define shared variables — or simply write use (*) as a parameter – which means “all”.

Linear execution

linear execution means that the block executes in the same thread as the main program. This means you actually dont have to define parameters, since all variables and objects of the program will be available to the block.

Execute (*) {
  stdio:writeln("linear execution");
}

Asyncronous execution

Async execution means that your code is executed in the same thread as the main program, but execution is done through interrupts, so that the program continues immediately and doesnt wait for the block to finish.

Execute async (stdio) {
  stdio:writeln("async execution");
}

Threaded execution

Threaded execution executes the block in it’s own process. Objects and variables you wish to share with the thread must be passed as parameters of the execute block. Note:under JavaScript this involves web-workers. nodeJS however supports real threads which is used by the code emitter.

Execute thread[Priority:Idle] (stdio,mySharedObject1,MySharedObject2)  {

  var msghandler = null;
  var myProcess = null;

  set msgHandler = open PIPE("messages");
  set myProcess = process("self");

  repeat(-1) {
    msghandler:waitfor(1000) {
      stdio:writeln("message recieved!");
    } fail (e) {
      criteria {
        myProcess:terminated = false;
      } execute (*) {
        /* Thread terminated, break free of wait loop */
        break;
      } else {
        /* thread not terminated, continue waiting
           for a message */
        continue;
      }
    }
  }

} finished {
  /* Code to execute when thread finishes */
}

The above code executes a code-block as a thread. The thread creates a pipe and waits for a message on the pipe (typically sent from the main program – but can also be triggered by another N++ application (or any application capable of creating and sending data over a pipe).

Anonymous procedures

Much like javascript N++ supports in-place anonymous procedures. Like other languages the declaration must have a compatible interface (parameters and their types):

Execute (*) {
  someclass:someproc( @execute(*){
      stdlib:writeLn("this execute block is anonymous");
      }, 100);
}

Hopefully this clears up the concept of execute-blocks and it’s parameters. The parameter list for the execute block simply defines what should be known for that block. This makes sense when you realize that the code-block can be executed as a completely separate thread.

Symbols so far

• “:” Accessor, as in “object:method” or “interface:method”
• “@” Reference to, address of, as in “myService @ process(‘name’);”
• “<type | interface>” typecast as in, <ISomeInterface>SomeInstance:InterfaceMethod(Params);
• “async” execute model, runs execute-block in async mode
• “thread” execute model, runs execute-block as a separate thread
• “[ attribute ]” accessor for attributes, arrays and dictionary elements. As in “object-factory[attribute-name:value, ..];”
  Also used as array accessors, as in “string name = Array[index]”
  Also used as dictionary accessors, as in object “temp = Dictionary[KEY];”

Attributes

N++ attributes are identical to what in other languages are called class-properties or class-methods, in that no instance needs to be constructed in order to change them. Attributes are typically used to initialize a class before you construct instances from it (an instance or “object” is what is created from a class, a class remains a blueprint or schema describing what you want to construct. This is classical OOP terminology).

* Note: The [ ] accessors are the same as those used for array access.

Under object pascal you would for instance write:

 type
    TMyClass = class
    strict private
    class var
       FRed: Integer;
       FGreen: Integer;
       FBlue: Integer;
     public
       class property Red: Integer read FRed write FRed;
       class property Green: Integer read FGreen write FGreen;
       class property Blue: Integer read FBlue write FBlue;
    end;

You would then initialize these values before you create an object from the class:

procedure TForm1.makeClass;
var
  mInstance: TMyClass;
Begin
  (* Initialize class level values *)
  TMyClass.red:=120;
  TMyClass.green:=19;
  TMyClass.blue:=22;

  (* construct instance from class.
     the values assigned to the class are mirrored on the instance,
     so the "red" property now contains 120 in our instance *)
  mInstance:=TMyClass.Create;
end;

Under N++ such special properties are called attributes and are not decorative like C# and C++ attributes. The word attribute and property (of something) means essentially the same thing; but under N++ we use them to differienciate between class and instance values. Attributes operate on the level of class (global), while properties operate on the level of instance (local).

Setting attributes

Attributes can be set directly or indirectly depending on the language construct. When obtaining service objects, which by nature are external processed without any constructors (external running programs, also running on other servers remotely) attributes function more or less as constructors:

    input {
      /* Consume WSDL Web-Service Endpoint */
      service1 @ service[URI:"http://www.test.com/SOAP/myService/WSDL/",
                 serviceType:SoapService];
    }

In the above example we set the attributes for the service we are going to use. The service can then be used through the identifier (service1). The “service” keyword is actually an object factory, which creates the invocation layer.

  /* create thread manually */
  var Thread myThread = new Thread
      [Priority:highest,name:"this is my thread"](*);

  /* set thread execution block */
  set @myThread:execute (*) {
  }

N++ accessing services

Sometimes you come up with solutions which are a thing of pure beauty and elegance. Im falling in love with the simplicity of my N++ programming language, it’s robust boundaries which creates a situation where errors are quickly identified and dealt with.

Below is the syntax for using a web-service. Notice that setting up an WSDL endpoint is no more difficult than setting up a stdout pipe (command-line output).

program("service_test") {

  handshake {

    input { 
      /* Consume WSDL Web-Service Endpoint */
      service1 @ service("http://www.test.com/SOAP/myService/WSDL/", serviceType:SoapService);
    }

    output {
        myProcess @ process("self");
        stdio @ pipe("stdout");
      }
  }

  /* Execute RPC call */
  execute (stdio,service1)  {
    stdio:writeln("Calling webservice");
    execute (*)  {
      var int32 result = 0;
      set result = service1:getUserId("quartex","secret");
      stdio:writelnF("UserID on server={0}", result);
    } fail (e) {
      stdio.writelnF("Calling soap service failed: {0}",e);
      proceed;
    }
  }

  /* Exit code for process */
  set myProcess:exitCode = 0;
}

For those of you interested in creating programming languages, I hope this wet’s your appetite to learn N++. At the moment the proof-of-concept is being written in Smart Pascal for nodeJS, but a native version running on Linux, Unix, Windows and OS X is the final product.

N++ is free to use. It is not open-source but created as a non-profit language which will be managed through an organization (more or less identical to php, perl and python).

To date, it’s the only language which is fully service oriented from the ground up.

Building a single context parser

Right, in the last post I introduced a simple text-buffer class which implemented the most basic functions you need when parsing a source-file.

In this post we will look closer at the actual parser itself, in our case a recursive-decent parser. But before we dive into the code, which is very easy – let’s spend a moment talking about the parser and how it works.

Recursive? Decent? Woot?

Ye old compiler bible

Right. Without going to far into the boring stuff, in short: there exists a lot of different parsing methods. Parsing source-code and building compilers is actually a science course that you can take in college and university – so a lot of very old, very dull people have spent decades arguing over what methods is the best.

The type of parser you create depends greatly on the language you want to parse. If you want to parse a basic source-code then naturally you dont need a very complex parser. Chances are that the most advanced piece of source you will encounter is a recursive if/then/else section (that according to the old rules from the 70’s, should not exceed a depth of 8 if/then sections).

So for basic you get away with a very humble parser that doesnt need that much in terms of infrastructure.

The recursive part of the name points to the fact that you want to re-cycle the parser rules and code you write to take care of different commands and structures. The decent means that your parser enters the code from the top, and keeps parsing into the various declarations, only to exit backwards again as the structures are closed.

For instance, in the code below every time the parser encounters an IF section, it will create a context object and push whatever context is presently used on the stack. The new “IF” context informs the parser about where it is, and what the rules are for the code ahead:

 if a>0 then
   if b>0 then
     if C>0 then
     doSomething;
   end if
  end if;

The moment the parser hits “end if” it will pop backwards, re-fetching the context for the previous entry. Each section of the program has it’s own context, which describes where you are and what object you are doing work for (in context to).
Typically you start with a program context, only to parse into a class context, then into a class-field context, then back out again and into a class member context (and so on).

The context changes as your parser moves through the source-file — so that at all times the parser knows what rules to follow, what to expect and (perhaps more importantly) what constitutes an error.

Recursive decent also has a huge impact on AST storage, meaning: how the binary representation of your program code in-memory (for further processing by the codegen) is represented. Below is a typical abstract symbol tree, where everything is parsed into objects and stored in nodes – a binary “tree” in memory.

Recursive Decent Schema

Single context parser

Context parsers are great, orderly and very efficient (!) but also more tricky to program. There are other solutions rather than contexts of course, and that is to move rule-checking and possible-combinations onto the actual parser instead. So instead of storing rules and information in a separate context object, using a stack to navigate — you create a parser for each identifier and symbol which are allowed — for each parser.

Take this Delphi code:

If a>0 then
Begin
  Case A of
  10: Begin
        B:=12;
        a:=0;
      End;
  end;
End;

The parsing process actually looks more like this:

• IF Parser
  • Condition Parser
    • Begin Parser
      • Case Parser
        • CaseItem Parser
          • Begin Parser
            • Assignment Parser
            • Assignment Parser
          • Exit Begin Parser
        • Exit CaseItem Parser
      • Exit Case Parser
    • Exit Begin Parser
• Exit IF parser

So whenever the parser finds a keyword or identifier, a parser is created for that identifier (if it’s allowed by the current parser),  who in turn would have all it’s allowed parsers registered (and so on, until the whole language and possible combinations are mapped).

Confused yet? Good. It’s actually very simple once you get the basics into your fingers.

The code

Now for large and complex languages I would go for a context-parser, but for our little experiments we can stick with a single context parser. This means that there will be more code associated with the various parsers, and also that there will be many different parser classes – each who contain an internal-registry (list) of allowed sub parsers.

unit qtxparser;

interface

uses
  SmartCL.System;

const
  TOK_ROUNDOPEN   = 1;  //  "("
  TOK_ROUNDCLOSE  = 2;  //  ")"
  TOK_CUROPEN     = 3;  //  "{"
  TOK_CURCLOSE    = 4;  //  "}"
  TOK_SPACE       = 5;  //  " "

  TOK_ADD         = 6;  //  "+"
  TOK_SUBTRACT    = 7;  //  "-"
  TOK_DIVIDE      = 8;  //  "/"
  TOK_POWER       = 9;  //  "^"

  TOK_COMMA       =10;  //  ","
  TOK_COLON       =11;  //  ";"

  Numeric_Operators: Array [0..3] of Integer =
    (TOK_ADD,TOK_SUBTRACT,TOK_DIVIDE,TOK_POWER);

type

  ENPPException = Class(EW3Exception);

  TQTXBuffer = Class(TObject)
  private
    FData:    String;
    FIndex:   Integer;
    FLineNr:  Integer;
  protected
    function  getCurrent:String;virtual;
  public

    Property  LineNr:Integer read FLineNr;

    Property  Current:String read getCurrent;
    Function  Back:Boolean;
    function  Next:Boolean;
    function  BOF:Boolean;
    function  EOF:Boolean;

    procedure SkipJunk;

    function  ReadTo(Const aChars:array of string;
              var text:String):Boolean;overload;
    function  ReadTo(aValue:String):Boolean;overload;
    function  ReadTo(aValue:String;var inner:String):Boolean;overload;

    function  ReadWord(var Text:String):Boolean;

    function  ReadToEOL(var text:String):Boolean;

    function  PeekAhead(aCount:Integer;var Text:String):Boolean;
    function  Compare(aText:String):Boolean;

    procedure First;

    procedure LoadFromString(Text:String);

    procedure Clear;
  End;

  TQTXToken = Record
    qToken: Integer;
    qText:  String;
    qline:  Integer;
    qCol:   Integer;
  end;

  TQTXTokenBuffer = Array of TQTXToken;

  TQTXContext = Class(TObject)
  Private
    FBuffer:    TQTXBuffer;
    FTokens:    TQTXTokenBuffer;
  public
    Property    Buffer:TQTXBuffer read FBuffer;
    Property    Tokens:TQTXTokenBuffer read FTokens;
    Constructor Create;virtual;
    Destructor  Destroy;Override;
  end;

  TQTXCustomParser      = Class;
  TQTXCustomParserClass = Class of TQTXCustomParser;

  TQTXParserInfo = Record
    piInstance:     TQTXCustomParser;
    piKeyword:      String;
  end;

  TQTXCustomParser = Class(TObject)
  private
    FContext:   TQTXContext;
    FParsers:   Array of TQTXParserInfo;
  protected
    function    getParserIndexFor(keyword:String;
                var aIndex:Integer):Boolean;
    function    getParserInstanceFor(keyword:String;
                var aParser:TQTXCustomParser):Boolean;
    procedure   RegisterParser(keyword:String;
                const aParser:TQTXCustomParser);
  public
    Property    Context:TQTXContext read FContext;
    procedure   Parse;virtual;
    Constructor Create(aContext:TQTXContext);virtual;
    Destructor  Destroy;Override;
  end;

  (* Parser for the keyword "program" *)
  TQTXProgramParser = Class(TQTXCustomParser)
  protected
    procedure   Parse;override;
  public
    Constructor Create(aContext:TQTXContext);override;
  end;

  TQTXLPPParser = Class(TQTXCustomParser)
  protected
    procedure   Parse;override;
  public
    Constructor Create(aContext:TQTXContext);override;
  end;

implementation

var
  TOK_SYM: Array[TOK_ROUNDOPEN..TOK_COLON] of string =
  ('(',')','{','}',' ','+','-','/','^',',',';');

//###########################################################################
// TQTXLPPParser
//###########################################################################

Constructor TQTXLPPParser.Create(aContext:TQTXContext);
begin
  inherited Create(aContext);
  self.RegisterParser('program',TQTXProgramParser.Create(context));
end;

procedure TQTXLPPParser.Parse;
var
  mCache: String;
  mSubParser: TQTXCustomParser;
Begin

  repeat
    case Context.Buffer.Current of
    ' ':  self.Context.Buffer.SkipJunk;
    '(':  Begin
            if Context.Buffer.Compare('(*') then
            Context.buffer.SkipJunk else
            Begin

              showmessage('Token =' + mCache);

              if getParserInstanceFor(mCache,mSubParser) then
              begin
                (* Invoke sub parser *)
                mSubParser.Parse;

                (* SKip trailing junk if any *)
                Context.Buffer.SkipJunk;

                (* clear cache *)
                mCache:='';

              end else
              raise ENPPException.CreateFmt
              ('Syntax error [%s]',[mCache]);

            end;
          end;
    else
      Begin
        mCache += Context.Buffer.Current;
      end;
    end;

    if not Context.buffer.next then
    break;
  until Context.buffer.EOF;
end;

//###########################################################################
// TQTXProgramParser
//###########################################################################

Constructor TQTXProgramParser.Create(aContext:TQTXContext);
begin
  inherited Create(aContext);
end;

procedure TQTXProgramParser.Parse;
var
  mName:  String;
Begin
  context.buffer.SkipJunk;

  showmessage('here!');

  (* Check if program name is defined *)
  if context.Buffer.Current = TOK_SYM[TOK_ROUNDOPEN] then
  Begin
    if Context.buffer.ReadTo(')',mName) then
    begin
      showmessage('name was:' + mName);
    end;
  end;
end;

//###########################################################################
// TQTXCustomParser
//###########################################################################

Constructor TQTXCustomParser.Create(aContext:TQTXContext);
Begin
  inherited Create;
  FContext:=aContext;
end;

Destructor TQTXCustomParser.destroy;
begin
  (* Release sub-parser instances if any *)
  while FParsers.Count>0 do
  Begin
    if FParsers[0].piInstance<>NIL then
    Begin
      FParsers[0].piInstance.free;
      FParsers[0].piInstance:=NIL;
    end;
    FParsers.Delete(0,1);
  end;
  inherited;
end;

function TQTXCustomParser.getParserIndexFor(keyword:String;
         var aIndex:Integer):Boolean;
var
  x:  Integer;
begin
  result:=False;
  aIndex:=-1;
  keyword:=lowercase(trim(keyword));
  if keyword.length>0 then
  Begin
    if FParsers.Count>0 then
    begin
      for x:=0 to FParsers.count-1 do
      Begin
        if sameText(FParsers[x].piKeyword,keyword) then
        begin
          result:=true;
          aIndex:=x;
          break;
        end;
      end;
    end;
  end;
end;

(*
function TQTXCustomParser.getParserClassFor(keyword:String;
         var aClass:TQTXCustomParserClass):Boolean;
var
  mIndex: Integer;
Begin
  aClass:=NIL;
  result:=getParserIndexFor(keyword,mIndex);
  if result then
  aClass:=FParsers[mIndex].piParserClass;
end;  *)

function TQTXCustomParser.getParserInstanceFor(keyword:String;
         var aParser:TQTXCustomParser):Boolean;
var
  x:  Integer;
begin
  result:=False;
  aParser:=NIL;
  keyword:=lowercase(trim(keyword));
  if keyword.length>0 then
  Begin
    if FParsers.Count>0 then
    begin
      for x:=0 to FParsers.count-1 do
      Begin
        if sameText(FParsers[x].piKeyword,keyword) then
        begin
          result:=true;
          aParser:=FParsers[x].piInstance;
          break;
        end;
      end;
    end;
  end;
end;

procedure TQTXCustomParser.RegisterParser(keyword:String;
          const aParser:TQTXCustomParser);
var
  mIndex: Integer;
  mInfo:  TQTXParserInfo;
Begin
  keyword:=lowercase(trim(keyword));
  if keyword.length>0 then
  Begin
    if aParser<>NIL then
    begin
      if not getParserIndexFor(keyword,mIndex) then
      Begin
        (* register sub parser *)
        mInfo.piInstance:=aParser;
        mInfo.piKeyword:=keyword;
        FParsers.Add(mInfo);
      end else
      raise ENPPException.createFmt
      ('Parser for keyword [%s] already registered',[keyword]);
    end else
    raise ENPPException.CreateFmt
    ('Parser class for keyword [%s] was NIL error',[keyword]);
  end;
end;

procedure TQTXCustomParser.Parse;
begin
  raise ENPPException.CreateFmt
  ('No parser implemented for class %s',[classname]);
end;

//###########################################################################
// TQTXContext
//###########################################################################

Constructor TQTXContext.Create;
begin
  inherited Create;
  FBuffer:=TQTXBuffer.create;
end;

Destructor TQTXContext.destroy;
Begin
  FTokens.clear;
  FBuffer.free;
  inherited;
end;

//###########################################################################
// TQTXBuffer
//###########################################################################

procedure TQTXBuffer.First;
Begin
  If FData.length>0 then
  begin
    FLineNr:=1;
    FIndex:=0;
  end;
end;

procedure TQTXBuffer.SkipJunk;
var
  mTemp:  String;
begin
  repeat
    case Current of
    ' ':  Begin
            if Next then
            continue else
            break;
          end;
    '/':  Begin
            (* Skip C style remark *)
            if Compare('/*') then
            begin
              if readTo('*/') then
              Begin
                Next;
                Next;
              end else
              raise ENPPException.Create('Comment not closed error');
            end else
            Begin
              (* Skip Pascal style remark *)
              if Compare('//') then
              begin
                if ReadToEOL(mTemp) then
                next else
                raise ENPPException.Create('Expected end of line error');
              end;
            end;
          end;
    '(':  Begin
            (* Skip pascal style remark *)
            if compare('(*') then
            Begin
              if readTo('*)') then
              begin
                Next;
                Next;
              end else
              raise ENPPException.Create('Comment not closed error');
            end;
          end;
    #13:
        begin
          //
        end;
    else
      begin
        Break;
      end;
    end;
    next;
  until EOF;
end;

Procedure TQTXBuffer.Clear;
begin
  FData:='';
  FLineNr:=1;
  FIndex:=0;
end;

procedure TQTXBuffer.LoadFromString(Text:String);
Begin
  FLineNr:=1;
  FData:=trim(text);
  FData:=StrReplace(FData,#10,#13);
  FData:=StrReplace(FData,#13#13,#13);
  FIndex:=1;
  if length(FData)<1 then
  FIndex:=-1;
end;

function TQTXBuffer.getCurrent:String;
Begin
  result:=FData[FIndex];
end;

function TQTXBuffer.ReadWord(var Text:String):Boolean;
begin
  result:=False;
  Text:='';
  if not EOF then
  begin
    repeat
      if (current in ['A'..'Z','a'..'z','0'..'9']) then
      Text += current else
      break;
    until not next;
    result:=length(Text)>0;
  end;
end;

function TQTXBuffer.Compare(aText:String):Boolean;
var
  mData:  String;
Begin
  result:=PeekAhead(length(aText),mData)
  and SameText(lowercase(mData),lowercase(aText));
end;

function TQTXBuffer.PeekAhead(aCount:Integer;var Text:String):Boolean;
Begin
  if not EOF then
  Begin
    while aCount>0 do
    begin
      Text+=Current;
      if not Next then
      break;
    end;
    //text:=copy(FData,FIndex,aCount);
    //inc(FIndex,length(text));
    result:=length(text)>0;
  end;
end;

function TQTXBuffer.ReadToEOL(var text:String):Boolean;
Begin
  result:=ReadTo([#13,#10],text);
end;

function TQTXBuffer.ReadTo(aValue:String;var inner:String):Boolean;
var
  mText:  String;
begin
  inner:='';
  result:=False;

  aValue:=lowercase(aValue);
  if aValue.length>0 then
  begin
    repeat
      if PeekAhead(aValue.length,mText)
      and SameText(lowercase(mtext),aValue) then
      Begin
        result:=true;
        break;
      end else
      Begin
        inner += Current;
        if not next then
        break;
      end;
    until EOF;
  end;
end;

function TQTXBuffer.readTo(aValue:String):Boolean;
var
  mText:  String;
begin
  aValue:=lowercase(aValue);
  if aValue.length>0 then
  begin
    repeat
      if PeekAhead(aValue.length,mText)
      and SameText(lowercase(mtext),aValue) then
      Begin
        result:=true;
        break;
      end else
      if not next then
      break;
    until EOF;
  end else
  result:=False;
end;

function TQTXBuffer.ReadTo(Const aChars:Array of string;
         var text:String):Boolean;
var
  x:  Integer;
Begin
  result:=False;
  text:='';
  if aChars.Length>0 then
  begin
    for x:=FIndex to FData.length do
    Begin
      //FIndex:=x;
      //if FData[x] in aChars then
      if (Current in aChars) then
      Begin
        result:=true;
        break;
      end else
      text+=text[x];

      if not Next then
      break;
    end;
  end;
end;

Function TQTXBuffer.Back:Boolean;
begin
  result:=FIndex>1;
  if result then
  dec(FIndex);
end;

function TQTXBuffer.Next:Boolean;
begin
  Result:=FIndex<FData.Length;
  if result then
  Begin
    inc(FIndex);
    if (Current in [#13,#10]) then
    inc(FLineNr);
  end;
end;

function TQTXBuffer.BOF:Boolean;
begin
  result:=FIndex=1;
end;

function TQTXBuffer.EOF:Boolean;
begin
  result:=FIndex>=FData.Length;
end;

end.

Using the code

The above code is not finished, it has just the bare-bone stuff needed. Also, only the first parser is implemented (the “program” parser) which will trigger whenever the “program” keyword is found. Here is the code to test the parser:

procedure TForm1.W3Button1Click(Sender: TObject);
var
  mContext: TQTXContext;
  mParser:  TQTXLPPParser;
begin
  mContext:=TQTXContext.Create;
  try
    mParser:=TQTXLPPParser.Create(mContext);
    try
      mContext.Buffer.LoadFromString(
        #'program("test") {
          execute (*) {
            /* Code here */
          }
        }');

      mParser.Parse;

    finally
      mParser.free;
    end;
  finally
    mContext.free;
  end;
end;

Next time

In the next article we will add more meat to the parser. We will finish the program-keyword and more into the execute method – as well as start building that mysterious abstract symbol tree, which in essence is just a in-memory representation of your code.

It’s actually a very worth-while experiment, because I have no idea of the browser will handle it, or how complex or long a source code is before the browser says “thats to power hungry for me” and drops the thread. There is a time factor involved in javascript where a single procedure entry cannot last to long before it’s dropped.

But being able to compile or otherwise make use of this on a website or in the cloud is quite fun! Who knows, maybe we’ll move Smart Mobile Studio completely to the cloud in the future – which makes sense. But for now, let’s focus on the experiments and see where we end up.

After all, N++ have some CSS to automate 🙂

N++ parser written in Smart Pascal (JavaScript)

Since there seems to be doubts (oh ye of little faith) as to the power of Smart Pascal in the marketplace, I figured: what better way to introduce a new programming language – than by writing a completely new programming language (N++) itself in Smart Pascal 🙂 Meaning, that N++ be for nodeJS and the browser exclusively – and it’s written 100% in Smart Pascal.

I think that is some kind of record, and that N++ will probably be the first ever programming language written in JavaScript. Or Smart Pascal and compiled to JavaScript to be more precise.

Either way, let’s start with the beginning..

The source buffer

Everything starts with a source buffer. A good compiler is built from several parts, but in general 90% of all parsers/compilers have the following modules:

• Buffer class
• Tokenizer / Lexer
• Parser
• Code generator (“codegen” or “emitter”)

The buffer has a single job and that is to provide methods to chew through the source-code as fast as possible. But there is a rule, namely that accuracy and readability should never be compromised over speed. So in this “brief introduction” I have written a buffer class which implements only the basics. And it goes a little something like this:

 

type

  TQTXBuffer = Class(TObject)
  private
    FData:    String;
    FIndex:   Integer;
    FLineNr:  Integer;
  protected
    function  getCurrent:String;virtual;
  public

    Property  LineNr:Integer read FLineNr;

    Property  Current:String read getCurrent;
    Function  Back:Boolean;
    function  Next:Boolean;
    function  BOF:Boolean;
    function  EOF:Boolean;

    function  ReadTo(Const aChars:array of string;
              var text:String):Boolean;

    function  ReadWord(var Text:String):Boolean;

    function  ReadToEOL(var text:String):Boolean;

    function  PeekAhead(aCount:Integer;var Text:String):Boolean;
    function  Compare(aText:String):Boolean;

    procedure LoadFromString(Text:String);

    procedure Clear;
  End;

//###########################################################################
// TQTXBuffer
//###########################################################################

Procedure TQTXBuffer.Clear;
begin
  FData:='';
  FLineNr:=1;
  FIndex:=0;
end;

procedure TQTXBuffer.LoadFromString(Text:String);
Begin
  FLineNr:=1;
  FData:=trim(text);
  FData:=StrReplace(FData,#10,#13);
  FData:=StrReplace(FData,#13#13,#13);
  FIndex:=1;
  if length(FData)<1 then
  FIndex:=-1;
end;

function TQTXBuffer.getCurrent:String;
Begin
  result:=FData[FIndex];
end;

function TQTXBuffer.ReadWord(var Text:String):Boolean;
begin
  result:=False;
  Text:='';
  if not EOF then
  begin
    repeat
      if (current in ['A'..'Z','a'..'z','0'..'9']) then
      Text += current else
      break;
    until not next;
    result:=length(Text)>0;
  end;
end;

function TQTXBuffer.Compare(aText:String):Boolean;
var
  mData:  String;
Begin
  result:=PeekAhead(length(aText),mData)
  and SameText(lowercase(mData),lowercase(aText));
end;

function TQTXBuffer.PeekAhead(aCount:Integer;var Text:String):Boolean;
Begin
  if not EOF then
  Begin
    while aCount>0 do
    begin
      Text+=Current;
      if not Next then
      break;
    end;
    //text:=copy(FData,FIndex,aCount);
    //inc(FIndex,length(text));
    result:=length(text)>0;
  end;
end;

function TQTXBuffer.ReadToEOL(var text:String):Boolean;
Begin
  result:=ReadTo([#13,#10],text);
end;

function TQTXBuffer.ReadTo(Const aChars:Array of string;
         var text:String):Boolean;
var
  x:  Integer;
Begin
  result:=False;
  text:='';
  if aChars.Length>0 then
  begin
    for x:=FIndex to FData.length do
    Begin
      //FIndex:=x;
      //if FData[x] in aChars then
      if (Current in aChars) then
      Begin
        result:=true;
        break;
      end else
      text+=text[x];

      if not Next then
      break;
    end;
  end;
end;

Function TQTXBuffer.Back:Boolean;
begin
  result:=FIndex>1;
  if result then
  dec(FIndex);
end;

function TQTXBuffer.Next:Boolean;
begin
  Result:=FIndex<FData.Length;
  if result then
  Begin
    inc(FIndex);
    if (Current in [#13,#10]) then
    inc(FLineNr);
  end;
end;

function TQTXBuffer.BOF:Boolean;
begin
  result:=FIndex=1;
end;

function TQTXBuffer.EOF:Boolean;
begin
  result:=FIndex>=FData.Length;
end;

Using the buffer class

The buffer class allows you to move horizontally through a source file, meaning that whatever file you load into the buffer, is regarded as a long string. No matter what the formatting may be, that’s the reality of writing a parser.

Here is a small example that can help you get an understanding about how the buffer works:

procedure TForm1.W3Button1Click(Sender: TObject);
var
  mBuffer:  TQTXBuffer;
begin
  mBuffer:=TQTXBuffer.Create;
  try
    // Set source into buffer
    mBuffer.loadFromString(
      #"program(test) {
        criteria (*) {
          test > 0;
        }
      }");

      // traverse through the buffer char by char
      repeat
        writeln('-->' + mBuffer.Current );
        mBuffer.Next;
      until mBuffer.EOF;
  finally
    mBuffer.free;
  end;
end;

Of-course, that just baby-steps when it comes to parsing. You sort of have to build the language rules into the parser class (not the buffer class). For instance, N++ expects the first word in a program to be “program”, followed by a name enclosed in “(” and “)” brackets, followed by “{” and “}” structural segments.

Here is a simple N++ program:

program("hello world") {
  handshake {
    input  { void; }
    output { void; }
  }

  execute(*) {
    writeln("hello world");
  }
}

Parsing this is very, very simple – as is creating the abstract symbol tree. N++ will be a great automation language, one which you can easily place on top of other technology. Take animations for instance.. or tweening. Wouldnt it be nice to have a language you could write effects in? One which is easies than the mess which is javascript?

Well by implementing a language module in JavaScript for N++, you can use N++ to control animation, effects, tweening or whatever you fancy. My personal favorite is databases and data management for nodeJS, but that’s me 🙂

The parser

In my next post we will look at the parser class and also add a lexer, which makes it “sane” to parse large structures and programs.

About N++ what is it?

N++ is a language designed to deal with big data, and I mean “BIG” data, terrabytes of records.

It’s a RISC type language, meaning that it has a reduced instruction set, and it’s designed to get the most amount of work done with the least amount of typing.

The benefits of N++ is:

• Data sculpting (creating new structured by joining old structures)
• IO is based on mapping
• Easy to use, easy to learn, easy to adapt to underlying processes
• Runs off nodeJS, designed for nodeJS and is written in JavaScript

What is mapping?

In short, mapping allows you to pre-define the IO channels that your N++ program should use. So instead of creating classes for streams, pipe’s and whatever — N++ simplifies this through a collection of mappings, called a “handshake”. For instance, if you plan on writing the “hello world” example above, you need to include stdout in your handshake under the output section, like this:

handshake {
  output {
    stdout => system.io.stdout;
  }
}

A mapping is a shortcut. Instead of having to write system.io.stdout.writeln() every single time, we create an alias called “stdout” locally (read: visible to our code) that we can use instead.

The handshake also serves as a means for the compiler to know precisely what your code uses, and what channels should be reserved.

The input handshake is the same, but with a reversed arrowhead (=> means “data into right”, and the arrowhead <= means "data from right into left".

Other differences

Quite a few! For instance the IF statement is very different, it's called "criteria" and looks like this:

program("test") {
  handshake {
    output {
      stdout => system.io.stdout;
    }
    input {
      params <= application.params;
    }
  }

  execute (*) {

    /* Check if the command-line param "test" and "beta" are true
    criteria (*) {
      input["test"] == true;
      input["beta"] == true;
    } execute {
      stdout.writeln("test and beta params were passed!");
    } fail (e) {
      stdout.write("Something was wrong!:");
      stdout.write(e);
      stdout.write("\n");
    }
  }
}

In the above, the code inside the criteria { } section must evaluate to TRUE in order for the appended EXECUTE section to actually execute. Should the criteria fail then the "fail" section is executed instead.

Oh and the for/next stuff is gone alone:

program("test") {
  handshake {
    output {
      stdout => system.io.stdout;
    }
    input {
      params <= application.params;
    }
  }

  execute (*) {

  var string[] test = new string[10];
  var int x = 0;

  process(test, mItem) {
    mitem = format("this is string #{0}",x);
    x++;
  }

  }
}

The keyword "process" will process anything which has depth, from bottom to top (lower to higher). So it takes the role for both for/next do/while and repeat/until.

Anyways — loads of fun stuff if you like playing with programming languages.
I'll post the full code for N++ when i'm done.

Introduction to N++, a process oriented programming language

For some time now I have been working on implementing various programming languages; writing parsers, sub parsers and dictionaries. To date these languages have been well-known languages, like pascal, visual basic and (to some extent) a subset of C#.

Programming languages are typically born out of two schools of thought: pure necessity, or just good old fun. I remember reading about the E programming language when I was a teenager for instance, which is a language that looks quite impressive – but serves little purpose. To be blunt: it doesnt give you anything in particular in terms of actual tools or advantages over, say, any other language out there.

And then there are languages which are just a complete waste of time, like brainfuck and it’s derived mathematical madness. If your idea of fun is jumping butt-naked into an inverted number generator (read: PI) – then by all means, brainfuck is your language. But for the rest of us — perhaps something more tasteful and useful is in order..

Presenting N++

N++ is a language I am designing at the moment (N stands for Nandi, Shiva’s ox), or adding partial support for in the Quartex IDE. While I cant cover everything in a single blog post (and certantly not at this hour), I can present some concepts you may find interesting.

N is a language designed to collect, process and distribute data in large quantities; hence the strong power of the oxen Nandi. It belongs on the server, although there is no reason why you cant use it from inside a desktop application or as a service.

Let’s start with the classical hello world:

program ("hello_world") {
  handshake {
    input  { void; }
    output { void; }
  }

  execute(*) {
    writeln("hello world");
  }
}

Let’s look at the program in broad terms. Since most of you are programmers you probably have some idea what is going on in the above code. The [pre]program()[/pre] block defines that this textfile is indeed the program file (as opposed to a module). All programs can only have a single program file, but as many modules as you like.

Next comes the handshake. Now this is a very handy (pun intended) subject. What it does is define the input the program can expect (or demand) as well as the output. In the above example we dont expect anything and we dont deliver anything, so both input and output is set to void.

The heart of this little program is within the execute block, where we use the method “writeln” to output the text “hello world”.

If you are wondering what the * character means inside the brackets, that section is called the data-view. In essence the * character means “what is known to the parent object”. In this case the parent is the program itself, which means that all global variables and objects should be regarded as known (or inherited into the scope).

Feedback loop

While hello-world is always fun, let’s do something a bit more complex. Let’s write a program that accepts X number of text arguments from the command-line, and then prints it back out again:

program ("feedback") {
  handshake {
    input {
      string arguments[];
    }
    output { void; }
  }

  criteria (*) {
    arguments <> null;
    arguments.length > 0;
  } execute {
    process (arguments,item) {
      writeln(item);
    }
  }

}

As you can see this example defined a typed handshake, where it expects to receive an string array as input. Since the program or module doesn’t produce anything, the output is again set to void (meaning “nothing”).

The criteria() section is probably the closest thing you will get to an IF statement in N++, what it does is validate X number of conditions, if they result in true the execute block is executed. You can also have an optional “fail” block to deal with scenarios where the criteria are not met.

The process() method is N++ variation of a FOR/NEXT loop. What it does is process the content of an object one-by-one and apply whatever code is inside it’s block on the data. As you can see from the parameters the arguments array from the input is the data we want to process, and as our second parameter we have a variable representing the current item.

Chainable criteria

One of the cool aspect of N++ is that you can chain these code blocks in various patterns. For instance you can chain process() and criteria() as such:

criteria {
  /* do not execute unless list has items */
  list.length>0;
} process (list,item) {
  /* do something to each item in the list */
} fail (e) {
  /* Criteria not met */
  writeln(e);
}

Or, apply criteria per item:

process (list,item) {
  writeln(item);
} criteria {
  /* Skip all items which does not begin with "jo" */
  item.firstname == "jo*";
}

Dynamic structures

While looping through data is fun, it’s not really something new. But being able to shape known data from various sources into new structures is extremely handy, especially for web services. Again it’s not a novelty – but here it’s a fundamental aspect of the language itself:

module ("data_export") {
  handshake {
    input  { void; }
    output { object[]; }
  }

  define dbConn as database("myDB@localhost:8090;user:admin;password:adminpassword");

  execute(dbconn) {
    collect ["users,"info"] from dbConn as data;
    set output = build(data,smAscending) {
      uid:      users.UID;
      username: users.userHash;
      password: users.passHash;
      fullName: info.fullName;
    }
  }
}

The above introduces a couple of new concepts. First there is the “define” keyword, which defined a data-source. In this case we associate “dbconn” as a database which we can obtain information from. By default N++ regards all types of data as either a single object, an array of object or a dictionary of object. You may also use an array as a dictionary – at which point the array object is transformed into a dictionary.

The collect() method does what the name implies, namely to collect data from a data-source, in this case we grab all the records from two tables (users and info) and stuff those into a named container (data).

And finally a magic method, namely the “build” function. In this case we create a completely new structure which will be sorted ascending — and then we map fields from the data-source(s) into the new structure.

When emitting JSON what this module returns is:

[
{
"uid": "1239094",
"userName": "AF965BF1274CCE1",
"passWord": "C009A6487BC120E",
"fullName": "Jon-Lennart Aasenden"
},
{
"uid": "987351",
"userName": "BF982737CD00A92",
"passWord": "AF965BF1274CCE1",
"fullName": "John Calvin"
},
{
"uid": "670941",
"userName": "09F9CA1BF982737",
"passWord": "4CCE1986CDE00AF",
"fullName": "Dave Jones"
}
]

The general idea here ofcourse, is that threading and multi-processor programming should be equally simple. If you have 10 million records and try to join them into a new structure like above, chances are it will take forever before the method returns. In fact, it may even break your database. But for ad-hoc amounts of data, threading it makes sense:

  background-execute ("user-export",tpIdle, => (*) {
      /* Anonymous procedure callback handler */
      signal.send([*].process.owner,MSG_NOTIFICATION,"$DB-EXPORT-READY");
      } ) {
    collect ["users,"info"] from dbConn as data;
    set output = build(data,smAscending) {
      uid:      users.UID;
      username: users.userHash;
      password: users.passHash;
      fullName: info.fullName;
    }
  }
}

In short: when the data export is done and the data is delivered as the module output, a signal is sent to the owner process, of type “notification” with a string message saying that the export is complete.

Expanding the idea

The idea behind N++ is that a language designed exclusively to process data, working with stores (which in this case can be any linear flow of data-items, such as a database table, a folder with files, a text-list or any other vertical media) will be able to take shortcuts traditional languages cannot.

As of writing, N++ is barely out of the idea stage, with only the bare-bones parser and AST implemented, but already we are able to cut corners that are, in computing terms, quite costly.

Take the “IF” statement for instance. In any procedure involving more than 2 variables, you end up writing criteria testing at the beginning of the procedure:

function TMyService.DoSomething(a,b,c:Float):Float;
Begin
  if (a>1.0)
  and ( (b<1.0) and (b>0.0) )
  and (c>0.0) then
  begin
    result:=A * B - C;
  end else
  Begin
   //raise exception
  end;
end;

Which can be more cleanly expressed through n++ direct approach:

method doSomething(demand a,b,c) {
  criteria {
    a > 1.0;
    b < 1.0;
    b > 0.0;
    c > 0.0;
  } execute {
    output float(a * b - c);
  } fail (e) {
    /* express error */
  }
} breach {
  /* parameter contract not met */
}

As you can see from the above code, N++ have some new concepts such as contract based interfaces. The interface of a procedure defined the syntax and expected input (as it does in all languages). This must not be confused with COM interfaces, as interface in this context is refering to header (as in C’s .h file). Object pascal doesn’t need a separate header file like C, since the syntax provides an interface section at the top of a source-file.

N++ doesnt even need that, and it can even (much like javascript) allow calling methods and modules without correct parameters. This is called a breach-of-contract and can be caught much like any error.

Contract based programming is not just limited to data-mapping, but is also used in parallell programming and cluster programming where invocation of a method can be done across the domain. All invocations are actually sent as signals within the cluster and workload can be distributed across several computers (nodes).

While that is not something I have even begun sculpting, putting it into the foundation of the language is important.

Well, I’m off to bed — it’s been a long day.

DelphiArmy.com is now a reality

Well I guess congratulations are in order – we, the object pascal community now have our very own job service! Today I bought the software, database and hosting solution, which means that in a matter of days you will be able to visit delphiarmy.com and register as either employer or developer!

The service is global, meaning that it can be used by anyone, be they European, American, from the Middle-East, Africa or Asia. The server was setup yesterday (16 december), the DNS pointer is being set today, add a couple of days tuning, and it will be online

Welcome to the #1 site online for Delphi work

To date I only know of a single website which promotes Delphi jobs, somewhere in France, so for all means and purposes DelphiArmy.com will be the #1 site for object-pascal developers to look for work; and for companies to find serious employees with a solid background in pascal software development.

• Delphi
• Delphi .net
• Smart Mobile Studio
• Remobjects Oxygene
• FreePascal / Lazarus
• DWScript
• Remobjects Pascal Script
• InnoSetup
• C++ Builder

Features for developers

You will be happy to know that you can both upload your resume (or create one directly on-site), and also connect to your linked-in profile. This should be a great time-saver. Personally I hate having to fill out the same CV on X number of websites. Well, if you already have a nice linked-in profile you can import that.

Video presentations are likewise possible, but I have yet to decide if this should be allowed due to storage concerns.

In short: all the features you would expect from a professional job portal is in place.

• Upload resume files
• Linked-In support
• Great search functionality
• Online CV builder
• Video presentation
• Recommendations
• Email notification
• Very reasonable registration fees (one time only)
• Mobile app (in progress)
• .. and more

I will also write articles about remote-work, what you need and what you should expect when applying for positions in Norway and Scandinavia at large. Similar articles will be provided for North-America, the Middle-East (Dubai) and Asia.

Features for Employers

• Option for making your position features (front side spot)
• Head-hunting services
• Very reasonable fees (access subscription options).
• Full access to our database of registered developers
• Developer Feedback option
• Email notification
• .. and more

Your support

I hope I have your support in this endeavor, that you will take the time to register with the service and use it. While you may have a steady job right now, you might be open for weekend work? Perhaps your life will change in six months and you will be looking for a new job. It makes sense to register, both for the community and yourself.

There are thousands of companies, both large and small, using Delphi on a daily basis around the world, sadly each of them live on their own ant-hill and have for some reason stopped talking to each other. Well, let’s get organized and start talking again. And like all great things in life, it begins with someone backing their ideas with action.

Investing in object pascal

As mentioned there are thousands of companies involved with Delphi around the globe. Many of them are maintaining legacy systems, many of them are developing new products – while others express insecurity if Delphi is worth investing in. Now one of the factors which has led to such thinking, has to do with visibility of Delphi (read: object pascal in all it’s forms) in the marketplace and more importantly: the availability of professional Delphi programmers.

Delphi and object-pascal in general has no “official” organ which takes care of promotion and/or open job positions. As a result people have no clue where to look, and end up using local newspapers or recruitment agencies. Until now there havent been a place where employers could reach out to find quality personnel fluent in Delphi. But what they do find are portals dedicated to Java, C#, even PHP and Ruby jobs.

As an example, the company I work for which is one of the biggest in Norway, have spent months trying to find a high-quality Delphi developer for their POS department. It took me less than 2 days to get them 20+ CV’s from professional Delphi programmers. Why? Because I know where to look. I also run Delphi Developer on Facebook with more than 2.600 active members, which I built exactly for that purpose: to get active people talking and working together.

So both employers and developers are there, in the thousands — we just need to connect them.

Sincerely

Jon Lennart Aasenden

Delphi programmer wanted

The company I work for, Visma AS, which is one of the biggest and most prestigious companies in Scandinavia is looking for a Delphi developer.

VISMA AS

Working remotely is ok, but with some criteria regarding availability during Norwegian office hours. Visma is a large and stable company offering competitive salaries and excellent benefits. As a company we are known for our high-standards.

Requirements

You must master Delphi well, not be afraid of low-level programming and be used to documenting your work. You must know your way around SQL server and preferably have some background in POS (point of sale) devices. And naturally, being fluent in English is a must.

Target platform is Win32/X86; Delphi application running on Windows XP Embedded.

Interested programmers can contact me on Facebook or send your CV to “jon.lennart.aasenden AT visma.com” – and I will forward your information to the Delphi department.

Sincerely

Jon Lennart Aasenden

Senior Software Engineer
Visma Retail Software AS

NodeJS service builder, progress

Being sick on thursday and friday cut heavily into my plans, and I have the kids this week, so naturally we have enjoyed ourselves with a trip to the movies, catching up and playing. So kids first, and coding second, which means that I was unable to complete this as planned.

Either way, I should be able to finish the boring stuff by next weekend I hope. Which means the data-model and XML IO should be done for the project (and yes, that is falling asleep boring, joining a monastery boring; moving to Tibet to live as a goat kind of boring). Well you get the picture..

My desktop as of writing

But with the data-model behind us there is only the cosy stuff left to play with, which means the various code generators (read: export classes). Out of the formats I have selected WSDL from Microsoft is probably the hardest to match, not through XML or anything like that – you have to remember that the generated code should also work (he he), not just look pretty. And that means all the colossal, fat and bloated XML Microsoft managed to byte-rape the RPC protocol with, has to be parsed and supported to the best of my abilities.

But word of warning, if it’s to boring I will bin the damn thing and focus on JSON, which I find much more interesting and lightweight. WSDL is not just for calling a remote procedure on a server somewhere, it also includes support for dataset updates and a hell of a lot more. Hence the moral ambivalence towards that standard from my point of view, because it’s utterly overkill (especially if you use the TW3Dataset for Smart Pascal).

Rest and namespaces

I have been thinking a lot about how to organize the different standards. I mean, RPC (remote procedure call) is not really REST is it? There is sort of a paradox at work here, because RPC can use REST as it’s organizing principle, but can we also say that REST is RPC? No we cant.

Anyways, namespaces make their debut when we start talking about JTLB (JSON type libraries), which is my personal take on how a RPC service system for nodeJS should look like. And yes, namespaces are there exactly because that’s how rest differienciate between calls and services.

For instance, let’s say you have a library (read: collection of services) called snaptalk which exposed 3 services:

• loginAPI
• messageAPI
• StorageAPI

The loginAPI (yes, I use small caps in the first word, because that’s how things are done with JavaScript) exposed the following methods:

• function login(username,password:string):TLoginResult;
• procedure logout(sessionid:String);

If you have your nodeJS library running at 127.0.0.1 (localhost) on port 8090, then the URL for the login method will look something like:

http://127.0.0.1:8090/snaptalk/loginAPI/login

Where the parameters are sent as HTTP-POST fields:

<sessionid>REQUEST</sessionid>
<username>admin</username>
<password>shrødingers</password>

In the above case, “snaptalk” which is the name of the library you are exposing (I might find another name for that later, since library in this context doesnt quite hit the mark) — and so it’s naturally to use “snaptalk” as a namespace identifier.

Should I create a cluster architecture later, where one server is able to delegate work to various threads, then each machine in the cluster (virtual or real PC) running a server, would be differientiated either by library-name (“snaptalk”)…

Or, perhaps, add machine name first?

http://127.0.0.1:8090/www/snaptalk/loginAPI/login

Well, I’m giving you the option to use both, so at least you can add a namespace or just use the default library name. That at least gives me room to expand the model later without ruining anyone’s work.

nodeJS, Smart Mobile and WinAPI services unleashed

Oh man this has been quite the week, so much stuff to share that I hardly know where to begin! First of all, I have fallen absolutely in love with nodeJS. And when you see what this little puppy can do, I think you will too. Secondly, the tools I am working with now are so far beyond anything we have in the Delphi camp – that I cant wait to blow your mind utterly with what Smart Mobile Studio will be capable of.

First, services

nodeJS rocks!

As a die-hard Delphi programmer you have probably coded a few Win32/64 services in your day right? Delphi is an excellent tool for writing services – most of all because it allows you to fall back on the rich wealth of components the world of Delphi contains. Yet as you probably know, writing good services is a black-art. It’s time-consuming and very, very tedious.

Well hold on to your hat because with nodeJS you will be able to write fully operational windows services using nothing but nodeJS and Smart Mobile Studio (read: object pascal).

The magic is simply a matter of installing nodeJS (the standard installation). This gives you access to the command-line V8 executor, which you use to execute your smart pascal compiled JavaScript code. Why do that from shell you say? Well, because nodeJS is basically JavaScript outside the browser. Forget everything you know about JavaScript, the “DOM” and everything else. Strip the DOM from the language utterly – and what you are left with is a very flexible scripting engine.

Next, you install the magic package called “node-windows”, you install this with the npm package manager that comes with nodeJS (so it’s a normal shell command).

Once installed, you can start writing code which runs as a service. Yes you read right, you can now write fully fledged WinAPI services using Smart Mobile Studio and nodeJS.

This means that if you write a little REST or RPC server, which is trivial in the Smart Mobile Studio nodeJS project — you can have this puppy run side-by-side with all the other services. Let’s just clarify how awesome that is:

• Smart Pascal code will run in the cloud with no dependencies
• Smart Pascal code will run as a windows service

In other words, you can now write code which is designed to run anywhere — be it cloud based on locally on your physical server machine. Add the package “node-mysql” or “node-mssql” to the mix and you pretty much have everything you need to write the entire backend in Smart Pascal — and deploy locally first — only to deploy it without change to Azure or Amazon when the need to scale becomes real.

Here is the bootstrap JS code which installs your nodeJS compiled code as a Windows Service. Dont worry, we will wrap all of this in pascal syntax later on – so you dont have to mess with it.

var Service = require('node-windows').Service;

// Create a new service object
var svc = new Service({
  name:'Hello World',
  description: 'The nodejs.org example web server.',
  script: 'C:\\path\\to\\helloworld.js'
});

// Listen for the "install" event, which indicates the
// process is available as a service.
svc.on('install',function(){
  svc.start();
});

svc.install();

I am so totally high on this right now, because I can now write code in 1 hour which would otherwise take me 2 days to complete in Delphi alone. Being able to write service applications, not to mention real executables with nodeWebkit, opens up a whole new world for Smart Mobile Studio.

But more importantly, it opens up a whole new world for object pascal programmers!

Delphiarmy, the place to find cool jobs

This is a plan I have worked on for a while. It is born first and foremost out practicality – because let’s be honest, Delphi developers are in high demand these days, but we are in much smaller numbers than JavaScript and C# programmers. So as a Delphi developer it’s hard to find work due to the lack of an official organ taking care of these things, and secondly it’s very frustrating to be an employer because locating good developers is tough enough, but finding an awesome Delphi developer can be the proverbial needle in a haystack.

Want a Delphi job? Well that is going to become much easier!

So, I want to present the upcoming object pascal job portal, humbly named: Delphi Army (www.delphiarmy.com). The website is not yet operational, but in a couple of weeks you can register and secure that job easier than ever before.

Delphi Army

For the past two years I must have gotten at least 25 phone calls from small and large companies who want to hire my services. But since I already have a full-time job, and Smart Mobile Studio on the side – I have had to decline them all. Even though many of them had excellent benefits and solid wages (even by Norwegian standard, which are the highest in the world).

Well, I have decided to do something about this and bought http://www.delphiarmy.com a while back. It will function as a hub for employers looking for Delphi programmers. The organization will operate more or less like manpower — except with a much lower cut (Manpower takes as much as 50% which is ridicules, DelphiArmy will settle between 25% which is very reasonable).

How does it work?

Developers register for free, including uploading their CV and presenting themselves and their previous work. Employers looking for expertise log-into a special portal on the website, where they can register their needs and what qualifications the candidate must meet.

All object pascal, in one place

We then pick the candidates matching the criteria, or at least those that comes closest to the needed expertise, and present you to the company in need of your skills.

If they accept you as a candidate (taking location and other details into account), they sign a hiring contract for the duration of the project with DelphiArmy — and you are given the job. You will receive your paycheck from DelphiArmy (we deduct 25%), which we receive from the employer.

Headhunting services will also be available for employers for a fee.

Is it Delphi only?

No. As we all know object pascal expands way beyond Delphi, which is a single product in Embarcadero’s portfolio. Smart Mobile Studio is becoming increasingly important as object pascal developers get to grips with HTML5/JS and nodeJS server programming. Not to mention the fact that more and more hardware runs JavaScript by default (such as micro-controllers and embedded boards). Espruino being a prime example of a SOC (system on a chip) controlled by nothing but JavaScript.

Freepascal is likewise an important piece of technology, one which is behind a multitude of object pascal projects around the world. It is also important because it represents an alternative to Delphi itself, generating faster and more optimized code for nearly every platform in the marketplace (even Nintendo, PlayStation and XBox). In-depth knowledge of FPC and a solid grasp of Lazarus for building rich, platform independent solutions is a great skill.

Remobjects Oxygene, which is the technology previously shipped with Delphi to cover the dot net platform, is likewise an important piece of the marketplace. Good knowledge of the dot net framework is essential when working with Oxygene, but for those that wish to build and run their applications on Microsoft’s platform -or Mono for other platforms (that may change very soon since Microsoft has open-sourced the entire framework, including compiler).

Here is how the technologies can be summed up:

• Delphi classic (Delphi 7 – 2009)
• Delphi modern (Delphi 2010 – XE7 and beyond)
• Delphi Mobile development
• Delphi OS X development
• Smart Pascal HTML5
• Smart Pascal nodeJS
• Smart Pascal Embedded
• Freepascal / Lazarus Windows
• FreePascal / Lazarus Linux
• FreePascal / Lazarus OS X
• FreePascal Embedded
• Remobjects Oxygene

Secondly there is knowledge of the various RTL’s, which is perhaps just as important to an employer as is the technical skill to write good code. A candidate versed in the dot net framework will be almost useless in the VCL environment, and visa versa;

• VCL – Delphi’s classic run-time library
• FMX – Delphi’s platform independent run-time library
• LCL – Lazarus and Freepascal component library
• VJL – Smart Pascal’s run-time library
• NJL – Smart Pascal’s nodeJS framework units
• NET – The dot net framework (Oxygene Pascal)

Being able to master various techniques is likewise an aspect of programming which is important to expose to an employer

• Generics for Delphi
• Generics for Freepascal
• Anonymous methods, variables, fields for Smart Pascal
• Lambdas for Smart Pascal
• Assembly / Machine code x86 / ARM

Being able to write modular, maintainable solutions across platforms which adapts custom adaptation is a skill-set very sought after; both visual and non-visual components alike:

• Creating custom controls for Delphi
• Creating custom controls for Freepascal / Lazarus
• Creating custom controls for Smart Mobile Studio
• Creating custom controls for Oxygene / .NET

Then there is types of executables, which to present date can be summed up as:

• Windows Services, Linux Daemons, OS X Helpers
• Windows DLL, Linux .so, OS X .dylib
• Windows COM libraries and typelibrary generation
• Windows COM server initialization and use
• RemObjects Hydra
• RemObjects SDK service containers (.dll)

And various standard Delphi project types

• REST client/server
• ISAPI modules
• Apache modules
• Multi-lingual projects in Delphi

And last but not least, being able to work with standard object pascal third party technology is a must, no matter what compiler or framework you provide services for:

• XML binding
• SecureBlackBox XML signing
• CryptoAPI XML signing
• Bluetooth API
• XSLT schemas and validation
• Developer Express controls
• TMS Aurelius
• TMS grids and controls
• mORMot  object relation mapping framework
• RemObjects SDK
• RemObjects Data Abstract
• Datasnap with Smart Mobile Studio
• Remobjects SDK with Smart Mobile Studio
• TClientDataset caching and update mechanisms
• ElevateSoft’s DBISAM
• ElevateSoft’s ElevateDB
• MySQL, MSSQL, Oracle, Interbase / Firebird
• FastReports, Crystal Reports, Report Server
• DirectX
• OpenGL
• WDOSX embedded framework
• GSM modem technology
• Smart card technology

All the above sections are each areas which is of interest to an employer, including what debug or error management framework you use (logging to file or Windows log is also valid, but the more depth you as a developer can describe and back up with knowledge, the better).

The important thing is to present factual information, because you will be tested. And candidates lying or otherwise miss-representing themselves, will never work again through DelphiArmy.

I live in country xyz, how can I remote work in Norway?

Most companies that deal with outside employees have strict guidelines regarding contact and availability, and it’s important that these are meet. The majority of companies I have worked with, either here in Norway or in the states, will typically start the day with a 15 minute scrum meeting on Skype to set the agenda.

You are expected to know your way around SVN, GIT, and other tools of the trade. It’s imperative that you speak english and that you at least write english which is coherent (some languages have a tendency to present conclusion before the deduction, which can be hard to understand in english).

Most companies also demand that you can be reached by phone, Skype and email during work-hours, this can be tricky if you live on the other side of the globe, but after a period of time when the employer sees results, most give you some freedom regarding contact – reducing it to being able to contact in case of an emergency.

Well, I hope this is good news for everyone. I am presently busy picking out the website software, which will include more than just work — it will also host forums and a web-shop, so stay tuned!

Things are about to get a lot better for all of us 🙂

Delphi for dot net unit

I had a rather long discussion with several members of Delphi developer (Facebook) the other day, mostly in response to be becoming a full-time C# developer (and Delphi developer of-course, that’s not gonna change).

Although we started with debating C# and differences between native object-pascal versus the “curly languages” in general, I ended up saying something that clearly bugged a few, namely: We can actually implement the dot net framework as an alternative to the VCL, written in Delphi itself. There is no technical limitation against it, and it may even benefit object pascal in general – as younger developers are more familiar with dot net than they are the VCL or VJL.

As you probably guess that spawned some interesting comments (nothing bad, important to underline that) – most of the comments along the lines of the task being pointless, technically difficult or just plain impractical.

My reply to this is that you are all wrong (he said with a smile).

First of all, it is not more impractical to use clone of the most evolved, modern run-time-library (framework) than it is to use the VCL. Delphi is in reality suffering great injustice due to the in-grown identification of product, language and RTL as one and the same. In fact, many people are completely spellbound by the concept of object pascal being “Delphi”, that they cannot for their life imagine object pascal with a new RTL.

This is something I have had first-hand experience with, since I wrote the RTL for Smart Mobile Studio and was the first to experience the wave of feedback from both happy and unhappy users. Dont get me wrong, I absolutely love the VCL; It’s component model and class hiearcy has stood the test of time. It scales well, it’s agile – and all the other words we use to describe a living product.

Technical difficulties

Secondly, it is no more a technical challenge to implement the .net framework and use that instead of the VCL – than it would be to write the VCL to begin with. The factor which matters in this case, as it is with software development in general, is time.

But this statement does have some merit, since it’s only recently that object pascal (both Delphi and FPC) have evolved it’s RTTI functionality. This was a requirement to bring generics and “C++ and C#” type RTTI access and management to Delphi. And as always the FPC group followed suit – which we should be thankful for.

The only technical challenges that requires a fair bit of research and testing can be isolated in 3 groups:

• Fundamental differences in serialization
• Object life-time differences
• Native code lacks the ability to emit reflection and alter itself at runtime

Why do it at all?

And last but not least, to the question of why; The answer is that the dot net framework has quickly become the dominant framework. People like to believe that C++ is in the lead here, or even JavaScript which tops the code evolution charts, but that is not the case. The dot net framework is used by millions of programmers every single day, both young and old alike. No other framework has the same level of exposure; Microsoft has successfully installed their framework onto every Windows PC on the planet – and with their recently announced “open source” initiative — the dot net framework will become and important part of Unix, Linux and OS X.

Being able to offer customers a framework they already know – but with a twist: namely that it compiles to native code, fast, relentless and which is emitted as a single executable — is more effective than presenting something utterly alien to young programmers. The same can be done with ordinary .net or mono apps through the executable image tool – which generates a single .exe with no dependencies of your C# code.

Porting over important libraries from C# becomes substantially easier if at least a subset of the dot net framework can be mapped to C# in 1:1 fashion.

C# lacks many of the features which makes object pascal so attractive; A native dot net “clone” RTL, which would replace the VCL completely, would benefit from many of the already existing VCL classes — and also from the language features unique to object pascal.

Proof of concept

To make a long story short; I have implemented a handful of the fundamental dot net classes. I have only spent an afternoon on this, so dont expect miracles, but at least it implements the basic .net serialization engine (the .net framework actually has 3 engines for serialization, few people are aware of that).

And to be frank, it’s already so much more easier to use than vanilla VCL. Now dont start a flame-war because of that statement. I love the VCL and use it every single day — but one of the more time-consuming tasks I can think of, is to write persistent code (if your components expose fields of a non-standard datatype).

A second nail in the proverbial coffin is that Delphi’s persistence is exclusively binary. A lot of frameworks have alternatives for this, like mORMot, Remobjects and TMS’s Aurelius (which I really love, since it’s purely attribute based), but vanilla object pascal as delivered by Embarcadero still ships with TPersistent which havent evolved since it’s inception ages ago.

C# and other .net languages have built in serialization out of the box. It’s a very simple form of serialization, but due to it’s decoupled nature – where property identifier is separated from property data (so you can emit XML text to a binary medium) it’s very effective.

It’s also fully automatic, unless you explicitly turn it off. So under C# you can write a “normal” class as such:

/* Bog standard class. We inherit from ISerializable,
   and we also tag the class with the "Serializable" attribute */
[Serializable()]
public class TMyClass: ISerializable {
  public int Value { get; set; }
  public string Name { get; set; }
}

The above is identical to this object-pascal code. The VCL rule for persistence is that only published properties are automatically persisted by the VCL, and the property must be a non-complex type (e.g “standard datatypes like integer, string, double and so on). The problem is that you will only be able to load and in Delphi’s custom binary format, which makes it so much harder to work with high-end, industry standard, enterprise level solutions.

In the world of enterprise computing, methods typically take serialized objects as parameters. So instead of shipping in a ton of parameters – you ship in one string which contains an object exposing whatever properties you need.
Delphi does have such a system, buried deep with it’s RPC (remote procedure call) units — but the binary data cannot be made any better. It’s just base-64 encoded.

TMyClass = Class(TPersistent)
private
  FValue:Integer;
  FName: String;
Published
  Property Value:Integer read FValue write FValue;
  Property Name:String read FName write FName;
End;

As you see from the C# code example, C# has adopted anonymous field declarations. Meaning that you dont define a property field (the actual field to hold a property’s value) by name. It remains anonymous and you simply access the exposed property name. This is a great time saver and it makes sense when you think about it. Smart Pascal implements this, so as of writing SMS is the only object-pascal compiler which allows you to write near identical pascal which maps directly to C#. It also does this without importing weird C++ syntax (let’s face it, generics sticks out like a sore thumb in Delphi). So Smart Pascal is in some ways closer to C# than BCPL; BCPL being the language pascal inherited many ideas from back in the 70’s.

Now when you want to serialize your object, which simply means that you are able to save all published properties automatically to XML, JSON, binary or whatever emitter is available, under C# you would just write:

void saveObjToStream(TMyClass mObject) {
  /* Use an XML serializer */
  XmlSerializer ser = new XmlSerializer(typeof(TMyClass));

  /* Setup target buffer */
  MemoryStream mBuffer = new MemoryStream();

  /* Setup our stream-writer */
  TextWriter mWriter = new StreamWriter(mBuffer);

  /* Save object instance as XML to our memory stream */
  ser.Serialize(mWriter, mObject);
}

Reasonably straight forward; easy and effective. Delphi’s old TPersistent may be faster due to it’s binary format, but Delphi is suffering because of the binary-only technology which VCL represents. It would be easy to fix this for Embarcadero, but I guess they are focusing more on FMX these days.

Right, with the core .net “object” class implemented (see code below) we are now able to do something very similar:

procedure saveToStream(mObject:TMyClass)
var
  mSerializer: TMSXMLSerializer;
  mBuffer: TMemoryStream;
  mWriter: TMSTextWriter;
Begin
  mSerializer:=TMSXMLSerializer;
end;

This is very different from how Delphi has traditionally dealt with serialization. TPersistent dispatches the job of writing data onto the component itself. This is very effective when dealing with large trees of objects and sub-objects (although stack hungry for very large structures). But be that as it may, Delphi’s TWriter and TReader is a binary affair from beginning to end. Which means Delphi serialization (as Embarcadero shipts it) cant play ball with the big-boys who exclusively use XML (even for parameters in DLL’s or ORMS).

Manual serialization

While the .net framework has the simple “automatic” serialization technique i demonstrated above, which is suitable for web services, databases and remote procedure calls — the .net framework actually has 3 different persistent serialization engines.

The second version is more hands-on and functions pretty much like Delphi’s TPersistent does. With one exception and that is a proxy object is used to register properties manually; This is where the TMSSerializationInfo class comes in.

When manually using this variation you simply derive a new class from TMSObject and implement the ISerializable interface. The system will then call on the GetObjectData() when needed to obtain a property dictionary, then that dictionary is used to either stream out RTTI information (the properties defined in the dictionary) or write properties to an instance.

Well, enough blabber from me — he is the “work in progress” code so you can see for yourself. I will probably finish it laster at some point, I am working on Smart Mobile Code at the moment.

unit qtx.system;

interface

uses
      System.Sysutils,
      System.Classes,
      System.rtti,
      System.TypInfo,
      System.Generics.Collections;

type

  EQTXObject  = Class(Exception);

  (* Exception classes *)
  EQTXObjectAlreadyRetained = Class(EQTXObject);
  EQTXObjectNotRetained     = Class(EQTXObject);
  EQTXObjectRetained        = Class(EQTXObject);
  EQTXObjectCloneFailed     = Class(EQTXObject);
  EQTXObjectRTTIQueryFailed = Class(EQTXObject);

  (* Forward declarations *)
  TQTXObject                  = Class;
  TQTXPersistent              = Class;
  TQTXSerializationInfo       = Class;
  //TQTXObjectPropertyInfo      = Class;
  //TQTXObjectPropertyInfoList  = Class;

  TCharArray = packed array of char;
  TByteArray = packed array of byte;

  IDisposable = interface
    ['{56714944-F3D0-43C9-8C4B-F2F00BA5F83D}']
    procedure Dispose;
  end;

  IRetainedObject = Interface
    ['{27B152DC-6553-4309-8C51-2B5C7D89A9EB}']
    procedure RetainObject;
    procedure ReleaseObject;
  end;

  ICloneable = interface
    ['{6BAB94D0-32B9-4C4C-9D71-4C88AA9E6D0B}']
    function  Clone:TQTXObject;
  end;

  ISerializable = interface
    ['{FAD5405E-34B8-4264-8F8D-EE2A0D257213}']
    function  GetObjectData:TQTXSerializationInfo;
  end;

  TQTXObjectPropertyInfoList  = Class;

  TQTXObjectPropertyInfo = Class(TObject)
  private
    FName:      String;
    FDataType:  TTypeKind;
    FParent:    TQTXObjectPropertyInfoList;
  public
    Property    PropertyName:String read FName write FName;
    property    PropertyType:TTypeKind read FDataType write FDataType;
    function    asString:String;
    constructor Create(Parent:TQTXObjectPropertyInfoList);virtual;
  end;

  TQTXObjectPropertyInfoList  = class(TObjectList<TQTXObjectPropertyInfo>)
  private
    FInstance:    TQTXObject;
  public
    Property    Instance:TQTXObject read FInstance;
    function    ToString:String;override;
    constructor Create(Instance:TQTXObject);reintroduce;virtual;
  end;

  (* IRTTIProvider = interface
    ['{6C3113DE-BAFD-46D1-9596-C1397991F02F}']
    function  queryPropertyInfo(var aList:TQTXObjectPropertyInfoList):Boolean;
    function  getPropertyValue(aName:String;var data;buffLen:Integer):Boolean;
  end; *)  

  ISomeThing = Interface
    function  queryPropertyInfo(var aList:TQTXObjectPropertyInfoList):Boolean;
    function  getPropertyValue(aName:String;var Data:PByte;buffLen:Integer):Boolean;
  end;

  TQTXObject = Class(TPersistent,IRetainedObject)
  strict private
    FRefCount:  Integer;
    FRetained:    Boolean;
  public
    function queryPropertyInfo(var list:TQTXObjectPropertyInfoList):Boolean;
    function getPropertyValue(aName:String;
             var data:Pointer;
             var buffLen:Integer):Boolean;
  strict protected
    procedure CloneProperties(aSource,aTarget:TQTXObject;
              Recursive:Boolean=False);

    class function ElfHash(const aData;aLength:Integer):LongWord;overload;
    class function ElfHash(const aText:String):LongWord;overload;

  strict protected
    Property  RefCount:Integer read FRefCount;
  strict protected
    { IInterface }
    function _AddRef: Integer;virtual;stdcall;
    function _Release: Integer;virtual;stdcall;
  strict protected
    procedure RetainObject;virtual;
    procedure ReleaseObject;virtual;
  public
    function CloneMemberWise(var aClone):Boolean;

    procedure Finalize;virtual;

    class function  ReferenceEquals(const ObjA,ObjB:TQTXObject):Boolean;
    class function  GetHashCode:Longword;reintroduce;
    class function  GetType:TClass;

    function  ToString:String;override;

    Procedure Free;reintroduce;virtual;

  public
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;

    Procedure BeforeDestruction;Override;
    Procedure AfterConstruction;Override;
  end;

    (* See: http://msdn.microsoft.com/en-us/library/system.runtime.serialization.serializationinfo(v=vs.110).aspx
       For member info
    *)
  TQTXSerializationInfo = Class(TQTXObject)
  end;  

  TQTXWriter = Class(TQTXObject)
  private
    FStream:  TStream;
  strict protected
    procedure   WriteBinary(const data;dataLen:Integer);
  public
    procedure   Write(value:Boolean);overload;virtual;
    procedure   Write(value:byte);overload;virtual;
    procedure   Write(value:TByteArray);overload;virtual;
    procedure   Write(value:char);overload;virtual;
    procedure   Write(value:TCharArray);overload;virtual;
    procedure   Write(value:String);overload;virtual;
    procedure   Write(value:Integer);overload;virtual;
    procedure   Write(value:word);overload;virtual;
    procedure   Write(Value:Longword);overload;virtual;
    procedure   Write(Value:double);overload;virtual;
    Procedure   Write(Value:Int64);overload;virtual;
    constructor Create(target:TStream);virtual;
    destructor  Destroy;Override;
  end;

  TQTXTextWriter = Class(TQTXWriter)
  strict protected
    Procedure   WriteText(value:String);
  public
    procedure   Write(value:Boolean);override;
    procedure   Write(value:byte);override;
    procedure   Write(value:TByteArray);override;
    procedure   Write(value:char);override;
    procedure   Write(value:TCharArray);override;
    procedure   Write(value:String);override;
    procedure   Write(value:Integer);override;
    procedure   Write(value:word);override;
    procedure   Write(Value:Longword);override;
    procedure   Write(Value:double);override;
    Procedure   Write(Value:Int64);override;
  end;

  TQTXReader = class(TQTXObject)
  end;

  TQTXTextReader = Class(TQTXReader)
  End;

  TQTXSerializer = Class(TQTXObject)
  public
    procedure Serialize(writer:TQTXWriter;const instance:TQTXObject);virtual;abstract;
    procedure DeSerialize(reader:TQTXReader;const instance:TQTXObject);virtual;abstract;
  end;

  TQTXXMLSerializer = Class(TQTXSerializer)
  public
    procedure Serialize(writer:TQTXWriter;const instance:TQTXObject);override;
    procedure DeSerialize(reader:TQTXReader;const instance:TQTXObject);override;
  end;

  TQTXBinarySerializer = Class(TQTXSerializer)
  End;

  TQTXPersistent = Class(TQTXObject,ICloneable,ISerializable)
  strict protected
    (* ICloneable *)
    function  Clone:TQTXObject;
  strict protected
    (* ISerializable *)
    function  GetObjectData:TQTXSerializationInfo;virtual;
  end;

implementation

class function TQTXObject.ElfHash(const aData;aLength:Integer):LongWord;
var
  i:    Integer;
  x:    Cardinal;
  FSrc: PByte;
Begin
  Result:=0;
  If aLength>0 then
  Begin
    FSrc:=@aData;
    for i:=1 to aLength do
    begin
      Result := (Result shl 4) + FSrc^;
      x := Result and $F0000000;
      if (x <> 0) then
      Result := Result xor (x shr 24);
      Result := Result and (not x);
      inc(FSrc);
    end;
  end;
end;

class function TQTXObject.ElfHash(const aText:String):LongWord;
var
  FAddr:  Pointer;
  FLen:   Integer;
Begin
  Result:=0;
  FLen:=Length(aText);
  If FLen>0 then
  Begin
    FAddr:=@aText[1];
    Result:=ElfHash(FAddr^,FLen * Sizeof(Char));
  end;
end;

//#############################################################################
// TQTXObjectPropertyInfo
//#############################################################################

constructor TQTXObjectPropertyInfo.Create(Parent:TQTXObjectPropertyInfoList);
begin
  inherited Create;
  FParent:=Parent;
end;    

function TQTXObjectPropertyInfo.asString:String;
var
  mStr:   String;
  mInt:   Integer;
  mInt64: Int64;
  mSize:  Integer;
  mPTR:   Pointer;
  mEnum:  longword;
  mVar:   Variant;
begin
  setLength(result,0);
  if FParent<>NIL then
  begin
    if FParent.Instance<>NIL then
    Begin

      case FDataType of
      tkString,
      tkLString,
      tkUString:
        Begin
          mSize:=0;
          repeat
            inc(mSize,1024);
            setLength(mStr,mSize);
            fillchar(mStr[1],mSize,#0);
            mPTR:=pointer(@mStr[1]);
          until FParent.Instance.getPropertyValue(FName,mPTR,mSize);
          result:=QuotedStr(strPas(PChar(mPTR)));
          setLength(mStr,0);
        end;
      tkInteger:
        Begin
          mPTR:=@mInt;
          mSize:=SizeOf(Integer);
          FParent.Instance.getPropertyValue(FName,mPTR,mSize);
          result:=IntToStr(mInt);
        end;
      tkInt64:
        Begin
          mPTR:=@mInt64;
          mSize:=SizeOf(Int64);
          FParent.Instance.getPropertyValue(FName,mPTR,mSize);
          result:=IntToStr(mInt64);
        end;
      tkEnumeration:
        Begin
          mPTR:=@mEnum;
          mSize:=SizeOf(Longword);
          FParent.Instance.getPropertyValue(FName,mPTR,mSize);
          if mSize=SizeOf(Boolean) then
          result:=boolToStr(PBoolean(mPTR)^,true) else
          Begin
            result:='[Enumeration]';
          end;
        end;
      tkVariant:
        Begin
          mPTR:=@mVar;
          mSize:=SizeOf(Variant);
          FParent.Instance.getPropertyValue(FName,mPTR,mSize);
          result:=string(mVar);
        end;
      end;

    end;
  end;
end;    

//#############################################################################
// TQTXObjectPropertyInfoList
//#############################################################################

constructor TQTXObjectPropertyInfoList.Create(Instance:TQTXObject);
Begin
  inherited Create(True);
  FInstance:=Instance;
end;    

function  TQTXObjectPropertyInfoList.ToString:String;
var
  x:  Integer;
Begin
  setLength(result,0);
  for x:=0 to Count-1 do
  Begin
    result:=result + Items[x].PropertyName + '=' + items[x].asString;
    if x<(count-1) then
    result:=result + #13;
  end;
end;

//#############################################################################
// TQTXXMLSerializer
//#############################################################################

procedure TQTXXMLSerializer.Serialize
          (writer:TQTXWriter;const instance:TQTXObject);
Begin
  if assigned(writer) then
  begin
    if assigned(instance) then
    Begin

    end;
  end;
end;

procedure TQTXXMLSerializer.DeSerialize
          (reader:TQTXReader;const instance:TQTXObject);
Begin
end;

//#############################################################################
// TQTXTextWriter
//#############################################################################

Procedure  TQTXTextWriter.WriteText(value:String);
Begin
  if length(value)>0 then
  Begin
    Value:=Value + #13#10;
    FStream.Write(value[1],length(value) * SizeOf(Char));
  end;
end;

procedure  TQTXTextWriter.Write(value:Boolean);
Begin
  WriteText(BoolToStr(value,true));
end;

procedure TQTXTextWriter.Write(value:byte);
Begin
  WriteText('$' + IntToHex(Value,2));
end;

procedure TQTXTextWriter.Write(value:TByteArray);
var
  x:  Integer;
Begin
  if length(value)>0 then
  for x:=low(value) to high(value) do
  Write(Value[x]);
end;

procedure TQTXTextWriter.Write(value:char);
Begin
  FStream.Write(Value,SizeOf(Char));
end;

procedure TQTXTextWriter.Write(value:TCharArray);
var
  x:  Integer;
Begin
  if length(Value)>0 then
  for x:=low(Value) to high(Value) do
  FStream.Write(Value[x],SizeOf(Char));
end;

procedure TQTXTextWriter.Write(value:String);
Begin
  WriteText(Value);
end;

procedure TQTXTextWriter.Write(value:Integer);
Begin
  WriteText(IntToStr(Value));
end;

procedure TQTXTextWriter.Write(value:word);
Begin
  WriteText('$' + IntToHex(Value,4));
end;

procedure TQTXTextWriter.Write(Value:Longword);
Begin
  WriteText('$' + IntToHex(Value,8));
end;

procedure TQTXTextWriter.Write(Value:double);
Begin
  WriteText(FloatToStr(Value));
end;

Procedure TQTXTextWriter.Write(Value:Int64);
Begin
  WriteText(IntToStr(value));
end;

//#############################################################################
// TQTXWriter
//#############################################################################

constructor TQTXWriter.Create(target:TStream);
Begin
  inherited Create;
  FStream:=target;
end;

destructor TQTXWriter.Destroy;
Begin
  inherited;
end;

procedure TQTXWriter.WriteBinary(const data;dataLen:Integer);
Begin
  FStream.Write(data,dataLen);
end;    

procedure TQTXWriter.Write(value:Boolean);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

procedure TQTXWriter.Write(value:byte);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

procedure TQTXWriter.Write(value:TByteArray);
Begin
  if length(value)>0 then
  WriteBinary(value,length(value));
end;

procedure TQTXWriter.Write(value:char);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

procedure TQTXWriter.Write(value:TCharArray);
Begin
  if length(value)>0 then
  WriteBinary(Value,SizeOf(Char) * Length(Value));
end;

procedure TQTXWriter.Write(value:String);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

procedure TQTXWriter.Write(value:Integer);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

procedure TQTXWriter.Write(value:word);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

procedure TQTXWriter.Write(Value:Longword);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

procedure TQTXWriter.Write(Value:double);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

Procedure TQTXWriter.Write(Value:Int64);
Begin
  WriteBinary(Value,sizeOf(Value));
end;

//#############################################################################
// TQTXPersistent
//#############################################################################

function  TQTXPersistent.GetObjectData:TQTXSerializationInfo;
begin
  result:=TQTXSerializationInfo.Create;
end;

function TQTXPersistent.Clone:TQTXObject;
var
  mClass: TClass;
begin
  result:=NIL;
  mClass:=getType;
  if mClass<>NIl then
  Begin
    (* Create instance *)
    result:=TQTXObject(mClass.Create);

    (* Do a recursive "deep-copy" of the object properties *)
    try
      cloneProperties(self,result,true);
    except
      on e: exception do
      begin
        freeAndNIL(result);
        Raise EQTXObjectCloneFailed.CreateFmt
        ('Failed to clone %s, method %s threw exception %s with message %s',
        [self.ClassType.ClassName,'Clone',e.ClassName,e.Message]);
      end;
    end;
  end;
end;      

//#############################################################################
// TQTXObject
//#############################################################################

Procedure TQTXObject.AfterConstruction;
begin
  inherited;
  AtomicDecrement(FRefCount);
end;

Procedure TQTXObject.BeforeDestruction;
Begin
  if RefCount <> 0 then
  Error(reInvalidPtr);

  Finalize;
  inherited;
end;    

Procedure TQTXObject.Free;
Begin
  if FRetained then
  Raise EQTXObjectRetained.Create
  ('Object is retained and cannot be released error');
  Inherited free;
end;    

function TQTXObject._AddRef: Integer;
begin
  Result := AtomicIncrement(FRefCount);
end;

procedure TQTXObject.RetainObject;
Begin
  (* Prevent automatic release through self-increment *)
  if not FRetained then
  FRetained:=_addRef>0 else
  raise EQTXObjectAlreadyRetained.Create
  ('Object is already marked as retained error');
end;

procedure TQTXObject.ReleaseObject;
Begin
  if FRetained then
  _release else
  raise EQTXObjectNotRetained.Create
  ('Object is not retained error');
end;    

function TQTXObject._Release: Integer;
begin
  (* Note: Delphi calls destroy directly, but since we want to
     be in tune with future possible changes to the VCL/FMX where
     free is expanded, I decided to invoke that instead *)
  Result := AtomicDecrement(FRefCount);
  if result<1 then
  free;
end;

function TQTXObject.QueryInterface(const IID: TGUID;out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  if GetInterface(IID, Obj) then
  Result := 0 else
  Result := E_NOINTERFACE;
end;

(* This is the dot net variation of "beforedestruction". I have included
   it for completeness and compatability only. It is invoked from
   beforedestruction. Also, this is where IDisposable is checked for *)
Procedure TQTXObject.Finalize;
var
  mAccess:  IDisposable;
begin
  (* Release unmanaged data *)
  if getInterface(IDisposable,mAccess) then
  mAccess.Dispose;
end;

function TQTXObject.ToString:String;
Begin
  result:=self.ClassType.ClassName;
end;    

class function TQTXObject.ReferenceEquals(const ObjA,ObjB:TQTXObject):Boolean;
Begin
  result:=(objA<>NIL)
  and (objB<>NIL)
  and (objA = objB);
end;    

class function TQTXObject.GetHashCode:longword;
begin
  result:=TQTXObject.ElfHash(ClassName);
end;    

class function TQTXObject.GetType:TClass;
var
  ctx: TRttiContext;
  objType: TRttiType;
begin
  result:=NIL;
  ctx := TRttiContext.Create;
  objType := ctx.GetType(ClassInfo);
  if (objType<>NIL)
  and (objType.AsInstance<>NIL) then
  result:=objType.AsInstance.ClassType;
end;                

function TQTXObject.getPropertyValue(aName:String;
         var Data:Pointer;
         var buffLen:Integer):Boolean;
var
  numProps, I : Integer;
  props: PPropList;
  PropInfo: PPropInfo;
  mInfo: TQTXObjectPropertyInfo;
  mText:  String;
  mLen: Integer;
Begin
  result:=False;

  if (Data<>NIL)
  and (BuffLen>0) then
  Begin

    numProps := GetPropList(self, props);
    try
      if numProps>0 then
      begin

        for i:=0 to numProps-1 do
        begin
          PropInfo := props^[I];

          if sameText(String(PropInfo^.Name),aName) then
          Begin
            case propInfo^.PropType^.Kind of
            tkInteger:
              Begin
                if BuffLen>=SizeOf(Integer) then
                Begin
                  Integer(data):=GetOrdProp(self,propinfo);
                  BuffLen:=SizeOf(Integer);
                end;
                break;
              end;
            tkChar:
              begin
                if BuffLen>=SizeOf(char) then
                Begin
                  PChar(data)^:=Char ( GetOrdProp(self,propinfo) );
                  BuffLen:=SizeOf(Char);
                end;
                break;
              end;
            tkEnumeration, tkSet, tkWChar:
              Begin

                if PropInfo^.PropType^ =  TypeInfo(boolean) then
                Begin
                  if BuffLen>=SizeOf(Boolean) then
                  begin
                    PBoolean(Data)^:=Boolean(GetOrdProp(self,propinfo));
                    BuffLen:=SizeOf(Boolean);
                    break;
                  end;
                end;

                if BuffLen>=SizeOf(longword) then
                Begin
                  PLongword(data)^:=GetOrdProp(self,propinfo);
                  BuffLen:=SizeOf(Longword);
                end;
                break;
              end;
            tkFloat:
              Begin
                if BuffLen>=SizeOf(Double) then
                Begin
                  PDouble(data)^:=GetOrdProp(self,propinfo);
                  BuffLen:=SizeOf(Double);
                end;
                break;
              end;
            tkString,
            tkLString,
            tkUString:
              begin
                mText:=GetStrProp(self,propinfo);
                mLen:=length(mText) * SizeOf(Char);
                if BuffLen>=mLen then
                Begin
                  move(mText[1],data^,mLen);
                  BuffLen:=mLen;
                end;
                break;
              end;

            tkInt64:
              Begin
                if BuffLen>=SizeOf(Char) * Length(mText) then
                Begin
                  PInt64(data)^:=GetInt64Prop(self,propinfo);
                  BuffLen:=SizeOf(Int64);
                end;
                break;
              end;

            tkVariant:
              begin
                if BuffLen>=SizeOf(variant) then
                Begin
                  PVariant(Data)^:=getVariantProp(self,PropInfo);
                  BuffLen:=SizeOf(Variant);
                end;
                break;
              end;

            (* tkInterface:
              begin
                break;
              end;

            tkMethod:
              Begin
                break;
              end; *)

            end;

          end;
        end;

        result:=(BuffLen>0);

      end;
    finally
      FreeMem(props);
    end;   

  end;

end;    

function TQTXObject.queryPropertyInfo
         (var list:TQTXObjectPropertyInfoList):Boolean;
var
  numProps, I : Integer;
  props: PPropList;
  PropInfo: PPropInfo;
  mInfo: TQTXObjectPropertyInfo;
Begin
  list:=NIL;
  result:=False;

  numProps := GetPropList(self, props);
  try
    if numProps>0 then
    begin
      list:=TQTXObjectPropertyInfoList.Create(self);

      for i:=0 to numProps-1 do
      begin
        PropInfo := props^[i];

        if not (PropInfo^.PropType^.Kind in
        [tkClass,tkArray,tkRecord,tkDynArray]) then
        Begin
          mInfo:=TQTXObjectPropertyInfo.Create(list);
          mInfo.PropertyName:=propInfo^.Name;
          mInfo.PropertyType:=PropInfo^.PropType^.Kind;
          list.Add(mInfo);
        end;
      end; 

      if list.Count<1 then
      freeAndNIL(list);

      result:=list<>NIL;

    end;
  finally
    FreeMem(props);
  end;
end;   

procedure TQTXObject.CloneProperties(aSource,aTarget:TQTXObject;
          Recursive:Boolean=False);
var
  numProps, I : Integer;
  props: PPropList;
  PropInfo: PPropInfo;
  src:  TObject;
  dst:  TObject;
Begin
  numProps := GetPropList(aSource, props );
  Try
    For I := 0 To numProps - 1 Do Begin
      PropInfo := props^[I];
      Case PropInfo^.PropType^.Kind Of
        tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
          SetOrdProp(aTarget,propinfo,GetOrdProp(aSource,propinfo));
        tkFloat:
          SetFloatProp(aTarget,propinfo,GetFloatProp(aSource,propinfo));
        tkString,
        tkLString,
        tkUString:
          SetStrProp( aTarget, propinfo,GetStrProp( aSource, propinfo));
        tkWString:
          SetWideStrProp(aTarget,propinfo,GetWideStrProp(aSource,propinfo));
        tkMethod:
          SetMethodProp(aTarget,propinfo,GetMethodProp(aSource,propinfo));
        tkInt64:
          SetInt64Prop(aTarget,propinfo,GetInt64Prop(aSource,propinfo));
        tkVariant:
          SetVariantProp(aTarget,propinfo,GetVariantProp(aSource,propinfo));
        tkInterface:
          SetInterfaceProp(aTarget,propinfo,GetInterfaceProp(aSource,propinfo));
        tkClass:
          Begin
            if Recursive then
            Begin

              src := GetObjectProp( aSource, propinfo );
              If Assigned( src ) Then
              Begin
                If src Is TComponent Then
                SetObjectProp( aTarget, propinfo, src ) else
                If src Is TPersistent Then
                Begin
                  if src<>self then
                  begin
                    dst := GetObjectProp( aTarget, propinfo, TPersistent);
                    if dst<>self then
                    begin
                      If Assigned( dst ) Then
                      TPersistent( dst ).Assign( TPersistent(src));
                    end;
                  end;
                End;
              End;

            end;
          End;
      tkArray,
      tkRecord,
      tkDynArray:
        begin
        end
      end;
    end;
  Finally
    FreeMem( props );
  End;
end;    

function TQTXObject.CloneMemberWise(var aClone):Boolean;
var
  mClass: TClass;
begin
  NativeInt(aClone):=0;
  result:=False;

  mClass:=getType;
  if mClass<>NIl then
  Begin
    TQTXObject(pointer(aClone)):=TQTXObject(mClass.Create);

    (* Do a recursive "deep-copy" of the object properties *)
    try
      cloneProperties(self,TQTXObject(pointer(aClone)),false);
    except
      on e: exception do
      begin
        freeAndNIL(result);
        Raise EQTXObjectCloneFailed.CreateFmt
        ('Failed to clone %s, method %s threw exception %s with message %s',
        [self.ClassType.ClassName,'CloneMemberWise',e.ClassName,e.Message]);
      end;
    end;
    //cloneProperties(self,TQTXObject(pointer(aClone)));
    result:=NativeInt(aClone)<>0;
  end;
end;    

end.

NodeJS and Smart Mobile Studio

For those that follow my blog and group (Delphi Developer on Facebook) I have recently got a new job. I now am a happy developer at Visma.com, which is one of the largest providers of retail and financial solutions in Europe. On average our systems process more than two million transactions every single day just in Norway alone.

Working at Visma is not only a stamp of approval, but also a great opportunity to learn and contribute to one of the most solid companies of Europe, a company built on innovation, Delphi (yet it started as a pure Delphi company) and excellence. So it’s a great honor to work there.

Welcome to Oz, where Delphi is having a hard time keeping up

While I am not permitted to divulge anything special regarding our work, it is common knowledge that we have both a Delphi department and a dot net department. The older Delphi department takes care of hardware (the cash registers and point-of-sale machines all run Windows Embedded with Delphi software and have done so for roughly 15 years), while the dot net division handles everything else.

Needless to say, I am now in a position of learning rather than teaching. I really love my job now, because the organization is so well planned and the quality of the work and genius of my fellow co-workers is among the best in the world. We also get to work on top of the line hardware, the software money can buy – and in return for our dedication we get the best benefits in the market – coupled with working in a friendly group of people who really know what they are doing.

I must admit that I have never been in a company where the collective knowledge and level of expertise is so high. I have always had to present rules and procedures for effective work, so I cant express my relief of getting a job where every detail has been thought out and clearly defined.

It’s been a while since I have been looking forward to going to work; Now I practically jump out of bed – and drive to work with a smile on my face. And driving distance is now 15 minutes as opposed to 70 minutes 🙂

CSharp

While it would be natural for everyone to think I ended up in the Delphi department, I am now actually a full-time C# developer (gasp!). Which means I am right now in “mental reorganization mode”, where my mind is spending most of it’s time absorbing new knowledge, connecting topics back to my Delphi background, and figuring out new ways to do the same (programming techniques havent really changed, we have just come up with new and more effective ways of doing the same thing).

If you are worried that this is yet another “Oh i’m leaving the Delphi scene” post, then you are dead wrong. It could not be more wrong, because working with C# and other platforms has only strengthened my view of object pascal as a superior language. With superiority I am not talking about the framework or the RTL, because this is the achillees heel of object pascal in this day and age; I am talking about syntax, structures and how we approach problems and describe solutions.

Object pascal leverages the amount of energy it takes to analyse and “get into” a codebase. The human brain recognizes human words faster than it does symbols, so behind my stance you will find scientific reasoning. Im not just a Delphi fan-boy with no clear reasoning other than “I like it better” to show for it.

So in fact, I am porting the best things dot net have to offer – back to object pascal. So my work for pascal is not going away any time soon.

Also, I have been using C# for a few years (mono mostly) so there is not much change in my life, except that now my 08:00 to 16:00 core time is spent in C# rather than Delphi.

I must admit that it does take some getting used to not seeing Delphi first ing in the morning. I have done that for some 20 years in one form or another (give or take a turbo pascal). Just how used to Delphi I have become sort of took me by surprise. But after some 20 odd years; well, I guess it’s natural to miss a daily event after all those years.

Extending smart pascal

I have to admit that I have never been more proud of the Smart Mobile Studio team as I am right now. While Delphi en large is being slowly eroded from larger companies, Smart Mobile Studio has the potential to utterly replace all forms of Delphi server software and even topple the “big boys” like perl and JSP. And I don’t mean this as a threat to Embarcadero, but rather as an enthusiast for our language – that despite what people say, Delphi is indirectly responsible for object pascal thriving in an alternative market. So should Delphi lose it’s grip — at least Smart Pascal still has a window open so we can get Delphi back in later 🙂

Smart Mobile Studio is ready for the cloud

What other object pascal compiler and RTL allows you to build cutting edge nodeJS server applications?

So while Delphi is on the way out for many companies around the world (which is really just a “semi truth”), Myself, Eric, Primoz, Jørn, Christian and Andre have made a new path for object pascal. A path which will not only allows existing object pascal programmers to save their investment and recycle their already hard-earned knowledge — but also a path which will potentially bring more people to object pascal and the Delphi community as a whole.

Smart Pascal is the only form of object pascal that is now running on high-end, corporate scale servers. I have just completed a nodeJS cluster test written completely in Smart Mobile Studio, and I can tell you right now — this is a completely different ballgame. I have worked for huge corporations before, but the amount of data and layers of technical processes I am working on now is forcing me to completely re-think ever aspect of my programming; in fact, it’s re-defining my entire outlook on scalable business logic and fundamental data processing.

Once again we are in a phase of transition. For those that have been using Delphi for a while you may remember when Delphi went from being a purely “local” development platform, to becoming a toolkit with included server-side and easy database management? Well, this time the IT industry is evolving one step further up – going from the classical RPC (remote procedure call), client/server model to pure hardware and platform independence.

So while nothing has changed neither for local win32/64 development or traditional client/server technology – languages must now adapt to a much larger scope. Which means software must be able to scale horizontally (meaning: being able to expand in number, be it the amount of servers dealing with data, or the amount of databases serving the same knowledge).

The classic RPC model now contains a new element, namely in-process cloning

So a modern server model is not simply A to B, but rather one that can clone itself in order to handle more payload. This is why dot net makes sense for larger corporations, because virtual code does not have the same limitations as native code. Spawning 1 server is no more technically challenging than spawning 10 servers across 10 different sub-domains. This is also why perl and ruby are popular, because script based servers are even easier to scale.

In other words: Delphi’s old IIS and Apache plugins are simply not going to cut it. You can pimp up those technologies to once again make them competitive – but that’s not my job. That’s Embarcadero’s job. And since it’s not happening and I can do better, then yes, I will invest that knowledge in Smart Mobile Studio instead.

Future of object pascal is awesome!

If you translate this post as negative to Delphi, then you are dead wrong. As insinuated, Delphi would retain its position in a lot of companies if Embarcadero took the time to update and get their enterprise tools in sync with reality. With special attention to the XML binding wizard which crashes spectacularly when chewing XSL files which reference other files (the @ include syntax). This alone was enough for Delphi to be kicked out of Hydro, an oil company I worked for earlier. Embarcadero must have lost at least $50K in licensing fees per year from Hydro moving to Java (I know, dont get me started).

If Embarcadero fixes this (and much more) and perhaps dedicate a full sprint/release to enterprise level programming; perhaps include a component framework for networking, active directory and other technologies, Delphi would be more able to compete with dot net and Java.

To much of this around, and that has to be changed ASAP!

But I don’t think Delphi is going away. It is down-scaling and is no longer *THE* main-stream product, but it will still be popular and lucrative for many decades to come. No language ever really goes away, it all boils down to the people using it and how well they promote their language and secure their own job future.

But the real action will be in cloud technologies and scripting — and the language which is seeing over 47% growth these days (which means it represents 47% of all growth in programming in total) is JavaScript.

NodeJS is the technology which is quickly replacing php, perl and other scripting technologies classically deployed server-side. And this is a blessing! Because it means you can now code both the server and the client using the same language. A language not bound to an economic entity (company) which works on all platforms out of the box.

I have never believed more in Smart Mobile Studio than I do today. Having looked at a dosen alternative routes, even going completely native server-side with Delphi, Smart Mobile Studio is the only system which delivers this amount of power to nodeJS.

Everyone in the Smart Pascal consortium focused on a particular field of technology. I guess I have found my niche. So while RTL updates and fixing will be on top of my list for months to come, nodeJS will be my main field of interest for the Smart Mobile platform.

Providing wrappers for mySQL and Firebird so you can natively connect to them comes first. This will fit in nicely with the dataset classes I am about to commit to our repository.

So to all of you who have been waiting for database management made-easy under Smart, it’s going to be like xmas and your birthday at the same time.

Now let’s build that nodeJS cluster in Smart Pascal itself and claim hardcore server programming for object pascal!

Dot net framework for Delphi?

One idea that has been lurking in the back of my head regarding the QTX framework, is that we could – actually, simply implements a light version of the dot net framework instead.

I realize that this may be anathema to many people, and the first question will no doubt be “why” rather than “how”, but it does make sense from a purely strategic point of view.

• It makes porting software from C# easier
• To some degree simplified coding style (read: easier)
• Many powerful concepts which object pascal lacks
• Benefit of both worlds: object pascal and the dot net theorem

To see if this would work even on a conceptual level I decided to implement the System.Object class in object pascal. To get the benefit of garbage collection I have derived the base class from TPersistent and implemented IInterface. Destruction of un-managed resources are under the dot net framework ensured destruction through IDisposable, which I also added.

As most people know, objects that uses reference-counting can be harder to work with under native languages. If you place them in an object-list and expects them to survive you are in for a surprise, because even though TObjectList retains the pointer the instance is released.

To avoid this I have implemented the IRetainable interface. So remember to invoke the RetainObject() method. Calling RetainObject() ensures that an element self-references; read: will never automatically release itself because the reference counter never reaches zero.

Well, here is the unit. If anyone else is interested in implementing the dot net framework in Delphi then let me know, we could setup a repository and work together on it.

unit qtx.system;

interface

uses  System.Sysutils, 
      System.Classes, 
      System.rtti,
      System.TypInfo;

type

  EQTXObject  = Class(Exception);

  (* Exception classes *)
  EQTXObjectAlreadyRetained = Class(EQTXObject);
  EQTXObjectNotRetained     = Class(EQTXObject);
  EQTXObjectRetained        = Class(EQTXObject);
  EQTXObjectCloneFailed     = Class(EQTXObject);

  (* Forward declarations *)
  TQTXObject                = Class;
  TQTXPersistent            = Class;
  TQTXSerializationInfo     = Class;
  
  IDisposable = interface
    ['{56714944-F3D0-43C9-8C4B-F2F00BA5F83D}']
    procedure Dispose;
  end;

  IRetainedObject = Interface
    ['{27B152DC-6553-4309-8C51-2B5C7D89A9EB}']
    procedure RetainObject;
    procedure ReleaseObject;
  end;

  ICloneable = interface
    ['{6BAB94D0-32B9-4C4C-9D71-4C88AA9E6D0B}']
    function  Clone:TQTXObject;
  end;

  ISerializable = interface
    ['{FAD5405E-34B8-4264-8F8D-EE2A0D257213}']
    function  GetObjectData:TQTXSerializationInfo;
  end;

  TQTXObject = Class(TPersistent,IRetainedObject)
  strict private
    FRefCount:  Integer;
    FRetained:    Boolean;
  strict protected
    procedure CloneProperties(aSource,aTarget:TQTXObject;
              Recursive:Boolean=False);
  strict protected
    Property  RefCount:Integer read FRefCount;
  strict protected
    { IInterface }
    function _AddRef: Integer;virtual;stdcall;
    function _Release: Integer;virtual;stdcall;
  strict protected
    procedure RetainObject;virtual;
    procedure ReleaseObject;virtual;
  public
    function CloneMemberWise(var aClone):Boolean;

    procedure Finalize;virtual;
    
    class function  ReferenceEquals(const ObjA,ObjB:TQTXObject):Boolean;
    class function  GetHashCode:Longword;reintroduce;
    class function  GetType:TClass;

    function  ToString:String;override;

    Procedure Free;reintroduce;virtual;

  public
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;

    Procedure BeforeDestruction;Override;
    Procedure AfterConstruction;Override;
  end;

    (* See: http://msdn.microsoft.com/en-us/library/
            system.runtime.serialization.serializationinfo(v=vs.110).aspx
       For member info
    *)
  TQTXSerializationInfo = Class(TQTXObject)
  end;  

  TQTXPersistent = Class(TQTXObject,ICloneable,ISerializable)
  strict protected
    (* ICloneable *)
    function  Clone:TQTXObject;
  strict protected
    (* ISerializable *)
    function  GetObjectData:TQTXSerializationInfo;virtual;
  end;
  
implementation

uses brage;

//#############################################################################
// TQTXPersistent
//#############################################################################

function  TQTXPersistent.GetObjectData:TQTXSerializationInfo;
begin
  result:=TQTXSerializationInfo.Create;
end;

function TQTXPersistent.Clone:TQTXObject;
var
  mClass: TClass;
begin
  result:=NIL;
  mClass:=getType;
  if mClass<>NIl then
  Begin
    (* Create instance *)
    result:=TQTXObject(mClass.Create);

    (* Do a recursive "deep-copy" of the object properties *)
    try
      cloneProperties(self,result,true);
    except
      on e: exception do
      begin
        freeAndNIL(result);
        Raise EQTXObjectCloneFailed.CreateFmt
        ('Failed to clone %s, method %s threw exception %s with message %s',
        [self.ClassType.ClassName,'Clone',e.ClassName,e.Message]);
      end;
    end;
  end;
end;      

//#############################################################################
// TQTXObject
//#############################################################################

Procedure TQTXObject.AfterConstruction;
begin
  inherited;
  AtomicDecrement(FRefCount);
end;

Procedure TQTXObject.BeforeDestruction;
Begin
  if RefCount <> 0 then
  Error(reInvalidPtr);
    
  Finalize;
  inherited;
end;    

Procedure TQTXObject.Free;
Begin
  if FRetained then
  Raise EQTXObjectRetained.Create
  ('Object is retained and cannot be released error');
  Inherited free;
end;    

function TQTXObject._AddRef: Integer;
begin
  Result := AtomicIncrement(FRefCount);
end;

procedure TQTXObject.RetainObject;
Begin
  (* Prevent automatic release through self-increment *)
  if not FRetained then
  FRetained:=_addRef>0 else
  raise EQTXObjectAlreadyRetained.Create
  ('Object is already marked as retained error'); 
end;

procedure TQTXObject.ReleaseObject;
Begin
  if FRetained then
  _release else
  raise EQTXObjectNotRetained.Create
  ('Object is not retained error');
end;    

function TQTXObject._Release: Integer;
begin
  (* Note: Delphi calls destroy directly, but since we want to
     be in tune with future possible changes to the VCL/FMX where
     free is expanded, I decided to invoke that instead *)
  Result := AtomicDecrement(FRefCount);
  if result<1 then
  free;
end;

function TQTXObject.QueryInterface(const IID: TGUID;out Obj): HResult;
const
  E_NOINTERFACE = HResult($80004002);
begin
  if GetInterface(IID, Obj) then
  Result := 0 else
  Result := E_NOINTERFACE;
end;


(* This is the dot net variation of "beforedestruction". I have included
   it for completeness and compatability only. It is invoked from
   beforedestruction. Also, this is where IDisposable is checked for *)
Procedure TQTXObject.Finalize;
var
  mAccess:  IDisposable;
begin
  (* Release unmanaged data *)
  if getInterface(IDisposable,mAccess) then
  mAccess.Dispose;
end;

function TQTXObject.ToString:String;
Begin
  result:=self.ClassType.ClassName;
end;    

class function TQTXObject.ReferenceEquals(const ObjA,ObjB:TQTXObject):Boolean;
Begin
  result:=(objA<>NIL)
  and (objB<>NIL)
  and (objA = objB);
end;    

class function TQTXObject.GetHashCode:longword;
begin
  result:=brage.TBRBuffer.ElfHash(ClassName);
end;    

class function TQTXObject.GetType:TClass;
var
  ctx: TRttiContext;
  objType: TRttiType;
begin
  result:=NIL;
  ctx := TRttiContext.Create;
  objType := ctx.GetType(ClassInfo);
  if (objType<>NIL)
  and (objType.AsInstance<>NIL) then
  result:=objType.AsInstance.ClassType;
end;

procedure TQTXObject.CloneProperties(aSource,aTarget:TQTXObject;
          Recursive:Boolean=False);
var
  numProps, I : Integer;
  props: PPropList;
  PropInfo: PPropInfo;
  src:  TObject;
  dst:  TObject;
Begin
  numProps := GetPropList(aSource, props );
  Try
    For I := 0 To numProps - 1 Do Begin
      PropInfo := props^[I];
      Case PropInfo^.PropType^.Kind Of
        tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
          SetOrdProp(aTarget,propinfo,GetOrdProp(aSource,propinfo));
        tkFloat:
          SetFloatProp(aTarget,propinfo,GetFloatProp(aSource,propinfo));
        tkString,
        tkLString,
        tkUString:
          SetStrProp( aTarget, propinfo,GetStrProp( aSource, propinfo));
        tkWString:
          SetWideStrProp(aTarget,propinfo,GetWideStrProp(aSource,propinfo));
        tkMethod:
          SetMethodProp(aTarget,propinfo,GetMethodProp(aSource,propinfo));
        tkInt64:
          SetInt64Prop(aTarget,propinfo,GetInt64Prop(aSource,propinfo));
        tkVariant:
          SetVariantProp(aTarget,propinfo,GetVariantProp(aSource,propinfo));
        tkInterface:
          SetInterfaceProp(aTarget,propinfo,GetInterfaceProp(aSource,propinfo));
        tkClass:
          Begin
            if Recursive then
            Begin
            
              src := GetObjectProp( aSource, propinfo );
              If Assigned( src ) Then
              Begin
                If src Is TComponent Then
                SetObjectProp( aTarget, propinfo, src ) else
                If src Is TPersistent Then
                Begin
                  if src<>self then
                  begin
                    dst := GetObjectProp( aTarget, propinfo, TPersistent);
                    if dst<>self then
                    begin
                      If Assigned( dst ) Then
                      TPersistent( dst ).Assign( TPersistent(src));
                    end;
                  end;
                End;
              End;
            
            end;
          End;
      tkArray,
      tkRecord,
      tkDynArray:
        begin
        end
      end;
    end;
  Finally
    FreeMem( props );
  End;
end;    

function TQTXObject.CloneMemberWise(var aClone):Boolean;
var
  mClass: TClass;
begin
  NativeInt(aClone):=0;
  result:=False;

  mClass:=getType;
  if mClass<>NIl then
  Begin
    TQTXObject(pointer(aClone)):=TQTXObject(mClass.Create);

    (* Do a recursive "deep-copy" of the object properties *)
    try
      cloneProperties(self,TQTXObject(pointer(aClone)),false);
    except
      on e: exception do
      begin
        freeAndNIL(result);
        Raise EQTXObjectCloneFailed.CreateFmt
        ('Failed to clone %s, method %s threw exception %s with message %s',
        [self.ClassType.ClassName,'CloneMemberWise',e.ClassName,e.Message]);
      end;
    end;
    //cloneProperties(self,TQTXObject(pointer(aClone)));
    result:=NativeInt(aClone)<>0;
  end;
end;    

end.

Enjoy!

TDBF works like a charm

Took two minutes to check out TDBF, the free open-source embedded database for Delphi (out of many). Discovered that it actually ships with Lazarus. I did a clean install of Lazarus/FPC on one of my mac’s at work (old macbook) just for fun – and you will find it pre-installed in the database tab.

Right. To get it working all you need to do is the following:

 

procedure TForm1.Button1Click(Sender: TObject);
var
   x:     Integer;
   mstart: TDateTime;
   mField: TField;
begin

  dbx.FilePath:=getMyDocsPath;
  dbx.CreateTable;
  dbx.Open;

  mStart:=now;
  mField:=dbx.fieldByname('name');
  for x:=1 to 100000 do
  begin
    dbx.Append;
    mField.AsString:='Name #' + IntToStr(x);
    dbx.post;
  end;

  caption:='Time:' + TimeToStr(now-mStart);

  dbx.First;
  listbox1.items.BeginUpdate;

  repeat
  listbox1.items.Add(dbx.fieldByName('name').asString);
    dbx.Next;
    if listbox1.items.count>100 then
    break;
  until dbx.EOF;
  listbox1.items.EndUpdate;

end;

That code will create a new database (remember to add ID and Name fields to the field-def collection property of the component).

The function getMyDocsPath looks like this:

function getMyDocsPath:String;
Begin
  result:='/Users/' + getCurrentUser + '/Documents/';
end;      

Note: The above code is for Unix (OS X) only, but should be trivial to figure out for Windows or Linux.

Speed

Well I only tested it on my ancient mac, but I was able to stuff 100.000 records into the flat-file in 16 seconds. This includes (as you can see above) a post for each insert. The time should be a lot better by caching, say, 1000 records in memory before commiting the data to disk.

Either way — TDBF is a great little database if you have a small project, or even if you just want to store options and/or user-data like they do in dot net.

Check out the code from sourceforge here: http://tdbf.sourceforge.net/