up10build.pas

Delphi for fun library v12, latest. This is the library for manuplating list, combination-permutati

unit UP10Build;

{.$DEFINE DEBUG}
{$IFNDEF DEBUG}
  {$D-} {$L-} {$Q-} {$R-} {$S-}
{$ENDIF}

{$IFDEF Win32}
  {$LONGSTRINGS ON}
  {$S-}
{$ENDIF}

{$I+} { I/O checking is always on }

interface

uses
  UParser10,
  SysUtils, Classes;


procedure ParseFunction( FunctionString: string; { the unparsed string }
                         Variables: TStringlist; { list of variables }

                         { lists of available functions }
                         FunctionOne,               { functions with ONE argument, e.g. exp() }
                         FunctionTwo: TStringList;  { functions with TWO arguments, e.g. max(,) }

                         UsePascalNumbers: boolean; { true: -> Val; false: StrToFloat }

                         { return pointer to tree, number of performed operations and error state }
                         var FirstOP : POperation;

                         var Error : boolean);
                         { error actually is superfluous as we are now using exceptions }



implementation


{$IFDEF VER100}
resourcestring
{$ELSE}
const
{$ENDIF}
  msgErrBlanks = 'Expression has blanks';
  msgMissingBrackets = 'Missing brackets in expression';
  msgParseError = 'Error parsing expression:';
  msgNestings = 'Expression contains too many nestings';
  msgTooComplex = 'Expression is too complex';
  msgInternalError = 'TExParser internal error';

const
  TokenOperators = [ sum, diff, prod, divis, modulo, IntDiv, 
                     integerpower, realpower];

type
  TermString = {$IFDEF Win32} string {$ELSE} PString {$ENDIF};


