fmain_nodebug.pas |
Makefile
// fmain 0.0.89 beta ( nodebug )
// - string matching still somewhat dirty
// - zero sized input file not allowed though it should
program fmain_list_structure;
const
ptrArrSize = 32;
type
ChLstElmPtr = ^ChLstElm;
ChLstElm = packed record
succElm: ChLstElmPtr;
ch: Char;
end;
PtrArr = packed array[1..ptrArrSize] of ChLstElmPtr;
PtrLstElmPtr = ^PtrLstElm;
PtrLstElm = packed record
succElm: PtrLstElmPtr;
ptr: ptrArr;
end;
RuleElmPtr = ^RuleElm;
RuleElm = packed record
succElm: RuleElmPtr;
terminate: Boolean;
priority, srcStrLen, dstStrLen: Cardinal;
srcStrPtr, dstStrPtr: ^Char;
end;
var
inputFileName : String(255) value 'input';
outputFileName: String(255) value 'output';
ruleFileName : String(255) value 'rules';
chBufElmNum: Cardinal value 32768;
isSort, isCheck: Boolean value true;
fstChLstElmPtr: ChLstElmPtr;
fstEmpChLstElmPtr: ChLstElmPtr value nil;
fstPtrLstElmPtr: PtrLstElmPtr value nil;
wrkPtrLstElmPtr: PtrLstElmPtr;
fstRulePtr: RuleElmPtr;
talRulePtr: RuleElmPtr;
ptrCnt: Cardinal value 0;
procedure EvaluateParams;
label
evaluateParams_fnd,
evaluateParams_err;
var
i: Cardinal value 1;
errCode: Integer;
begin
while i <= ParamCount do
begin
if (ParamStr(i) = '-i') or (ParamStr(i) = '--inputFile') then
begin
Inc(i);
inputFileName := ParamStr(i);
goto evaluateParams_fnd;
end;
if (ParamStr(i) = '-o') or (ParamStr(i) = '--outputFile') then
begin
Inc(i);
outputFileName := ParamStr(i);
goto evaluateParams_fnd;
end;
if (ParamStr(i) = '-r') or (ParamStr(i) = '--rulesFile') then
begin
Inc(i);
ruleFileName := ParamStr(i);
goto evaluateParams_fnd;
end;
if (ParamStr(i) = '-bs') or (ParamStr(i) = '--bufferSize') then
begin
Inc(i);
Val(ParamStr(i), chBufElmNum, errCode);
if errCode <> 0 then
goto evaluateParams_err;
if chBufElmNum < 16 then
chBufElmNum := 16;
goto evaluateParams_fnd;
end;
if (ParamStr(i) = '-ns') or (ParamStr(i) = '--noSort') then
begin
isSort := false;
goto evaluateParams_fnd;
end;
if (ParamStr(i) = '-nc') or (ParamStr(i) = '--noCheck') then
begin
isCheck := false;
goto evaluateParams_fnd;
end;
if (ParamStr(i) = '-a') or (ParamStr(i) = '--about') then
begin
WriteLn('fmain 0.0.89 beta - fast markov algorithm interpreter');
WriteLn;
WriteLn(' compiled for gnu/linux on i386 isa');
WriteLn(' compiled via gnu pascal 2.1');
WriteLn(' author jörg meyer, j.meyer@stud.fh-sm.de');
Halt($00);
end;
if (ParamStr(i) = '-h') or (ParamStr(i) = '--help') then
begin
WriteLn('fmain [ -i file | --inputFile file ] - specify file name, default is input');
WriteLn(' [ -o file | --outputFile file ] - specify file name, default is output');
WriteLn(' [ -r file | --rulesFile file ] - specify file name, default is rules');
WriteLn;
WriteLn(' [ -bs size | --bufferSize size ] - specify buffer size, default is 32768');
WriteLn;
WriteLn(' [ -ns | --noSort ] - don''t sort rules, not recommended');
WriteLn(' [ -nc | --noCheck ] - don''t check rules for multiple use of');
WriteLn(' equal priority etc, not recommended');
WriteLn;
WriteLn(' [ -a | --about ] - show some info about fmain');
WriteLn(' [ -h | --help ] - show this help screen');
Halt($00);
end;
evaluateParams_err:
WriteLn(stdErr, 'error evaluating parameter "', ParamStr(i), '", halting');
Halt($01);
evaluateParams_fnd:
Inc(i);
end;
end;
function GetChLstMemory(elmNum: Cardinal): Pointer;
var
tmpPtr: Pointer;
begin
GetMem(tmpPtr, SizeOf(ChLstElm) * elmNum);
GetChLstMemory := tmpPtr;
end;
procedure ReadInputFile;
var
inputFile: File;
chBuf: array[0..Pred(chBufElmNum)] of Char;
tmpPtr: ChLstElmPtr value nil;
chNumRead, b, e: Cardinal;
begin
Assign(inputFile, inputFileName);
Reset(inputFile, 1);
BlockRead(inputFile, chBuf, chBufElmNum, chNumRead);
if chNumRead = 0 then
begin
WriteLn(stdErr, 'zero sized input file not allowed, halting');
Halt($E0);
end;
repeat
if fstPtrLstElmPtr = nil then
begin
New(fstPtrLstElmPtr);
wrkPtrLstElmPtr := fstPtrLstElmPtr;
end;
Inc(ptrCnt); // store next ptr at next position of current ptr-array
if ptrCnt > ptrArrSize then // ptr-array already completely filled
begin
New(wrkPtrLstElmPtr^.succElm);
wrkPtrLstElmPtr := wrkPtrLstElmPtr^.succElm;
ptrCnt := 1; // store next ptr at the beginning of new ptr-array
end;
wrkPtrLstElmPtr^.ptr[ptrCnt] := GetChLstMemory(chBufElmNum);
if tmpPtr <> nil then
// last chListElm of old chElm-block points to begin of curr chElm-block
// pointer to new chElm-block may be stored in old or curr ptrArr-block
tmpPtr^.succElm := wrkPtrLstElmPtr^.ptr[ptrCnt];
if chNumRead <> 1 then // ensures chNumRead - 2 to be always defined
begin
for e := 0 to Pred(Pred(chNumRead)) do
with wrkPtrLstElmPtr^ do
begin
(ptr[ptrCnt] + e)^.ch := chBuf[e];
(ptr[ptrCnt] + e)^.succElm := (ptr[ptrCnt] + Succ(e));
end;
Inc(e);
end
else
e := 0;
(wrkPtrLstElmPtr^.ptr[ptrCnt] + e)^.ch := chBuf[e];
tmpPtr := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
BlockRead(inputFile, chBuf, chBufElmNum, chNumRead);
until chNumRead = 0;
Close(inputFile);
tmpPtr^.succElm := nil; // terminate chElmLst by setting last succElm to nil
for e := Succ(e) to Pred(chBufElmNum) do // for first to last empty element
if fstEmpChLstElmPtr = nil then
begin
fstEmpChLstElmPtr := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
fstEmpChLstElmPtr^.succElm := nil;
end
else
begin
tmpPtr := fstEmpChLstElmPtr;
fstEmpChLstElmPtr := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
fstEmpChLstElmPtr^.succElm := tmpPtr;
end;
fstChLstElmPtr := fstPtrLstElmPtr^.ptr[1]; // first chElm can be found here
end;
procedure ReadRuleFile;
var
ruleFile: File;
chBuf: array[0..Pred(chBufElmNum)] of Char;
chNumRead: Cardinal;
ruleChNum: Cardinal;
fstRuleChPtr: ^Char;
b, m: Cardinal value 0;
procedure FileRules;
const
attrib = 0;
fromStrDef_cnt = 1;
fromStrDef_copy = 2;
toStrDef_cnt = 3;
toStrDef_copy = 4;
var
wrkRulePtr: RuleElmPtr;
pChar: Char;
priorStr, asciiStr: String (10);
priorVal, asciiVal: Cardinal;
errCode: Integer;
wrkSrcStrPtr, wrkDstStrPtr: ^Char;
remInSideRuleLPref: Cardinal;
blChars: Set of Char value [#9, #10, #13, #32]; // <- Pascal 4 ever!
dgChars: Set of Char value ['0'..'9'];
anotherRule: Boolean value false; // <- grosser Schrott
tmpRuleChPtr: ^Char;
tmpM: Cardinal;
priorDefVal: Cardinal value 0;
label
outSideRule,
inSideRule_attrib,
inSideRule_attrib_beyondInit,
inSideRule_attrib_beyondRead,
setTerminus,
setPriority,
setPriority_beyondInit,
inSideRule_fromStrDef_cnt,
inSideRule_fromStrDef_cnt_beyondRead,
inSideRule_fromStrDef_cntStrict,
inSideRule_fromStrDef_cntStrict_beyondInit,
inSideRule_fromStrDef_cntLoose,
inSideRule_fromStrDef_cntLoose_beyondInit,
maySubstOperator_cnt,
inSideRule_fromStrDef_copy,
inSideRule_fromStrDef_copy_beyondInit,
inSideRule_fromStrDef_copy_beyondRead,
inSideRule_fromStrDef_copyStrict,
inSideRule_fromStrDef_copyLoose,
inSideRule_fromStrDef_copyLoose_beyondInit,
maySubstOperator_copy,
maySubstOperator_copy_confirmed,
inSideRule_toStrDef_cnt,
inSideRule_toStrDef_cnt_beyondRead,
inSideRule_toStrDef_cntStrict,
inSideRule_toStrDef_cntStrict_beyondInit,
inSideRule_toStrDef_cntLoose,
inSideRule_toStrDef_cntLoose_beyondInit,
inSideRule_toStrDef_copy,
inSideRule_toStrDef_copy_beyondInit,
inSideRule_toStrDef_copy_beyondRead,
inSideRule_toStrDef_copyStrict,
inSideRule_toStrDef_copyLoose,
inSideRule_toStrDef_copyLoose_beyondInit,
mayAlnRem_outSideRule,
isSlnRem_outSideRule,
isMlnRem_outSideRule,
isMlnRem_outSideRule_beyondRead,
mayNoMlnRem_outSideRule,
mayAlnRem_inSideRule,
isSlnRem_inSideRule,
isMlnRem_inSideRule,
isMlnRem_inSideRule_beyondRead,
mayNoMlnRem_inSideRule,
isSrRem,
isSrRem_strict,
error,
done;
inline procedure pRead;
begin
if m = ruleChNum then goto done;
pChar := (fstRuleChPtr + m)^;
Inc(m);
end;
begin
m := 0; // <- somewhat dirty
new(fstRulePtr); // dummy - works as head
new(fstRulePtr^.succElm);
wrkRulePtr := fstRulePtr^.succElm;
outSideRule:
pRead;
if pChar = '(' then goto inSideRule_attrib;
if pChar = '[' then goto isSrRem;
if pChar = '-' then goto mayAlnRem_outSideRule;
if pChar in blChars then goto outSideRule;
goto error;
inSideRule_attrib:
if anotherRule then
begin
priorDefVal := Succ(wrkRulePtr^.priority);
new(wrkRulePtr^.succElm);
wrkRulePtr := wrkRulePtr^.succElm;
end;
wrkRulePtr^.priority := priorDefVal;
anotherRule := true;
inSideRule_attrib_beyondInit:
pRead;
inSideRule_attrib_beyondRead:
if pChar = '$' then goto setTerminus;
if pChar = 'p' then goto setPriority;
if pChar = '"' then begin
// tmpRuleChPtr := Pred(wrkRuleChPtr);
tmpM := Pred(m);
goto inSideRule_fromStrDef_cntStrict;
end;
if pChar = '#' then begin
// tmpRuleChPtr := Pred(wrkRuleChPtr);
tmpM := Pred(m);
goto inSideRule_fromStrDef_cntLoose;
end;
if pChar = '-' then begin
remInSideRuleLPref := attrib;
goto mayAlnRem_inSideRule;
end;
if pChar in blChars then goto inSideRule_attrib_beyondInit;
goto error;
setTerminus:
wrkRulePtr^.terminate := true;
goto inSideRule_attrib_beyondInit;
setPriority:
SetLength(priorStr, 0);
setPriority_beyondInit:
pRead;
if pChar in dgChars then
begin
SetLength(priorStr, Succ(Length(priorStr)));
priorStr[Length(priorStr)] := pChar;
end
else
begin
Val(priorStr, priorVal, errCode);
if errCode <> 0 then goto error;
wrkRulePtr^.priority := priorVal;
goto inSideRule_attrib_beyondRead;
end;
goto setPriority_beyondInit;
inSideRule_fromStrDef_cnt: // <- fromStrDef_cnt
pRead;
inSideRule_fromStrDef_cnt_beyondRead:
if pChar = '"' then goto inSideRule_fromStrDef_cntStrict_beyondInit;
if pChar = '#' then goto inSideRule_fromStrDef_cntLoose_beyondInit;
if pChar = '=' then goto maySubstOperator_cnt;
if pChar = '-' then begin
remInSideRuleLPref := fromStrDef_cnt;
goto mayAlnRem_inSideRule;
end;
if pChar in blChars then goto inSideRule_fromStrDef_cnt;
goto error;
inSideRule_fromStrDef_cntStrict:
wrkRulePtr^.srcStrLen := 0;
inSideRule_fromStrDef_cntStrict_beyondInit:
pRead;
if pChar = '"' then goto inSideRule_fromStrDef_cnt;
Inc(wrkRulePtr^.srcStrLen);
goto inSideRule_fromStrDef_cntStrict_beyondInit;
inSideRule_fromStrDef_cntLoose:
wrkRulePtr^.srcStrLen := 0;
inSideRule_fromStrDef_cntLoose_beyondInit:
pRead;
if pChar in dgChars then goto inSideRule_fromStrDef_cntLoose_beyondInit;
Inc(wrkRulePtr^.srcStrLen);
goto inSideRule_fromStrDef_cnt_beyondRead;
maySubstOperator_cnt:
pRead;
if pChar = '>' then
begin
// wrkRuleChPtr := tmpRuleChPtr;
m := tmpM;
goto inSideRule_fromStrDef_copy;
end;
goto error;
inSideRule_fromStrDef_copy: // <- fromStrDef_copy
GetMem(wrkRulePtr^.srcStrPtr, wrkRulePtr^.srcStrLen);
wrkSrcStrPtr := wrkRulePtr^.srcStrPtr;
inSideRule_fromStrDef_copy_beyondInit:
pRead;
inSideRule_fromStrDef_copy_beyondRead:
if pChar = '"' then goto inSideRule_fromStrDef_copyStrict;
if pChar = '#' then goto inSideRule_fromStrDef_copyLoose;
if pChar = '=' then goto maySubstOperator_copy;
if pChar = '-' then begin
remInSideRuleLPref := fromStrDef_copy;
goto mayAlnRem_inSideRule;
end;
if pChar in blChars then goto inSideRule_fromStrDef_copy_beyondInit;
goto error;
inSideRule_fromStrDef_copyStrict:
pRead;
if pChar = '"' then goto inSideRule_fromStrDef_copy_beyondInit;
wrkSrcStrPtr^ := pChar;
Inc(wrkSrcStrPtr);
goto inSideRule_fromStrDef_copyStrict;
inSideRule_fromStrDef_copyLoose:
setLength(asciiStr, 0);
inSideRule_fromStrDef_copyLoose_beyondInit:
pRead;
if pChar in dgChars then
begin
SetLength(asciiStr, Succ(Length(asciiStr)));
asciiStr[Length(asciiStr)] := pChar;
end
else
begin
Val(asciiStr, asciiVal, errCode);
if errCode <> 0 then goto error;
wrkSrcStrPtr^ := Char(asciiVal);
Inc(wrkSrcStrPtr);
goto inSideRule_fromStrDef_copy_beyondRead;
end;
goto inSideRule_fromStrDef_copyLoose_beyondInit;
maySubstOperator_copy:
pRead;
if pChar = '>' then
begin
maySubstOperator_copy_confirmed:
pRead;
if pChar = '"' then begin
// tmpRuleChPtr := Pred(wrkRuleChPtr);
tmpM := Pred(m);
goto inSideRule_toStrDef_cntStrict;
end;
if pChar = '#' then begin
// tmpRuleChPtr := Pred(wrkRuleChPtr);
tmpM := Pred(m);
goto inSideRule_toStrDef_cntLoose;
end;
if pChar in blChars then goto maySubstOperator_copy_confirmed;
goto error;
end;
goto error;
inSideRule_toStrDef_cnt: // <- toStrDef_cnt
pRead;
inSideRule_toStrDef_cnt_beyondRead:
if pChar = '"' then goto inSideRule_toStrDef_cntStrict_beyondInit;
if pChar = '#' then goto inSideRule_toStrDef_cntLoose_beyondInit;
if pChar = ')' then begin
// wrkRuleChPtr := tmpRuleChPtr;
m := tmpM;
goto insideRule_toStrDef_copy;
end;
if pChar = '-' then begin
remInSideRuleLPref := toStrDef_cnt;
goto mayAlnRem_inSideRule;
end;
if pChar in blChars then goto inSideRule_toStrDef_cnt;
goto error;
inSideRule_toStrDef_cntStrict:
wrkRulePtr^.dstStrLen := 0;
inSideRule_toStrDef_cntStrict_beyondInit:
pRead;
if pChar = '"' then goto inSideRule_toStrDef_cnt;
Inc(wrkRulePtr^.dstStrLen);
goto inSideRule_toStrDef_cntStrict_beyondInit;
inSideRule_toStrDef_cntLoose:
wrkRulePtr^.dstStrLen := 0;
inSideRule_toStrDef_cntLoose_beyondInit:
pRead;
if pChar in dgChars then goto inSideRule_toStrDef_cntLoose_beyondInit;
Inc(wrkRulePtr^.dstStrLen);
goto inSideRule_toStrDef_cnt_beyondRead;
inSideRule_toStrDef_copy: // <- toStrDef_copy
GetMem(wrkRulePtr^.dstStrPtr, wrkRulePtr^.dstStrLen);
wrkDstStrPtr := wrkRulePtr^.dstStrPtr;
inSideRule_toStrDef_copy_beyondInit:
pRead;
inSideRule_toStrDef_copy_beyondRead:
if pChar = '"' then goto inSideRule_toStrDef_copyStrict;
if pChar = '#' then goto inSideRule_toStrDef_copyLoose;
if pChar = ')' then goto outSideRule;
if pChar = '-' then begin
remInSideRuleLPref := toStrDef_copy;
goto mayAlnRem_inSideRule;
end;
if pChar in blChars then goto inSideRule_toStrDef_copy_beyondInit;
goto error;
inSideRule_toStrDef_copyStrict:
pRead;
if pChar = '"' then goto inSideRule_toStrDef_copy_beyondInit;
wrkDstStrPtr^ := pChar;
Inc(wrkDstStrPtr);
goto inSideRule_toStrDef_copyStrict;
inSideRule_toStrDef_copyLoose:
SetLength(asciiStr, 0);
inSideRule_toStrDef_copyLoose_beyondInit:
pRead;
if pChar in dgChars then
begin
SetLength(asciiStr, Succ(Length(asciiStr)));
asciiStr[Length(asciiStr)] := pChar;
end
else
begin
Val(asciiStr, asciiVal, errCode);
if errCode <> 0 then goto error;
wrkDstStrPtr^ := Char(asciiVal);
Inc(wrkDstStrPtr);
goto inSideRule_toStrDef_copy_beyondRead;
end;
goto inSideRule_toStrDef_copyLoose_beyondInit;
mayAlnRem_outSideRule: // <- mayAlnRem_outSideRule
pRead;
if pChar = '-' then goto isSlnRem_outSideRule;
if pChar = '/' then goto isMlnRem_outSideRule;
goto error;
isSlnRem_outSideRule:
pRead;
if pChar = #10 then goto outSideRule;
goto isSlnRem_outSideRule;
isMlnRem_outSideRule:
pRead;
isMlnRem_outSideRule_beyondRead:
if pChar = '/' then goto mayNoMlnRem_outSideRule;
goto isMlnRem_outSideRule;
mayNoMlnRem_outSideRule:
pRead;
if pChar = '-' then goto outSideRule;
goto isMlnRem_outSideRule_beyondRead;
mayAlnRem_inSideRule: // <- mayAlnRem_inSideRule
pRead;
if pChar = '-' then goto isSlnRem_inSideRule;
if pChar = '/' then goto isMlnRem_inSideRule;
goto error;
isSlnRem_inSideRule:
pRead;
if pChar = #10 then
begin
if remInSideRuleLPref = attrib then goto inSideRule_attrib_beyondInit;
if remInSideRuleLPref = fromStrDef_cnt then goto inSideRule_fromStrDef_cnt;
if remInSideRuleLPref = fromStrDef_copy then goto inSideRule_fromStrDef_copy;
if remInSideRuleLPref = toStrDef_cnt then goto inSideRule_toStrDef_cnt;
if remInSideRuleLPref = toStrDef_copy then goto inSideRule_toStrDef_copy;
end;
goto isSlnRem_inSideRule;
isMlnRem_inSideRule:
pRead;
isMlnRem_inSideRule_beyondRead:
if pChar = '/' then goto mayNoMlnRem_inSideRule;
goto isMlnRem_inSideRule;
mayNoMlnRem_inSideRule:
pRead;
if pChar = '-' then
begin
if remInSideRuleLPref = attrib then goto inSideRule_attrib_beyondInit;
if remInSideRuleLPref = fromStrDef_cnt then goto inSideRule_fromStrDef_cnt;
if remInSideRuleLPref = fromStrDef_copy then goto inSideRule_fromStrDef_copy;
if remInSideRuleLPref = toStrDef_cnt then goto inSideRule_toStrDef_cnt;
if remInSideRuleLPref = toStrDef_copy then goto inSideRule_toStrDef_copy;
end;
goto isMlnRem_inSideRule_beyondRead;
isSrRem:
pRead;
if pChar = '"' then goto isSrRem_strict;
if pChar = ')' then goto outSideRule;
goto isSrRem;
isSrRem_strict:
pRead;
if pChar = '"' then goto isSrRem;
goto isSrRem_strict;
error:
WriteLn(stdErr, 'error parsing ', ruleFileName, ' at offset ', m, ', halting');
Halt($10);
done:
new(talRulePtr); // dummy - works as tail
wrkRulePtr^.succElm := talRulePtr;
talRulePtr^.succElm := talRulePtr;
// letting point talRulePtr^.succElm to itself allows
// swapping last two numbers without looking
// on them as a special case while sorting
end;
procedure SortRules;
var
sorted: Boolean;
prvRulePtr, tmpRulePtr, wrkRulePtr: RuleElmPtr;
begin
repeat
sorted := true;
prvRulePtr := fstRulePtr;
wrkRulePtr := fstRulePtr^.succElm;
while wrkRulePtr^.succElm <> talRulePtr do
begin
if wrkRulePtr^.priority > wrkRulePtr^.succElm^.priority then
begin
sorted := false;
prvRulePtr^.succElm := wrkRulePtr^.succElm;
tmpRulePtr := wrkRulePtr^.succElm^.succElm;
wrkRulePtr^.succElm^.succElm := wrkRulePtr;
wrkRulePtr^.succElm := tmpRulePtr;
end;
prvRulePtr := wrkRulePtr;
wrkRulePtr := wrkRulePtr^.succElm;
end;
until sorted;
end;
procedure FreeDummyRules;
var
wrkRulePtr: RuleElmPtr;
begin
// no more sorting - head and tail may go play now
wrkRulePtr := fstRulePtr^.succElm;
Dispose(fstRulePtr);
fstRulePtr := wrkRulePtr;
while wrkRulePtr^.succElm <> talRulePtr do
wrkRulePtr := wrkRulePtr^.succElm;
Dispose(talRulePtr);
wrkRulePtr^.succElm := nil;
end;
procedure CheckRules;
var
wrkRulePtr: RuleElmPtr;
savedPrior: Cardinal;
begin
with fstRulePtr^ do
if (srcStrLen = 0) and (terminate = false) then
begin
WriteLn(stdErr, 'lowest rule searches empty word and doesn''t terminate, halting');
Halt($11);
end;
savedPrior := fstRulePtr^.priority;
wrkRulePtr := fstRulePtr^.succElm;
while wrkRulePtr <> nil do
with wrkRulePtr^ do
begin
if priority = savedPrior then
begin
WriteLn(stdErr, 'more then one rule owns priority ', priority, ', halting');
Halt($12);
end;
savedPrior := priority;
wrkRulePtr := succElm;
end;
end;
begin
Assign(ruleFile, ruleFileName);
Reset(ruleFile, 1);
ruleChNum := FileSize(ruleFile);
GetMem(fstRuleChPtr, ruleChNum);
BlockRead(ruleFile, chBuf, chBufElmNum, chNumRead);
while chNumRead <> 0 do
begin
for b := 0 to Pred(chNumRead) do
(fstRuleChPtr + m + b)^ := chBuf[b];
Inc(m, chBufElmNum);
BlockRead(ruleFile, chBuf, chBufElmNum, chNumRead);
end;
Close(ruleFile);
FileRules; // increment pointer directly for higher speed?!?
if isSort then
SortRules;
FreeDummyRules;
if isCheck then
CheckRules;
end;
procedure WriteOutputFile;
var
actChLstElmPtr: ChLstElmPtr;
outputFile: File;
chBuf: array[1..chBufElmNum] of Char;
r: Cardinal value 1;
w: Cardinal;
begin
actChLstElmPtr := fstChLstElmPtr;
Assign(outputFile, outputFileName);
Rewrite(outputFile, 1);
while actChLstElmPtr <> nil do
begin
chBuf[r] := actChLstElmPtr^.ch;
if r = chBufElmNum then
begin
BlockWrite(outputFile, chBuf, r, w);
r := 1;
end
else
Inc(r);
actChLstElmPtr := actChLstElmPtr^.succElm;
end;
BlockWrite(outputFile, chBuf, Pred(r), w);
Close(outputFile);
end;
procedure Interpret;
var
wrkRulePtr: RuleElmPtr;
matChPos, prvChPos, wrkChPos: ChLstElmPtr;
shorterStrLen, i: Cardinal;
inline function GotMatchPos: Boolean; // still very dirty
var
actChElmPtr: ChLstElmPtr;
tmpChElmPtr: ChLstElmPtr;
equal: Boolean;
emptyMatch: Boolean value false;
begin
matChPos := nil;
prvChPos := nil;
actChElmPtr := fstChLstElmPtr;
if wrkRulePtr^.srcStrLen = 0 then
begin
emptyMatch := true;
matChPos := actChElmPtr; // nil if chElmLst empty -> match var
end
else
while actChElmPtr <> nil do
begin
if wrkRulePtr^.srcStrPtr^ = actChElmPtr^.ch then
begin
equal := true;
if wrkRulePtr^.srcStrLen > 1 then
begin
tmpChElmPtr := actChElmPtr;
for i := 1 to Pred(wrkRulePtr^.srcStrLen) do
begin
if tmpChElmPtr^.succElm = nil then
begin
equal := false;
Break;
end
else
tmpChElmPtr := tmpChElmPtr^.succElm;
if (wrkRulePtr^.srcStrPtr + i)^ <> tmpChElmPtr^.ch then
begin
equal := false;
Break;
end;
end;
end;
end
else
equal := false;
if equal then
begin
matChPos := actChElmPtr;
Break;
end;
prvChPos := actChElmPtr;
actChElmPtr := actChElmPtr^.succElm;
end;
GotMatchPos := (emptyMatch or (matChPos <> nil));
end;
inline procedure SetShorterStrLen;
begin
shorterStrLen := wrkRulePtr^.srcStrLen;
if wrkRulePtr^.dstStrLen < shorterStrLen then
shorterStrLen := wrkRulePtr^.dstStrLen;
end;
inline procedure SwpStrChars;
begin
wrkChPos := matChPos;
for i := 0 to Pred(shorterStrLen) do
begin
wrkChPos^.ch := (wrkRulePtr^.dstStrPtr + i)^;
prvChPos := wrkChPos;
wrkChPos := wrkChPos^.succElm;
end;
end;
inline procedure DelStrChars;
var
hlpChPtr: Pointer;
wrkChPtr: ChLstElmPtr;
begin
wrkChPtr := prvChPos;
if prvChPos = nil then // if no previous element
for i := (wrkRulePtr^.srcStrLen - shorterStrLen) downto 1 do
if fstEmpChLstElmPtr = nil then
begin
fstEmpChLstElmPtr := fstChLstElmPtr;
fstChLstElmPtr := fstChLstElmPtr^.succElm;
fstEmpChLstElmPtr^.succElm := nil;
end
else
begin
hlpChPtr := fstEmpChLstElmPtr;
fstEmpChLstElmPtr := fstChLstElmPtr;
fstChLstElmPtr := fstChLstElmPtr^.succElm;
fstEmpChLstElmPtr^.succElm := hlpChPtr;
end
else
for i := (wrkRulePtr^.srcStrLen - shorterStrLen) downto 1 do
if fstEmpChLstElmPtr = nil then
begin
fstEmpChLstElmPtr := wrkChPtr^.succElm;
wrkChPtr^.succElm := wrkChPtr^.succElm^.succElm;
fstEmpChLstElmPtr^.succElm := nil;
end
else
begin
hlpChPtr := fstEmpChLstElmPtr;
fstEmpChLstElmPtr := wrkChPtr^.succElm;
wrkChPtr^.succElm := wrkChPtr^.succElm^.succElm;
fstEmpChLstElmPtr^.succElm := hlpChPtr;
end;
end;
inline procedure InsStrChars;
var
hlpChPtr: ChLstElmPtr;
wrkChPtr: ChLstElmPtr;
e: Cardinal;
begin
wrkChPtr := prvChPos;
for i := wrkRulePtr^.dstStrLen downto Succ(shorterStrLen) do
begin
if fstEmpChLstElmPtr = nil then
begin
Inc(ptrCnt); // store next ptr at next position of current ptr-array
if ptrCnt > ptrArrSize then // ptr-array already completely filled
begin
New(wrkPtrLstElmPtr^.succElm);
wrkPtrLstElmPtr := wrkPtrLstElmPtr^.succElm;
ptrCnt := 1; // store next ptr at the beginning of new ptr-array
end;
wrkPtrLstElmPtr^.ptr[ptrCnt] := GetChLstMemory(chBufElmNum);
for e := 0 to Pred(chBufElmNum) do // for first to last empty element
if fstEmpChLstElmPtr = nil then
begin
fstEmpChLstElmPtr := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
fstEmpChLstElmPtr^.succElm := nil;
end
else
begin
hlpChPtr := fstEmpChLstElmPtr;
fstEmpChLstElmPtr := (wrkPtrLstElmPtr^.ptr[ptrCnt] + e);
fstEmpChLstElmPtr^.succElm := hlpChPtr;
end;
end;
if prvChPos = nil then
begin
hlpChPtr := fstEmpChLstElmPtr;
fstEmpChLstElmPtr := fstEmpChLstElmPtr^.succElm;
hlpChPtr^.succElm := fstChLstElmPtr;
fstChLstElmPtr := hlpChPtr;
fstChLstElmPtr^.ch := (wrkRulePtr^.dstStrPtr + Pred(i))^; // swap
end
else
begin
hlpChPtr := fstEmpChLstElmPtr;
fstEmpChLstElmPtr := fstEmpChLstElmPtr^.succElm;
hlpChPtr^.succElm := wrkChPtr^.succElm;
wrkChPtr^.succElm := hlpChPtr;
wrkChPtr^.succElm^.ch := (wrkRulePtr^.dstStrPtr + Pred(i))^; // swap
end;
end;
end;
begin
repeat
wrkRulePtr := fstRulePtr;
repeat
if GotMatchPos then // sets matChPos and prvChPos
Break // current rule will work fine
else // if nothing matched
wrkRulePtr := wrkRulePtr^.succElm // try next rule in new loop
until wrkRulePtr = nil; // no more rules available
if wrkRulePtr = nil then // no rule matches anymore
Break // substitution done.
else
begin // apply rule ...
SetShorterStrLen;
if shorterStrLen <> 0 then // if there are chars to swap
SwpStrChars; // swap these chars
if wrkRulePtr^.srcStrLen > shorterStrLen then
DelStrChars; // del chars using prvChPos
if wrkRulePtr^.dstStrLen > shorterStrLen then
InsStrChars;
if wrkRulePtr^.terminate then // break after terminative rule
Break; // substitution done.
end;
until false; // left via several breaks
end;
begin
EvaluateParams;
ReadInputFile;
ReadRuleFile;
Interpret;
WriteOutputFile;
end.