up10build.pas

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

                      Result := CheckBracket(s2, s3{$IFNDEF Win32}^{$ENDIF});
                      if Result then
                        s2 := s3{$IFNDEF Win32}^{$ENDIF}
                      else
                        Result := 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 CheckFuncTwoVar(const s: string; var s1, s2: string): boolean;
          {checks whether s=f(s1,s2); s1,s2 being valid terms}

            function CheckComma(const s: string; var s1, s2: string): boolean;
            var
              i, j: 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);
                  if CheckTerm(s1) then
                  begin
                    s2 := copy(s, i+1, j-i);
                    Result := CheckTerm(s2);
                  end;

                end
                else
                  break;

              until Result;
            end;

          var
            SLen,
            counter : integer;
          begin

            Result := false;

            SLen := Pos('(', s);
            dec(SLen);

            if (SLen > 0) and (s[length(s)] = ')') then
            begin
              if FunctionTwo.Find(copy(s, 1, SLen), counter) then
              begin
                inc(SLen, 2);
                Result := CheckComma( copy(s, SLen, length(s)-SLen), s1, s2);
              end;
            end;
          end;


          function CheckFuncOneVar(const s: string; var s1: string): boolean;
          {checks whether s denotes the evaluation of a function fsort(s1)}
          var
          {$IFNDEF Win32}
            s2: TermString;
          {$ENDIF}
            counter: integer;
            SLen: integer;
          begin
            Result := false;

            SLen := Pos('(', s);
            dec(SLen);

            if (SLen > 0) then
            begin
              if FunctionOne.Find(copy(s, 1, SLen), counter) then
              begin
              {$IFNDEF Win32}
                new(s2);
                try
                  s2^ := copy(s, SLen+1, length(s)-SLen);
                  Result := CheckBracket(s2^, s1);
                finally
                  dispose(s2);
                end;
              {$ELSE}
                Result := CheckBracket(copy(s, SLen+1, length(s)-SLen), s1);
              {$ENDIF}
              end;
            end;
          end;



          function CheckPower(const s: string; var s1, s2: string; var AToken: TToken): boolean;
          var
            s3, s4: TermString;
            i, j: integer;
            FloatNumber: ParserFloat;
            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 := CheckFuncOneVar(s1, s3{$IFNDEF Win32}^{$ENDIF}) or
                              CheckFuncTwoVar(s1, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});

                  if Result then
                  begin

                    if CheckNumber(s2, FloatNumber) then
                    begin
                      i := trunc(FloatNumber);

                      if (i <> FloatNumber) then
                      begin
                        { this is a real number }
                        AToken := realpower;
                      end
                      else
                      begin
                        case i of
                          2: AToken := square;
                          3: AToken := third;
                          4: AToken := fourth;
                        else
                          AToken := integerpower;
                        end;
                      end;
                    end
                    else
                    begin
                      Result := CheckVariable(s2, VariableID);

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

                      if not Result then
                      begin
                        Result := CheckFuncOneVar(s2, s3{$IFNDEF Win32}^{$ENDIF}) or
                                  CheckFuncTwoVar(s2, s3{$IFNDEF Win32}^{$ENDIF}, s4{$IFNDEF Win32}^{$ENDIF});
                      end;

                      if Result then
                        AToken := realPower;
                    end;
                  end;

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

                end;
              end
              else
                break;

            until Result;
          end;

          function CreateOperation(const Term: TToken; const Proc: Pointer): POperation;
          begin
            new(Result);
            with Result^ do
            begin
              Arg1 := nil;
              Arg2 := nil;
              Dest := nil;

              NextOperation := nil;

              Token := Term;

              Operation := TMathProcedure(Proc);
            end;
          end;

const
  BlankString = ' ';

