Einheiten parsen

[Bjoerk]

Zitat von Dejan Vu:

Irgendwo hier ist auch Code für einen Parser der mit 50 Zeilen Code auskommt.

50 Zeilen ist heftig. Bin bei 120 Zeilen (inkl. unärem Minus). Schönes WE.

Delphi-Quellcode:

unit uSimpleParser; // (C) 2011, Dr. Joachim Mohr, Dipl.-Ing. Thomas Abel;

interface

uses
  SysUtils, StrUtils, Math;

function TermToFloat(S: string): double;

implementation

function OperatorPos(const Substr, S: string): integer;
var
  I, N: integer;
begin
  Result := 0;
  N := 0;
  for I := Length(S) downto 1 do
  begin
    if S[I] = '(' then Inc(N);
    if S[I] = ')' then Dec(N);
    if N = 0 then
      if PosEx(Substr, S, I) = I then
      begin
        Result := I;
        Break;
      end;
  end;
end;

function StrMid(const S: string; const A, B: integer): string;
begin
  Result := Copy(S, A, B - A + 1)
end;

function StrLeft(const S: string; const B: integer): string;
begin
  Result := StrMid(S, 1, B);
end;

function StrRight(const S: string; const A: integer): string;
begin
  Result := StrMid(S, A, Length(S));
end;

function Left(const S, Substr: string): string;
begin
  Result := StrLeft(S, OperatorPos(Substr, S) - 1);
end;

function Right(const S, Substr: string): string;
begin
  Result := StrRight(S, OperatorPos(Substr, S) + Length(Substr));
end;

function Parenthesis(var S: string; const Minus: boolean): boolean;
begin
  Result := false;
  if Minus then
  begin
    if Length(S) > 3 then
      if Copy(S, 1, 2) = '~(' then
      begin
        S := StrMid(S, 3, Length(S) - 1);
        Result := true;
      end;
  end
  else
  begin
    if Length(S) > 2 then
      if S[1] = '(' then
      begin
        S := StrMid(S, 2, Length(S) - 1);
        Result := true;
      end;
  end;
end;

function Solve(S: string): double;
begin
  try
    if OperatorPos('+', S) > 0 then
      Result := Solve(Left(S, '+')) + Solve(Right(S, '+'))
    else
      if OperatorPos('-', S) > 0 then
        Result := Solve(Left(S, '-')) - Solve(Right(S, '-'))
      else
        if OperatorPos('*', S) > 0 then
          Result := Solve(Left(S, '*')) * Solve(Right(S, '*'))
        else
          if OperatorPos('/', S) > 0 then
            Result := Solve(Left(S, '/')) / Solve(Right(S, '/'))
          else
            if Parenthesis(S, true) then
              Result := -Solve(S)
            else
              if Parenthesis(S, false) then
                Result := Solve(S)
              else
                Result := StrToFloat(StringReplace(S, '~', '-', []));
  except
    Result := 0;
  end;
end;

function TermToFloat(S: string): double; // ~ für unäres Minus;
begin
  Result := 0;
  S := StringReplace(S, #32, '', [rfReplaceAll]);
  if Length(S) > 0 then
  begin
    if S[1] = '-' then S[1] := '~';
    if S[1] = '+' then Delete(S, 1, 1);
    S := StringReplace(S, '*+', '*', [rfReplaceAll]);
    S := StringReplace(S, '/+', '/', [rfReplaceAll]);
    S := StringReplace(S, '(+', '(', [rfReplaceAll]);
    S := StringReplace(S, '*-', '*~', [rfReplaceAll]);
    S := StringReplace(S, '/-', '/~', [rfReplaceAll]);
    S := StringReplace(S, '(-', '(~', [rfReplaceAll]);
    Result := Solve(S);
  end;
end;

end.