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 🙂
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.
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.
Recent
The vatican vault
- January 2022
- October 2021
- March 2021
- November 2020
- September 2020
- July 2020
- June 2020
- April 2020
- March 2020
- February 2020
- January 2020
- November 2019
- October 2019
- September 2019
- August 2019
- July 2019
- June 2019
- May 2019
- April 2019
- March 2019
- February 2019
- January 2019
- December 2018
- November 2018
- October 2018
- September 2018
- August 2018
- July 2018
- June 2018
- May 2018
- April 2018
- March 2018
- February 2018
- January 2018
- December 2017
- November 2017
- October 2017
- August 2017
- July 2017
- June 2017
- May 2017
- April 2017
- March 2017
- February 2017
- January 2017
- December 2016
- November 2016
- October 2016
- September 2016
- August 2016
- July 2016
- June 2016
- May 2016
- April 2016
- March 2016
- January 2016
- December 2015
- November 2015
- October 2015
- September 2015
- August 2015
- June 2015
- May 2015
- April 2015
- March 2015
- February 2015
- January 2015
- December 2014
- November 2014
- October 2014
- September 2014
- August 2014
- July 2014
- June 2014
- May 2014
- April 2014
- March 2014
- February 2014
- January 2014
- December 2013
- November 2013
- October 2013
- September 2013
- August 2013
- July 2013
- June 2013
- May 2013
- February 2013
- August 2012
- June 2012
- May 2012
- April 2012
You must be logged in to post a comment.