type
  PTermRecord = ^TermRecord;
  TermRecord = record
                 { this usage of string is a bit inefficient,
                   as in 16bit always 256 bytes are consumed.
                   But since we
                   a) are allocating memory dynamically and
                   b) this will be released immediately when
                      finished with parsing
                   this seems to be OK

                   One COULD create a "TermClass" where this is handled }
                 StartString: string;
                 LeftString, RightString: string;

                 Token: TToken;

                 Position: array[1..3] of integer;

                 Next1,
                 Next2,
                 Previous: PTermRecord;
               end;

const
  { side effect: for each bracketing level added
      SizeOf(integer) bytes additional stack usage
      maxLevelWidth*SizeOf(Pointer) additional global memory used }
  maxBracketLevels = 20;

  { side effect: for each additional (complexity) level width
      maxBracketLevels*SizeOf(Pointer) additional global memory used }
  maxLevelWidth = 50;
type
  LevelArray = array[0..maxBracketLevels] of integer;

  OperationPointerArray = array[0..maxBracketLevels, 1..maxLevelWidth] of POperation;
  POperationPointerArray = ^OperationPointerArray;
var
  Matrix: POperationPointerArray;

  { bracket positions }
  CurrentBracket,
  i,
  CurBracketLevels: integer;

  BracketLevel: LevelArray;

  LastOP: POperation;
  FloatNumber: ParserFloat;
  VariableID: integer;


  ANewTerm, { need this particlar pointer to guarantee a good, flawless memory cleanup in except }

  FirstTerm,
  Next1Term,
  Next2Term,
  LastTerm: PTermRecord;

  counter1,
  counter2: integer;
begin
  { initialize local variables for safe checking in try..finally..end}

  { FirstTerm := nil; } { not necessary since not freed in finally }
  LastTerm := nil;
  ANewTerm := nil;
  Next1Term := nil;
  Next2Term := nil;

  Error := false;

  FillChar(BracketLevel, SizeOf(BracketLevel), 0); { initialize bracket array }
  BracketLevel[0] := 1;
  CurBracketLevels := 0;

  new(Matrix);

  try { this block protects the whole of ALL assignments...}
    FillChar(Matrix^, SizeOf(Matrix^), 0);

    new(ANewTerm);
    with ANewTerm^ do
    begin

      StartString := UpperCase(FunctionString);

      { remove leading and trailing spaces }
      counter1 := 1;
      counter2 := length(StartString);
      while counter1 <= counter2 do
        if StartString[counter1] <> ' ' then
          break
        else
          inc(counter1);

      counter2 := length(StartString);
      while counter2 > counter1 do
        if StartString[counter2] <> ' ' then
          break
        else
          dec(counter2);

      StartString := Copy(StartString, counter1, counter2 - counter1 + 1);

      if Pos(' ', StartString) > 0 then
        raise EExpressionHasBlanks.Create(msgErrBlanks);
      {
      Old code:

         StartString := RemoveBlanks(UpperCase(FunctionString));

      ...do not use! Using it would create the following situation:

         Passed string:   "e xp(12)"
         Modified string: "exp(12)"

      This MAY or may not be the desired meaning - there may well exist
      a variable "e" and a function "xp" and just the operator would be missing.

      Conclusion: the above line has the potential of changing the meaning
                  of an expression.
      }

      if not CheckNumberBrackets(StartString) then
        raise EMissMatchingBracket.Create(msgMissingBrackets);

      { remove enclosing brackets, e.g. ((pi)) }
      while CheckBracket(StartString, FunctionString) do
        StartString := FunctionString;

      LeftString := BlankString;
      RightString := BlankString;

      Token := variab;

      Next1 := nil;
      Next2 := nil;
      Previous := nil;
    end;

    Matrix^[0,1] := CreateOperation(variab, nil);

    LastTerm := ANewTerm;
    FirstTerm := ANewTerm;
    ANewTerm := nil;

    with LastTerm^ do
    begin
      Position[1] := 0;
      Position[2] := 1;
      Position[3] := 1;
    end;

    repeat

      repeat

        with LastTerm^ do
        begin

          CurrentBracket := Position[1];
          i := Position[2];