procedure ParseFunction( FunctionString: string;
                         Variables: TStringList;

                         FunctionOne,
                         FunctionTwo: TStringList;

                         UsePascalNumbers: boolean;

                         var FirstOP: POperation;

                         var Error: boolean);


          function CheckNumberBrackets(const s: string): boolean; forward;
          { checks whether number of ( = number of ) }

          function CheckNumber(const s: string; var FloatNumber: ParserFloat): boolean; forward;
          { checks whether s is a number }

          function CheckVariable(const s: string; var VariableID: integer): boolean; forward;
          { checks whether s is a variable string }

          function CheckTerm(var s1: string): boolean; forward;
          { checks whether s is a valid term }

          function CheckBracket(const s: string; var s1: string): boolean; forward;
          { checks whether s =(...(s1)...) and s1 is a valid term }



          function CheckNegate(const s: string; var s1: string): boolean; forward;
          {checks whether s denotes the negative value of a valid operation}



          function CheckAdd(const s: string; var s1, s2: string): boolean; forward;
          {checks whether + is the primary operation in s}

          function CheckSubtract(const s: string; var s1, s2: string): boolean; forward;
          {checks whether - is the primary operation in s}

          function CheckMultiply(const s: string; var s1, s2: string): boolean; forward;
          {checks whether * is the primary operation in s}

          function CheckIntegerDiv(const s: string; var s1, s2: string): boolean; forward;
          {checks whether DIV is the primary TOperation in s}

          function CheckModulo(const s: string; var s1, s2: string): boolean; forward;
          {checks whether MOD is the primary TOperation in s}

          function CheckRealDivision(const s: string; var s1, s2: string): boolean;  forward;
          {checks whether / is the primary operation in s}



          function CheckFuncTwoVar(const s: string; var s1, s2: string): boolean; forward;
          {checks whether s=f(s1,s2); s1,s2 being valid terms}

          function CheckFuncOneVar(const s: string; var s1: string): boolean; forward;
          {checks whether s denotes the evaluation of a function fsort(s1)}


          function CheckPower(const s: string; var s1, s2: string; var AToken: TToken): boolean; forward;


          function CheckNumberBrackets(const s: string):boolean;
          {checks whether # of '(' equ. # of ')'}
          var
            counter,
            bracket : integer;
          begin
            bracket := 0;

            counter := length(s);
            while counter <> 0 do
            begin
              case s[counter] of
                '(': inc(bracket);
                ')': dec(bracket);
              end;
              dec(counter);
            end;

            Result := bracket = 0;
          end;


          function CheckNumber(const s: string; var FloatNumber: ParserFloat):boolean;
          {checks whether s is a number}
          var
            code: integer;
          {$IFDEF Debug} { prevent debugger from showing conversion errors }
            SaveClass : TClass;
          {$ENDIF}
          begin
            if s = 'PI' then
            begin
              FloatNumber := Pi;
              Result := true;
            end
            else
            if s = '-PI' then
            begin
              FloatNumber := -Pi;
              Result := true;
            end
            else
            begin
              if UsePascalNumbers then 
              begin
                val(s, FloatNumber, code);
                Result := code = 0;
              end
              else
              begin
                {$IFDEF Debug}
                  SaveClass := ExceptionClass;
                  ExceptionClass := nil;
                  try
                {$ENDIF}
                  try
                    FloatNumber := StrToFloat(s);
                    Result := true
                  except
                    on E: Exception do
                    begin
                      Result := false;
                    end;
                  end;
                {$IFDEF Debug}
                  finally
                    ExceptionClass := SaveClass;
                  end;
                {$ENDIF}
              end;
            end; 
          end;


          function CheckVariable(const s: string; var VariableID: integer): boolean;
          {checks whether s is a variable string}
          begin
            Result := Variables.Find(s, VariableID);
          end;


          function CheckTerm(var s1: string) :boolean;
          { checks whether s is a valid term }
          var
            s2, s3: TermString;
            FloatNumber: ParserFloat;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            if length(s1) = 0 then
              exit;

            {$IFNDEF Win32}
              new(s2);
              new(s3);
              try
            {$ENDIF}

            if CheckNumber(s1, FloatNumber) or
               CheckVariable(s1, VariableID) or
               CheckNegate(s1, s2{$IFNDEF Win32}^{$ENDIF}) or
               CheckAdd(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckSubtract(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckMultiply(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckIntegerDiv(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckModulo(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckRealDivision(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckPower(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}, fsort) or
               CheckFuncTwoVar(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}) or
               CheckFuncOneVar(s1, s2{$IFNDEF Win32}^{$ENDIF})
            then
              Result := true
            else
              if CheckBracket(s1, s2{$IFNDEF Win32}^{$ENDIF}) then
              begin
                s1 := s2{$IFNDEF Win32}^{$ENDIF};
                Result := true
              end;

            {$IFNDEF Win32}
              finally
                dispose(s2);
                dispose(s3);
              end;
            {$ENDIF}
          end;

          function CheckBracket(const s: string; var s1: string): boolean;
          {checks whether s =(...(s1)...) and s1 is a valid term}
          var
            SLen : integer;
          begin
            Result := false;

            SLen := Length(s);
            if (SLen > 0) and (s[SLen] = ')') and (s[1] = '(') then
            begin
              s1 := copy(s, 2, SLen-2);
              Result := CheckTerm(s1);
            end;
          end;


          function CheckNegate(const s: string; var s1: string) :boolean;
          {checks whether s denotes the negative value of a valid TOperation}
          var
            s2, s3: TermString;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            if (length(s) <> 0) and (s[1] = '-') then
            begin
              {$IFNDEF Win32}
                new(s2);
                new(s3);
                try
              {$ENDIF}

              s1 := copy(s, 2, length(s)-1);
              if CheckBracket(s1, s2{$IFNDEF Win32}^{$ENDIF}) then
              begin
                s1 := s2{$IFNDEF Win32}^{$ENDIF};
                Result := true;
              end
              else
                Result :=
                  CheckVariable(s1, VariableID) or
                  CheckPower(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF}, fsort) or
                  CheckFuncOneVar(s1, s2{$IFNDEF Win32}^{$ENDIF}) or
                  CheckFuncTwoVar(s1, s2{$IFNDEF Win32}^{$ENDIF}, s3{$IFNDEF Win32}^{$ENDIF});

              {$IFNDEF Win32}
                finally
                  dispose(s2);
                  dispose(s3);
                end;
              {$ENDIF}
            end;
          end;


          function CheckAdd(const s: string; var s1, s2: string): boolean;
          {checks whether '+' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;
            FloatNumber: ParserFloat;
            fsort: TToken;
            VariableID: integer;
          begin
            Result := false;

            i := 0;
            j := length(s);
            repeat

              while i <> j do
              begin
                inc(i);
                if s[i] = '+' then
                  break;
              end;

              if (i > 1) and (i < j) then
              begin
                s1 := copy(s, 1, i-1);
                s2 := copy(s, i+1, j-i);

                Result := CheckNumberBrackets(s1) and CheckNumberBrackets(s2);

                if Result then
                begin
                  Result := CheckVariable(s1, VariableID) or CheckNumber(s1, FloatNumber);

                  {$IFNDEF Win32}
                    new(s3);
                    new(s4);
                    try
                  {$ENDIF}

                  if not Result then
                  begin
                    Result := CheckBracket(s1, s3{$IFNDEF Win32}^{$ENDIF});
                    if Result then
                      s1 := s3{$IFNDEF Win32}^{$ENDIF};
                  end;

                  if not Result then
                    Result := CheckNegate(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckSubtract(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckMultiply(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckIntegerDiv(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckModulo(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckRealDivision(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                              CheckPower(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                              CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                  if Result then
                  begin
                    Result := CheckVariable(s2, VariableID) or CheckNumber(s2, FloatNumber);

                    if not Result then
                    begin
                      Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                      if Result then
                        s2 := s3{$IFNDEF Win32}^{$ENDIF}
                      else
                        Result := CheckAdd(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckSubtract(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckMultiply(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckIntegerDiv(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckModulo(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckRealDivision(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckPower(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF}, fsort) or
                                  CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                    end;
                  end;

                  {$IFNDEF Win32}
                    finally
                      dispose(s3);
                      dispose(s4);
                    end;
                  {$ENDIF}

                end;
              end
              else
                break;

            until Result;
          end;



          function CheckSubtract(const s: string; var s1, s2: string): boolean;
          {checks whether '-' is the primary TOperation in s}
          var
            s3, s4: TermString;
            i, j: integer;