Archive
LDef parser done
Note: For a quick introduction to LDef click here: Introduction to LDef.
Great news guys! I finally finished the parser and model builder for LDef!
That means we just need to get the assembler ported. This is presently running fine under Smart Pascal (I like to prototype things there since its faster) – and it will be easy to port it over to Delphi and Freepascal after the model has gone through the steps.
I’m really excited about this project and while I sadly don’t have much free time – this is a project I truly enjoy working on. Perhaps not as much as Smart Pascal which is my baby, but still; its turning into a fantastic system.
Thoughts on the architecture
One of the things I added support for, and that I have hoped that Embarcadero would add to Delphi for a number of years now, is support for contract coding. This is a huge topic that I’m not jumping into here, but one of the features it requires is support for entry and exit sections. Essentially that you can define code that executes before the method body and directly after it has finished (before the result is returned if it’s a function).
This opens up for some very clever means of preventing errors, or at the very least give the user better information about what went wrong. Automated tests also benefits greatly from this.
For example, a normal object pascal method looks, for example, like this:
procedure TForm1.MySpecialMethod;
begin
writeln("You called my-special-method")
end;
The basis of contract design builds on the classical and expands it as such:
procedure TForm1.MySpecialMethod;
Before()
begin
writeln("Before my-special-method");
end;
After()
begin
writeln("After my-special-method");
end;
begin
writeln("You called my-special-method")
end;
Note: contract design is a huge system and this is just a fragment of the full infrastructure.
What is cool about the before/after snippets, is that they allow you to verify parameters before the body is even executed, and likewise you get to work on the result before the value is returned (if any).
You mights ask, why not just write the tests directly like people do all the time? Well, that is true. But there will also be methods that you have no control over, like a wrapper method that calls a system library for instance. Being able to attach before/after code for externally defined procedures helps take the edge off error testing.
Secondly, if you are writing a remoting framework where variant data and multi-threaded invocation is involved – being able to check things as they are dispatched means catching potential errors faster – leading to better performance.
As always, coding techniques is a source of argument – so im not going into this now. I have added support for it and if people don’t need it then fine, just leave it be.
Under LDef assembly it looks like this:
public void main() {
enter {
}
leave {
}
}
Well I guess that’s all for now. Hopefully my next LDef post will be about the assembler being ready – leaving just the linker. I need to experiment a bit with the codegen and linker before the unit format is complete.
The bytecode-format needs to include enough information so that the linker can glue things together. So every class, member, field etc. must be emitted in a way that is easy and allows the linker to quickly look things up. It also needs to write the actual, resulting method offsets into the bytecode.
Have a happy weekend!
Smart Pascal, the next generation
I want to take the time to talk a bit about the future, because like all production companies we are all working towards lesser and greater goals. If you don’t have a goal then you are in trouble; Thankfully our goals have been very clear from the beginning. Although I must admit that our way there has been.. “colorful” at times.
When we started back in 2010 we didn’t really know what would become of our plans. We only knew that this was important; there was a sense of urgency and “we have to build this” in the air; I think everyone involved felt that this was the case, without any rational explanation as to why. Like all products of passion it can consume you in a way – and you work day and night on turning an idea into something real. From the intangible to the tangible.
It seems like yesterday, but it was 5 years ago!
By the end of 2011 / early 2012, Eric and myself had pretty much proven that this could be done. At the time there were more than enough nay-sayers and I think both of us got flamed quite often for daring to think different. People would scoff at me and say I was insane to even contemplate that object pascal could ever be implemented for something as insignificant and mediocre as JavaScript. This was my first meeting with a sub-culture of the Delphi and C++ community, a constellation I have gone head-to-head with on many occasions. But they have never managed to shake my resolve as much as inch.
When we released version 1.0 in 2012 some ideas about what could be possible started to form. Jørn defined plans for a system we later dubbed “Smart net”. In essence it would be something you logged onto from the IDE – allowing you to store your projects in the cloud, compile in the cloud (connected with Adobe build services) and essentially move parts of your eco-system to the cloud. Keep in mind this was when people still associated cloud with “storage”; they had not yet seen things like Uber or Netflix or played Quake 3 at 160 frames per second, courtesy of asm.js in their browser.
The second part would be a website where you could do the same, including a live editor, access to the compiler and also the ability to buy and sell components, solutions and products. But for that we needed a desktop environment (which is where the Quartex Media Desktop came in later).
The first version of the Media Desktop, small but powerful. Here running in touch-screen mode with classical mobile device layout (full screen forms).
Well, we have hit many bumps along the road since then. But I must be honest and say, some of our detours have also been the most valuable. Had it not been for the often absurd (to the person looking in) research and demo escapades I did, the RTL wouldn’t be half as powerful as it is today. It would deliver the basics, perhaps piggyback on Ext.js or some lame, run of the mill framework – and that would be that. Boring, flat and limited.
What we really wanted to deliver was a platform. Not just a website, but a rich environment for creating, delivering and enjoying web and cloud based applications. And without much fanfare – that is ultimately what the Smart Desktop and it’s sexy node.js back-end is all about is all about.
We have many project types in the pipeline, but the Smart Desktop type is by far the most interesting and powerful. And its 100% under your control. You can create both the desktop itself as a project – and also applications that should run on that desktop as separate projects.
This is perfectly suited for NAS design (network active storage devices can usually be accessed through a web portal on the device), embedded boards, intranets and even intranets for that matter.
You get to enjoy all the perks of a multi-user desktop, one capable of both remote desktop access, telnet access, sharing files and media, playing music and video (we even compiled the mp4 codec from C to JavaScript so you can play mp4 movies without the need for a server backend).
The Smart Desktop
The Smart Desktop project is not just for fun and games. We have big plans for it. And once its solid and complete (we are closing in on 46% done), my next side project will not be more emulators or demos – it will be to move our compiler(s) to Amazon, and write the IDE itself from scratch in Smart Pascal.
The Smart Desktop – A full desktop in the true sense of the word
And yeah, we have plans for EmScripten as well – which takes C/C++ and compiles it into asm.js. It will take a herculean effort to merge our RTL with their sandboxed infrastructure – but the benefits are too great to ignore.
As a bonus you get to run native 68k applications (read: Amiga applications) via emulation. While I realize this will be mostly interesting for people that grew up with that machine – it is still a testament to the power of Smart and how much you can do if you really put your mind to it.
Naturally, the native IDE wont vanish. We have a few new directions we are investigating here – but native will absolutely not go anywhere. But cloud, the desktop system we are creating, is starting to become what we set out to make five years ago (has it been half a decade already? Tempus fugit!). As you all know it was initially designed as an example of how you could write full-screen applications for Raspberry PI and similar embedded devices. But now its a full platform in its own right – with a Linux core and node.js heart, there really is very little you cannot do here.
The Smart Pascal compiler is one of our tools that is ready for cloud-i-fication
Being able to login to the Smart company servers, fire up the IDE and just code – no matter if you are: be it Spain, Italy, Egypt, China or good old USA — is a pretty awesome thing!
Clicking compile and the server does the grunt work and you can test your apps live in a virtual window; switch between device layouts and targets — then hit “publish” and it goes to Cordova (or Delphi) and voila – you get a message back when binaries for 9 mobile devices is ready for deployment. One click to publish your applications on Appstore, Google play and Microsoft marketplace.
Object pascal works
People may have brushed off object pascal (and from experience those people have a very narrow view of what object pascal is all about), but when they see what Smart delivers, which in itself is written in Delphi, powered by Delphi and should be in every Delphi developer’s toolbox — i think it should draw attention to both Delphi as a product, object pascal as a language – and smart as a solution.
With Smart it doesn’t matter what computer you use. You can sit at home with the new A1222 PPC Amiga, or a kick-ass Intel i7 beast that chew virtual machines for breakfast. If your computer can handle a modern website, then you can learn object pascal and work directly in the cloud.
The Smart Desktop running on cheap embedded hardware. The results are fantastic and the financial savings of using Smart Pascal on the kiosk client is $400 per unit in this case
Heck you can work off a $60 ODroid XU4, it has more than enough horsepower to drive the latest chrome or Firefox engines. All the compilation takes place on the server anyways. And if you want a Delphi vessel rather than phonegap (so that it’s a Delphi application that opens up a web-view in full-screen and expose features to your smart code) then you will be happy to know that this is being investigated.
More targets
There are a lot of systems out there in the world, some of which did not exist just a couple of years ago. FriendOS is a cloud based operating system we really want to support, so we are eager to get cracking on their SDK when that comes out. Being able to target FriendOS from Smart is valuable, because some of the stuff you can do in SMS with just a bit of code – would take weeks to hand write in JavaScript. So you get a productive edge unlike anything else – which is good to have when a new market opens.
As far as Delphi is concerned there are smaller systems that Embarcadero may not be interested in, for example the many embedded systems that have come out lately. If Embarcadero tried to target them all – it would be a never-ending cat and mouse game. It seems like almost every month there is a new board on the market. So I fully understand why Embarcadero sticks to the most established vendors.
Smart technology allows you to cover all your bases regardless of device
But for you, the programmer, these smaller boards can repsent thousands of dollars worth of saving. Perhaps you are building a kiosk system and need to have a good-looking user interface that is not carved in stone, touch capabilities, low-latency full-duplex communication with a server; not much you can do about that if Delphi doesnt target it. And Delphi is a work horse so it demands a lot more cpu than a low-budget ARM SoC can deliver. But web-tech can thrive in these low-end environments. So again we see that Smart can compliment and be a valuable addition to Delphi. It helps you as a Delphi developer to act on opportunities that would otherwise pass you by.
So in the above scenario you can double down. You can use Smart for the user-interface on a low power, low-cost SoC (system on a chip) kiosk — and Delphi on the server.
It all depends on what you are interfacing with. If you have a full Delphi backend (which I presume you have) then writing the interface server in Delphi obviously makes more sense.
If you don’t have any back-end then, depending on your needs or future plans, it could be wise to investigate if node.js is right for you. If it’s not – go with what you know. You can make use of Smart’s capabilities either way to deliver cost-effective, good-looking device front-ends of mobile apps. Its valuable tool in your Delphi toolbox.
Better infrastructure and rooting
So far our support for various systems has been in the form of APIs or “wrapper units”. This is good if you are a low-level coder like myself, but if you are coming directly from Delphi without any background in web technology – you wouldn’t even know where to start.
So starting with the next IDE update each platform we support will not just have low-level wrapper units, but project types and units written and adapted by human beings. This means extra work for us – but that is the way it has to be.
As of writing the following projects can be created:
- HTML5 mobile applications
- HTML5 mobile console applications
- Node.js console applications
- node.js server applications
- node.js service applications (requires PM2)
- Web worker project (deprecated, web-workers can now be created anywhere)
We also have support for the following operating systems:
- Chrome OS
- Mozilla OS
- Samsung Tizen OS
The following API’s have shipped with Smart since version 1.2:
- Khronos browser extensions
- Firefox spesific API
- NodeWebkit
- Phonegap
- Phonegap provides native access to roughly 9 operating systems. It is however cumbersome to work with and beta-test if you are unfamiliar with the “tools of the trade” in the JavaScript world.
- Whatwg
- WAC Apis
Future goals
The first thing we need to do is to update and re-generate ALL header files (or pascal units that interface with the JavaScript libraries) and make what we already have polished, available, documented and ready for enterprise level use.
Why pay $400 to power your kiosk when $99 and Smart can do a better job?
Secondly, project types must be established where they make sense. Not all frameworks are suitable for full project isolation, but act more like utility libraries (like jQuery or similar training-wheels). And as much as possible of the RTL made platform independent and organized following our namespace scheme.
But there are also other operating systems we want to support:
- Norwegian made Friend OS, which is a business oriented cloud desktop
- Node.js OS is very exciting
- LG WebOS, and their Enyo application framework
- Asustor DLM web operating system is also a highly attractive system to support
- OpenNAS has a very powerful JavaScript application framework
- Segate Nas OS 4 likewise use JavaScript for visual, universal applications
- Microsoft Universal Platform allows you to create truly portable, native speed JavaScript applications
- QNap QTS web operating system [now at version 4.2]
All of these are separate from our own NAS and embedded device system: Smart Desktop, which uses node.js as a backend and will run on anything as long as node and a modern browser is present.
Final words
I hope you guys have enjoyed my little trip down memory lane, and also the plans we have for the future. Personally I am super excited about moving the IDE to the cloud and making Smart available 24/7 globally – so that everyone can use it to design, implement and build software for the future right now.
Smart Pascal Builder (or whatever nickname we give it) is probably the first of its kind in the world. There are a ton of “write code on the web” pages out there, but so far there is not a single hard-core development studio like I have in mind here.
So hold on, because the future is just around the corner 😉
Delphi developer on its own server
While the Facebook group will naturally continue exactly like it has these past years, we have set up a server active Delphi developers on my Quartex server.
This has a huge benefit: first of all those that want to test the Smart Desktop can do so from the same domain – and people who want to test Smart Mobile Studio can do so with myself just a PM away. Error reports etc. will still need to be sent to the standard e-mail, but now I can take a more active role in supervising the process and help clear up whatever missunderstanding could occur.
Always good with a hardcore Smart, Laz, amibian.js forum!
Besides that we are building a lively community of Delphi, Lazarus, Smart and Oxygene/Remobjects developers! Need a job? Have work you need done? Post an add — wont cost you a penny.
So why not sign up? Its free, it wont bite you and we can continue regardless of Facebook’s up-time this year..
You enter here and just fill out user/pass and that’s it: http://quartexhq.myasustor.com/sharetronix/
Ghost of xmas past, or better known as the folder where old projects and abandoned ideas end up
I think everyone has a folder where they stuff old units, test projects and well – all those ideas that seemed awesome at the time, but you either discovered that it was crap, not enough time, or just forgot all about it. It happens. What can I say.
Yeah, I have one of those as well. And I also have those duplicate folders. You know, that time when you decided to make backups for everything – but then you got a new PC and now you dont have a clue which version to keep? And when you finally sit down with beyondcompare to get this sorted, you have managed to add to both copies.
Well, needless to say I had a day I just went apeshit about a year ago and sorted everything. And whatever did not fit into my neat new code-folder(s) was mercilessly stuffed into the dark, obscure folder known only as “stuff” or “misc”.
My first basic compiler, awwwww how cute
Well its not all rubbish! I did find a special version of my kitchen-sink research IDE, the IDE I use when trying out new code for DWScript, PaxCompiler and FreePascal. I think it has 4 compilers in it or something, yet its under 30 megabytes in size! Pretty neat 🙂
Visual Basic to Smart Pascal, awww…. just want to snuggle it 🙂
It also features a unified file-system! You can mount packages, FTP folders, network paths or local folders – the IDE could not care less, it is completely abstracted from the actual filesystem and relates only to symbols and identifiers. The actual storage is dealt with by the filesource classes.
Package, ftp, socket, local folder – the IDE could not care less
The Basic dialect here is essentially classical Visual Basic. The way you would write classes and deal with instances before dot net came along and forced all languages to look the same. I kinda like old visual basic, it had soul. It was completely useless except for scripting, and Delphi made it look like a joke – but as far as basic dialects go, it’s probably one of the cleanest and easiest to read.
DWScript, QTX Pascal (a custom fork of DWScript with a lot of cool features, some that Eric has added afterwards), Basic – and even freepascal! Thats the mother of all kitchen sinks!
The loss of QTX Pascal is a bit sad. I spent a couple of months doing my own fork of DWScript. Most of the features I added have now been included (although in another form) by Eric. But the codegen produced faster javascript. One of the things I spent some time on was optimization. Like getting rid of “variable = 0” type initialization if an assignment followed. I also added BeforeDestruction() and AfterConstruction() calls. This made an RTL a lot easier to write, but also more overhead. I was about to do conditional testing (so these would only be called if you actually used them) when I had to stop and work on Smart Mobile Studio again.
N++, exotic and functional!
This was one of my favorite language research projects. And dare I say, it is way ahead of it’s time. The idea is simple: with the future of computing being distributed, cloud based and powered by a multitude of computing modules from the US to South Africa — what would a programming language look like if built for 100% asyncronous, distributed execution?
Consider for instance, the execution of a procedure. Simple right? Well, in a truly distributed system – that procedure could execute anywhere. The whole point here is to utilize the combined power of each module (pc); which means a tasks could execute on different computers. A procedure could also be split up by the runtime environment and once again, be executed all over the place – with the dispatcher keeping track of when it’s done and whatever the result was (if any).
Only a spesific and generated on-demand “runtime context” would follow the task. This would contain things like variables it needs to execute, public symbols, basicaly just enough for the code to run successfully. This also includes resource forks (a term i used for accessing resources regardless of where they may be on the network).
The language design was actually done using Smart Mobile Studio (you can read more about the initial ideas here), and the first test modules ran on node.js (so no fancy graphics available sadly).
But it was incredibly fun to play with! But also time consuming to design a language for an execution model that havent really been invented yet. You can read more about some of my ideas for the execution model here.
I dont even think this execution model is out of the MIT labs yet — but it will once quantum compute models become commercially available (click here for a Berkley University published introduction to the basic computational models used in quantum information theory).
An N++ procedure (actually a microservice that consumed a WSDL service and calls it) looks like this:
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;
}
RML, Reduced markup language parser and runtime
Dont you just hate it when you lose the source-file for a programming language you made in a day, so now you dont have a clue what the syntax really was? I know, I know, but I honestly dont have the syntax or examples. It does with a disk ages ago.
RML was written to simplify generating HTML documents. There are a few things that you can optimize when it comes to HTML. First of all you know that the browser will read the document from top and downwards. This might not mean much at first glance, but it actually means that a language doesnt need the abillity to call emitter-code that has already executed (above). Think of it as being able to omit calls to procedure behind you in the source. That would be a mess for a language like delphi – but it doesnt impact a language that execute linear without any forms of jumps!
I seem to remember it looked something like this:
createobject(TRMLObject)
{
writestr("testing");
if(a=12)
{
readstr("mer testing");
}
}
createobject(TRMLHeading)
{
settitle("testing second object");
if(a=12)
{
writestr("heading object successfully done");
}
}
createobject(TRMLObject)
{
writestr("testing third object");
if(a=12)
{
readstr("mer testing from da third object");
}
}
The idea is ofcourse that you have some pre-defined objects, a bit like custom-controls in Smart Pascal, and you create and populate these in a top-down fashion.
Once defined, generating quite advanced HTML documents can be done extremely fast. Much faster than ASP, DWS or php since no jumps are involved.
Here is how you compile and run a small debug session (drop a memo and button on a form first):
var
FContext: TRMLParseContext;
FText: String;
begin
FText:= 'createobject(TRMLObject)'
+ '{'
+ ' writestr("testing");'
+ ' if(a=12)'
+ ' {'
+ ' readstr("mer testing");'
+ ' }'
+ '}'
+ 'createobject(TRMLHeading)'
+ '{'
+ ' settitle("testing second object");'
+ ' if(a=12)'
+ ' {'
+ ' writestr("heading object successfully done");'
+ ' }'
+ '}'
+ 'createobject(TRMLObject)'
+ '{'
+ ' writestr("testing third object");'
+ ' if(a=12)'
+ ' {'
+ ' readstr("mer testing from da third object");'
+ ' }'
+ '}';
// double the code, just to get some payload
FText := FText + FText;
memo1.text:='';
If RMLAllocContext(FContext,FText,[TRMLObject,TRMLHeading]) then
Begin
try
if RMLCompile(FContext) then
Begin
caption:='Compilation was a success';
If RMLExecute(FContext) then
Begin
Caption:='Executed successfully';
memo1.text:=FContext.pcOutput;
end;
end else
caption:=Format('compilation failed [%s]',[FContext.pcError]);
finally
RMLDisposeContext(FContext);
end;
end;
And here is the full code for the parser and runtime (still a few tidbits to work on, but its childs play). If you can make sense of it, knock yourself out 🙂
unit rml;
interface
uses sysutils, classes, dialogs;
type
TRMLObject = Class;
TRMLClass = Class of TRMLObject;
TRMLOperator = (opLess,opMore,opEquals,opNotEquals);
TRMLDataType = (daString,daNumber,daBoolean,daCustom);
TRMLEntryType = (etAssignment,etMethod,etRepeat,etCreate,etIf);
TRMLObjProc = Function (Const EntryData:Pointer):Boolean of Object;
(* represents a single condition in an IF statement *)
PRMLCondition = ^TRMLCondition;
TRMLCondition = Packed Record
coSource: String;
coTarget: String;
coOperator: TRMLOperator;
End;
(* represents a parsed code declaration *)
PRMLEntryDeclaration = ^TRMLEntryDeclaration;
TRMLEntryDeclaration = Packed Record
cxToken: String;
cxCondition: String;
End;
(* represents a compiled parameter *)
PRMLParameter = ^TRMLParameter;
TRMLParameter = Packed Record
prType: TRMLDataType;
prValue: Pointer;
prSize: Integer;
End;
(* represents a compiled code entry *)
PRMLEntryData = ^TRMLEntryData;
TRMLEntryData = Packed Record
edtype: TRMLEntryType;
edDeclaration: TRMLEntryDeclaration;
edObject: TRMLObject;
edParent: PRMLEntryData;
edMethod: TRMLObjProc;
edContext: Pointer;
edConditions: Array of PRMLCondition;
edParameters: Array of PRMLParameter;
edSubEntries: Array of PRMLEntryData;
End;
PRMLParseContext = ^TRMLParseContext;
TRMLParseContext = Packed Record
pcSignature: Integer;
pcCol: Integer;
pcRow: Integer;
pcPos: Integer;
pcLen: Integer;
pcData: String;
pcError: String;
pcOutput: String;
pcRoot: TRMLEntryData;
pcClasses: Array of TRMLClass;
End;
TRMLReadProc = Function (Var OutData;var Bytes:Integer):Boolean of Object;
TRMLWriteProc = Function (Var InData;Const Bytes:Integer):Boolean of Object;
TRMLProcEntry = Function (Const Entry:PRMLEntryData):Boolean of Object;
PRMLObjectIndex = ^TRMLObjectIndex;
TRMLObjectIndex = Packed Record
oiMethods: Array of record
omName: String;
omSyntax: Array of TRMLDataType;
omEntry: TRMLProcEntry;
end;
oiProperties: Array of record
oiName: String;
oiRead: TRMLReadProc;
oiWrite: TRMLWriteProc;
oiType: TRMLDataType;
end;
End;
TRMLObject = Class(TObject)
Private
FIndexData: TRMLObjectIndex;
FIndexPTR: PRMLObjectIndex;
Private
Function DoWriteStr(Const Entry:PRMLEntryData):Boolean;
Function DoReadStr(Const Entry:PRMLEntryData):Boolean;
protected
Procedure Output(Const Context:PRMLParseContext;Const Value:String);
Procedure RegisterProperty(Const Name:String;Const DataType:TRMLDataType;
Const _Read:TRMLReadProc;Const _Write:TRMLWriteProc);
Procedure RegisterMethod(Const Name:String;
Const Syntax: Array of TRMLDataType;
Const Entry: TRMLProcEntry);
Public
Property ObjectIndex:PRMLObjectIndex read FIndexPTR;
Constructor Create;virtual;
End;
TRMLHeading = Class(TRMLObject)
Private
FTitle: String;
Function DoSetTitle(Const Entry:PRMLEntryData):Boolean;
Function DoReadTitle(Var OutData;var Bytes:Integer):Boolean;
Function DoWriteTitle(Var InData;Const Bytes:Integer):Boolean;
Public
property Title:String read FTitle write FTitle;
Constructor Create;override;
End;
Function RMLAllocContext(var Context:TRMLParseContext;
Const Source:String;Const ClsBase:Array of TRMLClass):Boolean;
Function RMLDisposeContext(Var Context:TRMLParseContext):Boolean;
Function RMLCompile(Var Context:TRMLParseContext):Boolean;
Function RMLExecute(Const Context:TRMLParseContext):Boolean;
Function RMLParseEntry(Value:String;
var Declaration:TRMLEntryDeclaration;var Error:String):Boolean;
implementation
//###########################################################################
// TRMLHeading
//###########################################################################
Constructor TRMLHeading.Create;
Begin
inherited;
RegisterMethod('settitle',[daString],DoSetTitle);
RegisterProperty('title',daString,DoReadTitle,DoWriteTitle);
end;
Function TRMLHeading.DoSetTitle(Const Entry:PRMLEntryData):Boolean;
var
FTemp: String;
Begin
result:=length(Entry^.edParameters)>0;
If result and (Entry^.edParameters[0].prType=daString) then
DoWriteTitle(Entry^.edParameters[0].prValue^,
Entry^.edParameters[0].prSize);
end;
Function TRMLHeading.DoReadTitle(Var OutData;var Bytes:Integer):Boolean;
Begin
Bytes:=Length(FTitle);
If Bytes>0 then
move(FTitle[1],outData,Bytes);
end;
Function TRMLHeading.DoWriteTitle(Var InData;Const Bytes:Integer):Boolean;
Begin
SetLength(FTitle,bytes);
if Bytes>0 then
move(inData,FTitle[1],Bytes);
end;
//###########################################################################
// TRMLObject
//###########################################################################
Constructor TRMLObject.Create;
begin
inherited;
FIndexPTR:=@FIndexData;
RegisterMethod('writestr',[daString],DoWriteStr);
RegisterMethod('readstr',[daString],DoReadStr);
end;
Procedure TRMLObject.Output(Const Context:PRMLParseContext;
Const Value:String);
Begin
Context^.pcOutput:=Context^.pcOutput + Value;
end;
Function TRMLObject.DoReadStr(Const Entry:PRMLEntryData):Boolean;
var
FText: String;
Begin
result:=True;
With Entry^ do
Begin
FText:='Token: ' + edDeclaration.cxToken + #13#10;
FText:=FText + 'Condition: ' + edDeclaration.cxCondition + #13#10;
FText:=FText + #13#10;
Output(edContext,FText);
end;
end;
Function TRMLObject.DoWriteStr(Const Entry:PRMLEntryData):Boolean;
var
FText: String;
Begin
result:=True;
With Entry^ do
Begin
FText:='Token: ' + edDeclaration.cxToken + #13#10;
FText:=FText + 'Condition: ' + edDeclaration.cxCondition + #13#10;
FText:=FText + #13#10;
Output(edContext,FText);
end;
end;
Procedure TRMLObject.RegisterProperty(Const Name:String;
Const DataType:TRMLDataType;
Const _Read:TRMLReadProc;Const _Write:TRMLWriteProc);
var
FCount: Integer;
Begin
//FCount:=high(FIndexData.oiProperties) - Low(FIndexData.oiProperties) + 1;
FCount:=Length(FIndexData.oiProperties);
SetLength(FIndexData.oiProperties,FCount+1);
FIndexData.oiProperties[FCount].oiName:=Name;
FIndexData.oiProperties[FCount].oiRead:=_Read;
FIndexData.oiProperties[FCount].oiWrite:=_Write;
FIndexData.oiProperties[FCount].oiType:=DataType;
end;
Procedure TRMLObject.RegisterMethod(Const Name:String;
Const Syntax: Array of TRMLDataType;
Const Entry: TRMLProcEntry);
var
FCount: Integer;
FTemp: Integer;
Begin
//FCount:=high(FIndexData.oiMethods) - Low(FIndexData.oiMethods) + 1;
FCount:=Length(FIndexData.oiMethods);
SetLength(FIndexData.oiMethods,FCount+1);
FIndexData.oiMethods[FCount].omName:=Name;
FIndexData.oiMethods[FCount].omEntry:=Entry;
//FTemp:=high(Syntax) - Low(Syntax) + 1;
FTemp:=Length(Syntax);
If FTemp>0 then
Begin
SetLength(FIndexData.oiMethods[FCount].omSyntax,FTemp);
for FTemp:=low(syntax) to high(syntax) do
FIndexData.oiMethods[FCount].omSyntax[FTemp]:=Syntax[FTemp];
end;
end;
//###########################################################################
// RML util methods
//###########################################################################
Function RMLContainChars(Const Value:String;const Chars:String):Boolean;
var
x: Integer;
Begin
result:=True;
for x:=1 to length(chars) do
Begin
if pos(chars[x],Value)<1 then
Begin
result:=False;
Break;
end;
end;
end;
Function RMLScanFor(const Value:String;Const Target:CHAR;
Const Breakers:String;var Len:Integer):Boolean;
var
xpos: Integer;
Begin
result:=False;
Len:=-1;
xpos:=1;
while xpos<=Length(Value) do Begin If Value[xpos]=Target then Begin Len:=xpos-1; Result:=True; Break; end else Begin if pos(Value[xpos],Breakers)>0 then
Break;
end;
inc(xpos);
end;
end;
Function RMLisNumber(Const Value:String):Boolean;
const
CHARSET = '0123456789';
var
x: Integer;
Begin
Result:=True;
for x:=1 to length(Value) do
Begin
if pos(Value[x],CHARSET)<1 then
Begin
result:=False;
Break;
end;
end;
end;
Function RMLIsBoolean(Const Value:String):Boolean;
var
FTemp: String;
Begin
FTemp:=lowercase(trim(Value));
result:=(FTemp='false') or (FTemp='true');
end;
Function RMLisString(Const Value:String):Boolean;
var
x: Integer;
FLeft: Integer;
Begin
result:=False;
FLeft:=0;
(* check left side *)
for x:=1 to length(Value) do
Begin
if Value[x]='"' then
Begin
FLeft:=x;
Result:=True;
Break;
end else
if Value[x]<>#32 then
Break;
end;
(* check right side *)
If result then
Begin
for x:=Length(Value) downto 1 do
Begin
if Value[x]='"' then
Begin
If x>FLeft then
Break else
Begin
Result:=False;
Break;
end;
end else
if Value[x]<>#32 then
Break;
end;
end;
end;
Function RMLParseEntry(Value:String;
var Declaration:TRMLEntryDeclaration;
var Error:String):Boolean;
var
xpos: Integer;
Begin
fillchar(Declaration,SizeOf(Declaration),0);
Result:=RMLContainChars(value,'()');
if Result then
Begin
Result:=RMLScanFor(value,'(',')',xpos);
if result then
Begin
Declaration.cxToken:=trim(copy(value,1,xpos));
delete(value,1,xpos+1);
Result:=RMLScanFor(value,')','(',xpos);
if result then
Begin
Value:=TrimRight(Value);
Result:=xpos=(length(value)-1);
if result then
Declaration.cxCondition:=trim(Copy(Value,1,xpos));
end;
end;
end;
If not Result then
Error:='Invalid entry <' + value + '>';
end;
Function RMLAllocContext(var Context:TRMLParseContext;
Const Source:String;Const ClsBase:Array of TRMLClass):Boolean;
var
FCount: Integer;
Begin
If Context.pcSignature=SizeOf(Context) then
RMLDisposeContext(Context);
fillchar(Context,SizeOf(Context),#0);
Context.pcSignature:=SizeOf(Context);
Context.pcLen:=Length(Source);
Context.pcData:=Source;
FCount:=High(clsBase) - low(clsBase)+1;
If FCount>0 then
Begin
SetLength(Context.pcClasses,FCount);
for FCount:=Low(clsBase) to high(clsBase) do
Context.pcClasses[FCount]:=clsBase[FCount];
end;
result:=True;
end;
Procedure RMLDisposeEntryData(Const Data:PRMLEntryData);
var
FTemp: Integer;
x: Integer;
Begin
(* dispose of condition data *)
FTemp:=length(Data^.edConditions);
While FTemp>0 do
Begin
Dispose(Data^.edConditions[FTemp-1]);
dec(FTemp);
end;
SetLength(Data^.edConditions,0);
(* dispose of parameter data *)
FTemp:=length(Data^.edParameters);
While FTemp>0 do
Begin
If length(Data^.edParameters)>0 then
Begin
for x:=Low(Data^.edParameters) to high(Data^.edParameters) do
If Data^.edParameters[x]^.prSize>0 then
FreeMem(Data^.edParameters[x]^.prValue);
end;
Dispose(Data^.edParameters[FTemp-1]);
dec(FTemp);
end;
SetLength(Data^.edParameters,0);
(* dispose of sub entries *)
//Ftemp:=High(Data^.edSubEntries)-Low(Data^.edSubEntries)+1;
FTemp:=Length(Data^.edSubEntries);
While FTemp>0 do
Begin
RMLDisposeEntryData(Data^.edSubEntries[FTemp-1]);
Dec(FTemp);
end;
SetLength(Data^.edSubEntries,0);
(* dispose of script object *)
If not (Data^.edtype in [etIf,etRepeat,etMethod])
and (Data^.edObject<>NIL) then
Data^.edObject.free;
(* dispose of entry *)
Dispose(Data);
end;
Function RMLDisposeContext(Var Context:TRMLParseContext):Boolean;
var
FCount: Integer;
Begin
Result:=Context.pcSignature=SizeOf(Context);
If Result then
Begin
Context.pcSignature:=0;
Context.pcData:='';
Context.pcError:='';
FCount:=Length(Context.pcRoot.edSubEntries);
//FCount:=High(Context.pcRoot.edSubEntries)
//- Low(Context.pcRoot.edSubEntries) + 1;
While FCount>0 do
Begin
RMLDisposeEntryData(Context.pcRoot.edSubEntries[FCount-1]);
dec(FCount);
end;
SetLength(Context.pcRoot.edSubEntries,0);
end;
end;
//###########################################################################
// RML core methods
//###########################################################################
Function RMLImplements(Const MethodName:String;
Const obj:TRMLObject):Boolean;
var
FTable: PRMLObjectIndex;
FCount: Integer;
Begin
Result:=Obj<>NIL;
If result then
Begin
(* get object inex *)
FTable:=Obj.ObjectIndex;
//FCount:=High(FTable^.oiMethods) - low(FTable^.oiMethods) + 1;
FCount:=Length(FTable^.oiMethods);
Result:=FCount>0;
If Result then
Begin
for FCount:=low(FTable^.oiMethods) to high(FTable^.oiMethods) do
Begin
Result:=FTable^.oiMethods[FCount].omName=MethodName;
If Result then
Break;
end;
end;
end;
end;
Function RMLGetMethodEntry(Const MethodName:String;
Const obj:TRMLObject;var outEntry:TRMLObjProc):Boolean;
var
FTable: PRMLObjectIndex;
FCount: Integer;
Begin
Result:=Obj<>NIL;
If result then
Begin
(* get object inex *)
FTable:=Obj.ObjectIndex;
//FCount:=High(FTable^.oiMethods) - low(FTable^.oiMethods) + 1;
FCount:=Length(FTable^.oiMethods);
Result:=FCount>0;
If Result then
Begin
for FCount:=low(FTable^.oiMethods) to high(FTable^.oiMethods) do
Begin
Result:=FTable^.oiMethods[FCount].omName=MethodName;
If Result then
Begin
outEntry:=TRMLObjProc(FTable^.oiMethods[FCount].omEntry);
Break;
end;
end;
end;
end;
end;
Function RMLCreateObject(var Context:TRMLParseContext;
Const Objname:String;var outObject:TRMLObject;
var Error:String):Boolean;
var
FCount: Integer;
Begin
FCount:=High(Context.pcClasses) - Low(Context.pcClasses) + 1;
Result:=FCount>0;
if Result then
Begin
For FCount:=Low(Context.pcClasses) to high(Context.pcClasses) do
Begin
Result:=lowercase(Context.pcClasses[FCount].ClassName)=lowercase(objName);
If result then
Begin
outObject:=Context.pcClasses[FCount].Create;
Break;
end;
end;
end;
If not Result then
Error:='Unknown class <' + Objname + '>';
end;
Function RMLAddEntry(var Context:TRMLParseContext;
Var Declaration:TRMLEntryDeclaration;
Root:PRMLEntryData;var NewEntry:PRMLEntryData;
var Error:String):Boolean;
var
FCount: Integer;
x: Integer;
FTemp: String;
FLen: Integer;
FPar: PRMLParameter;
Begin
Result:=Root<>NIL;
If result then
Begin
(* create new entry *)
new(NewEntry);
(* Reset entry record *)
NewEntry^.edType:=etAssignment;
NewEntry^.edObject:=NIL;
NewEntry^.edMethod:=NIL;
SetLength(NewEntry^.edConditions,0);
SetLength(NewEntry^.edParameters,0);
SetLength(NewEntry^.edSubEntries,0);
(* Set basic values *)
NewEntry^.edParent:=Root;
NewEntry^.edContext:=@Context;
newEntry^.edDeclaration:=Declaration;
(* insert entry into parent *)
FCount:=Length(Root^.edSubEntries);
SetLength(Root^.edSubEntries,FCount+1);
Root^.edSubEntries[FCount]:=NewEntry;
(* tokenize *)
If declaration.cxToken='createobject' then
Begin
NewEntry^.edtype:=etCreate;
Result:=RMLCreateObject
(
Context,declaration.cxCondition,
NewEntry^.edObject,Error
);
end else
if declaration.cxToken='if' then
Begin
NewEntry^.edtype:=etIF;
NewEntry^.edObject:=NewEntry^.edParent.edObject;
end else
if declaration.cxToken='repeat' then
NewEntry^.edtype:=etRepeat else
Begin
(* method call? Make sure entry object supports this *)
Result:=NewEntry^.edParent.edObject<>NIL;
If Result then
Begin
(* check if object supports the method name *)
Result:=RMLImplements(declaration.cxToken,NewEntry^.edParent.edObject);
If Result then
Begin
(* Query object for method entry *)
Result:=RMLGetMethodEntry
(
declaration.cxToken,
NewEntry^.edParent.edObject,
NewEntry^.edMethod
);
If result then
Begin
NewEntry^.edtype:=etMethod;
NewEntry^.edObject:=NewEntry^.edParent.edObject;
(* now parse the parameter conditions *)
x:=0;
While x<Length(declaration.cxCondition) do Begin inc(x); If (declaration.cxCondition[x]=',') or (x=Length(declaration.cxCondition)) then Begin If x=Length(declaration.cxCondition) then FTemp:=FTemp + declaration.cxCondition[x]; FTemp:=trim(FTemp); If length(FTemp)>0 then
Begin
(* create a new parameter *)
FLen:=length(NewEntry^.edParameters);
setlength(NewEntry^.edParameters,FLen+1);
New(FPar);
If RMLIsString(FTemp) then
FPar^.prType:=daString else
if RMLIsNumber(FTemp) then
FPar^.prType:=daNumber else
if RMLIsBoolean(FTemp) then
FPar^.prType:=daBoolean else
FPar^.prType:=daCustom;
Case FPar^.prType of
daString:
Begin
Delete(FTemp,1,1);
Delete(FTemp,length(FTemp),1);
FPar^.prSize:=Length(FTemp);
FPar^.prValue:=AllocMem(FPar^.prSize);
move(FTemp[1],FPar^.prValue^,FPar^.prSize);
end;
daNumber:
Begin
FPar^.prSize:=SizeOf(Integer);
FPar^.prValue:=AllocMem(FPar^.prSize);
PInteger(FPar^.prValue)^:=StrToInt(FTemp);
end;
daBoolean:
Begin
end;
daCustom:
Begin
end;
end;
NewEntry^.edParameters[FLen]:=FPar;
FTemp:='';
end else
Begin
//Invalid parameter error
end;
end else
FTemp:=FTemp + declaration.cxCondition[x]
end;
{
Validate parameter datatypes here!
If (Length(NewEntry^.edParameters)>0) then
Begin
for x:=Low(NewEntry^.edParameters) to
high(NewEntry^.edParameters) do
Begin
newEntry^.edObject.
end;
end; }
end;
end else
Begin
// property assignment test here
end;
end;
end;
(* Failed to tokenize? *)
If not Result then
Begin
(* dispose of entry data *)
Dispose(NewEntry);
NewEntry:=NIL;
SetLength(Root^.edSubEntries,FCount);
Context.pcError:=Format('Invalid token "%s"',[declaration.cxToken]);
end;
end else
Error:='AddEntry failed, root can not be NIL';
end;
Function RMLParseObject(Var Context:TRMLParseContext;
Const Root:PRMLEntryData):Boolean;
var
FChar: Char;
FTemp: String;
FDeclaration: TRMLEntryDeclaration;
FNewEntry: PRMLEntryData;
Begin
Result:=Context.pcSignature=SizeOf(Context);
If result then
Begin
(* update cursor *)
inc(Context.pcPos);
inc(Context.pcCol);
while Result and (Context.pcPos<Context.pcLen) do
Begin
FChar:=Context.pcData[Context.pcPos];
Case FCHAR of
#13:
Begin
inc(Context.pcRow);
inc(Context.pcPos);
Context.pcCol:=0;
Continue;
end;
';':
Begin
Result:=RMLParseEntry(trim(FTemp),FDeclaration,Context.pcError);
If result then
Result:=RMLAddEntry
(
Context,
FDeclaration,
root,
FNewEntry,
Context.pcError
);
If Result then
Begin
inc(Context.pcPos);
inc(Context.pcCol);
If FNewEntry^.edtype=etIF then
Result:=RMLParseObject(Context,FNewEntry);
end;
FTemp:='';
end;
'{':
Begin
Result:=RMLParseEntry(FTemp,FDeclaration,Context.pcError);
If Result then
Begin
Result:=FDeclaration.cxToken='if';
If result then
Begin
Result:=RMLAddEntry
(
Context,
FDeclaration,
Root,
FNewEntry,
Context.pcError
);
If Result then
Result:=RMLParseObject(Context,FNewEntry);
end;
end;
FTemp:='';
end;
'}':
Begin
inc(Context.pcCol);
inc(Context.pcPos);
Break;
end;
else
Begin
FTemp:=FTemp + FChar;
inc(Context.pcCol);
inc(Context.pcPos);
end;
end;
end;
end;
end;
Function RMLExecute(Const Context:TRMLParseContext):Boolean;
Function RunEntry(Const Item:PRMLEntryData):Boolean;
var
FSubCount: Integer;
x: Integer;
Begin
result:=True;
Case Item^.edtype of
etCreate,
etAssignment:
Begin
FSubCount:=Length(Item^.edSubEntries);
for x:=1 to FSubCount do
Begin
result:=RunEntry(Item^.edSubEntries[x-1]);
If not result then
break;
end;
end;
etMethod:
Begin
{result:=RMLGetMethodEntry(Item^.edDeclaration.cxToken,
Item^.edObject,FEntry);
If result then
result:=FEntry(Item); }
Result:=TRMLProcEntry(Item^.edMethod)(Item);
end;
etRepeat:
Begin
//FSubCount:=Length(Item^.edSubEntries);
end;
etIf:
Begin
FSubCount:=Length(Item^.edSubEntries);
for x:=1 to FSubCount do
RunEntry(Item^.edSubEntries[x-1]);
end;
end;
End;
Begin
Result:=Context.pcSignature=SizeOf(Context);
If result then
Begin
result:=length(Context.pcError)<1;
If result then
result:=RunEntry(@Context.pcRoot);
end;
end;
Function RMLCompile(Var Context:TRMLParseContext):Boolean;
var
FChar: Char;
FTemp: String;
FDeclaration: TRMLEntryDeclaration;
FNewEntry: PRMLEntryData;
Begin
Result:=Context.pcSignature=SizeOf(Context);
If result then
Begin
Context.pcCol:=0;
Context.pcRow:=0;
Context.pcPos:=1;
Context.pcError:='';
while Result and (Context.pcPos<Context.pcLen) do
Begin
FChar:=Context.pcData[Context.pcPos];
Case FCHAR of
#13:
Begin
inc(Context.pcRow);
inc(Context.pcPos);
Context.pcCol:=0;
Continue;
end;
'{':
Begin
Result:=RMLParseEntry(FTemp,FDeclaration,Context.pcError);
If Result then
Begin
Result:=FDeclaration.cxToken='createobject';
If result then
Begin
Result:=RMLAddEntry
(
Context,
FDeclaration,
@Context.pcRoot,
FNewEntry,
Context.pcError
);
If Result then
Result:=RMLParseObject(Context,FNewEntry);
end;
end;
FTemp:='';
end;
'}':
Begin
end;
else
Begin
FTemp:=FTemp + FChar;
inc(Context.pcCol);
inc(Context.pcPos);
end;
end;
end;
end;
end;
end.
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++ 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
- Begin Parser
- Exit CaseItem Parser
- CaseItem Parser
- Exit Case Parser
- Case Parser
- Exit Begin Parser
- Begin Parser
- Condition 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 🙂
Jon L. Aasenden 
You must be logged in to post a comment.