⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 up10build.pas

📁 Delphi for fun library v12, latest. This is the library for manuplating list, combination-permutati
💻 PAS
📖 第 1 页 / 共 4 页
字号:
          if Next1 = nil then
          begin
            if CheckVariable(StartString, VariableID) then
            begin
              Token := variab;

              if Position[3] = 1 then
                Matrix^[CurrentBracket, i]^.Arg1 := PParserFloat(Variables.Objects[VariableID])
              else
                Matrix^[CurrentBracket, i]^.Arg2 := PParserFloat(Variables.Objects[VariableID])
            end
            else
            begin
              if CheckNumber(StartString, FloatNumber) then
              begin
                Token := constant;
                if Position[3] = 1 then
                begin
                  new(Matrix^[CurrentBracket, i]^.Arg1);
                  Matrix^[CurrentBracket, i]^.Arg1^ := FloatNumber;
                end
                else
                begin
                  new(Matrix^[CurrentBracket, i]^.Arg2);
                  Matrix^[CurrentBracket, i]^.Arg2^ := FloatNumber;
                end;
              end
              else
              begin
                if CheckNegate(StartString, LeftString) then
                  Token := minus
                else
                begin
                  if CheckAdd(StartString, LeftString, RightString) then
                    Token := sum
                  else
                  begin
                    if CheckSubtract(StartString, LeftString, RightString) then
                      Token := diff
                    else
                    begin
                      if CheckMultiply(StartString, LeftString, RightString) then
                        Token := prod
                      else
                      begin
                        if CheckIntegerDiv(StartString, LeftString, RightString) then
                          Token := IntDiv
                        else
                        begin
                          if CheckModulo(StartString, LeftString, RightString) then
                            Token := modulo
                          else
                          begin
                            if CheckRealDivision(StartString, LeftString, RightString) then
                              Token := divis
                            else
                            begin
                              if not CheckPower(StartString, LeftString, RightString, Token) then
                              begin
                                if CheckFuncOneVar(StartString, LeftString) then
                                  Token := FuncOneVar
                                else
                                begin
                                  if CheckFuncTwoVar(StartString, LeftString, RightString) then
                                    Token := FuncTwoVar
                                  else
                                  begin
                                    Error := true; {with an exception raised this is meaningless...}
                                    if (LeftString = BlankString) and (RightString = BlankString) then
                                      raise ESyntaxError.CreateFmt(
                                         msgParseError+#13'%s', [StartString]
                                                                   )
                                    else
                                      raise ESyntaxError.CreateFmt(
                                         msgParseError+#13'%s'#13'%s', [Leftstring, RightString]
                                                                   )
                                  end;
                                end;
                              end;
                            end;
                          end;
                        end;
                      end;
                    end;
                  end;
                end;
              end;
            end;
          end;
        end; { with LastTerm^ }


        if LastTerm^.Token in ( [minus, square, third, fourth, FuncOneVar, FuncTwoVar] + TokenOperators) then
        begin
          if LastTerm^.Next1 = nil then
          begin
            try
              Next1Term := nil;
              new(Next1Term);

              inc(CurrentBracket);
              if CurrentBracket > maxBracketLevels then
              begin
                Error := true;
                raise ETooManyNestings.Create(msgNestings);
              end;

              if CurBracketLevels < CurrentBracket then
                CurBracketLevels := CurrentBracket;

              i := BracketLevel[CurrentBracket] + 1;
              if i > maxLevelWidth then
              begin
                Error := true;
                raise EExpressionTooComplex.Create(msgTooComplex);
              end;

              with Next1Term^ do
              begin
                StartString := LastTerm^.LeftString;
                LeftString := BlankString;
                RightString := BlankString;

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

                Token := variab;

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

              with LastTerm^ do
              begin
                case Token of
                  FuncOneVar:
                    with FunctionOne do
                      Matrix^[CurrentBracket, i] := CreateOperation(
                                       Token,
                                       Objects[IndexOf(copy(StartString, 1, pos('(', StartString)-1))]
                                                                   );

                  FuncTwoVar:
                    with FunctionTwo do
                      Matrix^[CurrentBracket, i] := CreateOperation(
                                       Token,
                                       Objects[IndexOf(copy(StartString, 1, pos('(', StartString)-1))]
                                                                  );
                else
                  Matrix^[CurrentBracket, i] := CreateOperation(Token, nil);
                end;

                new(Matrix^[CurrentBracket, i]^.Dest);
                Matrix^[CurrentBracket, i]^.Dest^ := 0;

                if Position[3] = 1 then
                  Matrix^[Position[1], Position[2]]^.Arg1 := Matrix^[CurrentBracket, i]^.Dest
                else
                  Matrix^[Position[1], Position[2]]^.Arg2 := Matrix^[CurrentBracket, i]^.Dest;

                Next1 := Next1Term;
                Next1Term := nil;
              end;

              if LastTerm^.Token in [minus, square, third, fourth, FuncOneVar] then
                inc(BracketLevel[CurrentBracket]);

            except
              on E: Exception do
              begin
                if assigned(Next1Term) then
                begin
                  dispose(Next1Term);
                  Next1Term := nil;
                end;

                raise;
              end;
            end;

          end

          else
          begin
            if LastTerm^.Token in (TokenOperators + [FuncTwoVar]) then
            begin
              try
                Next2Term := nil;
                new(Next2Term);

                inc(CurrentBracket);
                if CurrentBracket > maxBracketLevels then
                begin
                  Error := true;
                  raise ETooManyNestings.Create(msgNestings);
                end;

                if CurBracketLevels < CurrentBracket then
                  CurBracketLevels := CurrentBracket;

                i := BracketLevel[CurrentBracket] + 1;
                if i > maxLevelWidth then
                begin
                  Error := true;
                  raise EExpressionTooComplex.Create(msgTooComplex);
                end;

                with Next2Term^ do
                begin
                  StartString := LastTerm^.RightString;

                  LeftString := BlankString;
                  RightString := BlankString;

                  Token := variab;

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

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

                LastTerm^.Next2 := Next2Term;
                Next2Term := nil;
                inc(BracketLevel[CurrentBracket]);

              except
                on E: Exception do
                begin
                  if assigned(Next2Term) then
                  begin
                    dispose(Next2Term);
                    Next2Term := nil;
                  end;
                end;
              end;
            end
            else
              raise EParserInternalError.Create(msgInternalError);
          end;
        end;


        with LastTerm^ do
          if Next1 = nil then
          begin
          { we are done with THIS loop }
            break;
          end
          else
            if Next2 = nil then
              LastTerm := Next1
            else
              LastTerm := Next2;

      until false; { endless loop, break'ed 7 lines above }

      if LastTerm = FirstTerm then
      begin
        dispose(LastTerm);
        FirstTerm := nil;
        break; { OK - that is it, we did not find any more terms}
      end;

      repeat
        with LastTerm^ do { cannot use "with LastTerm^" OUTSIDE loop }
        begin
          if Next1 <> nil then
          begin
            dispose(Next1);
            Next1 := nil;
          end;

          if Next2 <> nil then
          begin
            dispose(Next2);
            Next2 := nil;
          end;

          LastTerm := Previous;
        end;
      until ((LastTerm^.Token in (TokenOperators + [FuncTwoVar])) and (LastTerm^.Next2 = nil)) or
            (LastTerm = FirstTerm);

      with FirstTerm^ do
      if (LastTerm = FirstTerm) and
            (  (Token in [minus, square, third, fourth, FuncOneVar]) or
               ((Token in (TokenOperators + [FuncTwoVar])) and Assigned(Next2))
            ) then
      begin
        break;
      end;


    until false;


    { after having built the expression matrix, translate it into a tree/list }

    with FirstTerm^ do
      if FirstTerm <> nil then
      begin
        if Next1 <> nil then
        begin
          dispose(Next1);
          Next1 := nil;
        end;

        if Next2 <> nil then
        begin
          dispose(Next2);
          Next2 := nil;
        end;

        dispose(FirstTerm);
      end;

    BracketLevel[0] := 1;

    if CurBracketLevels = 0 then
    begin
      FirstOP := Matrix^[0,1];
      Matrix^[0,1] := nil;
      FirstOP^.Dest := FirstOP^.Arg1;
    end
    else
    begin

      FirstOP := Matrix^[CurBracketLevels, 1];
      LastOP := FirstOP;

      for counter2 := 2 to BracketLevel[CurBracketLevels] do
      begin
        LastOP^.NextOperation := Matrix^[CurBracketLevels, counter2];
        LastOP := LastOP^.NextOperation;
      end;


      for counter1 := CurBracketLevels-1 downto 1 do
        for counter2 := 1 to BracketLevel[counter1] do
        begin
          LastOP^.NextOperation := Matrix^[counter1, counter2];
          LastOP := LastOP^.NextOperation;
        end;


      with Matrix^[0,1]^ do
      begin
        Arg1 := nil;
        Arg2 := nil;
        Dest := nil;
      end;

      dispose(Matrix^[0,1]);
    end;

    dispose(Matrix);

  except

    on E: Exception do
    begin
      if Assigned(Matrix) then
      begin
        if assigned(Matrix^[0,1]) then
          dispose(Matrix^[0,1]);

        for counter1 := CurBracketLevels downto 1 do
          for counter2 := 1 to BracketLevel[counter1] do
            if Assigned(Matrix^[counter1, counter2]) then

              dispose(Matrix^[counter1, counter2]);

        dispose(Matrix);
      end;

      if Assigned(Next1Term) then
        dispose(Next1Term);

      if Assigned(Next2Term) then
        dispose(Next2Term);

  {   do NOT kill this one at it is possibly the same as LastTerm (see below)!
      if Assigned(FirstTerm) then
        dispose(FirstTerm);

      instead, DO kill ANewTerm, which will only be <> nil if it has NOT passed
      its value to some other pointer already so it can safely be freed
  }
      if Assigned(ANewTerm) then
        dispose(ANewTerm);

      if Assigned(LastTerm) and (LastTerm <> Next2Term) and (LastTerm <> Next1Term) then
        dispose(LastTerm);

      FirstOP := nil;

      raise; { re-raise exception }

    end; { on E:Exception do }
  end;
end;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -