
program extractor4;

{$I DIRECTIVES}

uses
  Classes, SysUtils,
  IOUtils,
  FLRE, FLREUnicode;
{ https://github.com/BeRo1985/flre }

function SubStr(const aSource: string; aStart: integer; aEnd: integer = MAXINT): string;
begin
  result := Copy(aSource, aStart, aEnd - aStart + 1);
end;

var
  txt: string;
  i, j, k: integer;
  data: TStringList;
  re: TFLRE;

procedure Extraction(var aCount: integer; const aType: string);
begin
  Inc(aCount);
  data.Append(Format('_%s_%d_=%s', [aType, aCount, SubStr(txt, j, k)]));
  txt := Format('%s_%s_%d_%s', [SubStr(txt, 1, j - 1), aType, aCount, SubStr(txt, k + 1)]);
end;

type
  TReplacement = class
    function Callback(const aInput: PFLRERawByteChar; const aCaptures: TFLRECaptures): TFLRERawByteString;
  end;

function TReplacement.Callback(const aInput: PFLRERawByteChar; const aCaptures: TFLRECaptures): TFLRERawByteString;
begin
  with aCaptures[0] do result := FLREPtrCopy(aInput, Start, Length);
  result := data.Values[result];
end;

var
  c: char;
  l: integer;
  d: boolean;
  
  // |----------------+-----------+----------------------------------------|
  // | Variable name  |  Meaning  |                 Values                 |
  // |----------------+-----------+----------------------------------------|
  // | c              | comment   | #0 (eq FALSE), '{', '(', '/' (eq TRUE) |
  // | l              | literal   | 0 (eq FALSE), 1, 2, etc. (eq TRUE)     |
  // | d              | directive | FALSE, TRUE                            |
  // |----------------+-----------+----------------------------------------|
  
  ccount, lcount, dcount: integer;
  
begin
  data := TStringList.Create;
  
  if (ParamCount = 1) and FileExists(ParamStr(1))then
    txt := TFile.ReadAllText(ParamStr(1))
  else
    txt := TFile.ReadAllText({$IFDEF FPC}'extractor4.pp'{$ELSE}'extractor4.dpr'{$ENDIF});

  i := 1;
  j := 0;
  k := 0;

  c := #0;
  l := 0;
  d := FALSE;
  
  ccount := 0;
  lcount := 0;
  dcount := 0;
  
  while i <= Length(txt) do
  begin
    if c <> #0 then
    begin
      if ((c = '{') and (txt[i] = '}'))
      or ((c = '(') and (txt[i] = ')') and (txt[i - 1] = '*'))
      or ((c = '/') and (i < Length(txt)) and (txt[i + 1] in [#10, #13])) then
      begin
        k := i;
        
        Extraction(ccount, 'comment');
        
        c := #0; // comment := FALSE
        i := j - 1;
      end;
    end else

      if l <> 0 then
      begin
        if txt[i] = '''' then
        begin
          Inc(l);
          if (l mod 2 = 0) and (i < Length(txt)) and (txt[i + 1] <> '''') then
          begin
            k := i;
            
            Extraction(lcount, 'literal');
            
            l := 0; // literal := FALSE
            i := j - 1;
          end;
        end;
      end else

        if d then
        begin
          if txt[i] = '}' then
          begin
            k := i;
            
            Extraction(dcount, 'directive');
            
            d := FALSE; // directive := FALSE
            i := j - 1;
          end;
        end else

          if ((txt[i] = '{') and (i < Length(txt)) and (txt[i + 1] <> '$'))
          or ((txt[i] = '(') and (i < Length(txt)) and (txt[i + 1] = '*'))
          or ((txt[i] = '/') and (i < Length(txt)) and (txt[i + 1] = '/')) then
          begin
            j := i;
            c := txt[i]; // comment := TRUE
          end else

            if txt[i] = '''' then
            begin
              j := i;
              l := 1; // literal := TRUE
            end else

              if ((txt[i] = '{') and (i < Length(txt)) and (txt[i + 1] = '$')) then
              begin
                j := i;
                d := TRUE; // directive := TRUE
              end;

    Inc(i);
  end;

  TFile.WriteAllText('1.txt', txt);
  
  data.SaveToFile('2.txt');
  
  re := TFLRE.Create('_[a-z]+_\d+_', []);
  with TReplacement.Create do
  begin
    txt := re.ReplaceCallback(txt, Callback);
    Free;
  end;
  re.Free;

  TFile.WriteAllText('3.txt', txt);

  data.Free;
end.
