Показать сообщение отдельно
  #9  
Старый 09.02.2010, 12:55
= FFFFh = = FFFFh = вне форума
Прохожий
 
Регистрация: 07.02.2010
Сообщения: 9
Репутация: 10
По умолчанию

Ах да, чуть не забыл, вот писал как-то парсер мат. строки. Поддерживаются приоритеты операций и скобки.

Код:
program CalcParser; 
{$APPTYPE CONSOLE}
type
  TypeTok = (number, plus, minus, emulation, divide, leftparent, rightparent, Stop);
var
  Str: String;
  TypeToken: TypeTok;
  RealToken: real;
  StringToken: String;
  position: byte;

procedure Expression(var x: real); forward;

procedure Get;
var
  e: integer;
begin
  if position>length(Str) then begin
    TypeToken:=Stop;
    exit;
  end;

  StringToken:='';

  while Str[position] in [' ', #9] do inc(position);
  case Str[position] of
    '0'..'9': begin
                while Str[position] in ['0'..'9'] do begin
                  StringToken:=StringToken+Str[position];
                  inc(position);
                end;
                if Str[position]='.' then begin
                  StringToken:=StringToken+Str[position];
                  inc(position);
                  while Str[position] in ['0'..'9'] do begin
                    StringToken:=StringToken+Str[position];
                    inc(position);
                  end;
                end;
                TypeToken:=number;
                val(StringToken, RealToken, e);
              end;
    '+':      begin TypeToken:=plus; inc(position); end;
    '-':      begin TypeToken:=minus; inc(position); end;
    '*':      begin TypeToken:=emulation; inc(position); end;
    '/':      begin TypeToken:=divide; inc(position); end;
    '(':      begin TypeToken:=leftparent; inc(position); end;
    ')':      begin TypeToken:=rightparent; inc(position); end;
    else
      {error}
  end;
end;


procedure Factor(var x: real);
begin
  case TypeToken of
    number:     begin
                x:=RealToken;
                Get;
              end;
    leftparent: begin
                Get;
                Expression(x);
                if TypeToken=rightparent then
                  Get
                else
                  {error};
              end;
  end;
end;

procedure Term(var x: real);
var
  y: real;
  op: TypeTok;
begin
  Factor(x);
  while TypeToken in [emulation, divide] do begin
    op:=TypeToken;
    Get;
    Factor(y);
    case op of
      emulation: x:=x*y;
      divide: x:=x/y;
    end;
  end;
end;

procedure Expression(var x: real);
var
  y:  real;
  op: TypeTok;
begin
  Term(x);
  while TypeToken in [plus, minus] do begin
    op:=TypeToken;
    Get;
    Term(y);
    case op of
      plus:  x:=x+y;
      minus: x:=x-y;
    end;
  end
end;

procedure init;
begin
  StringToken:='';
  RealToken:=0.0;
  position:=1;
  Get;
end;

var
  x: real;
begin
  write('> ');
  readln(Str);
  while Str<>'' do begin
    init;
    Expression(x);
    writeln('   result = ', x:0:5);
    write('> ');
    readln(Str);
  end;
end.

компилировал на дельфах 7. Всё работало.
Ответить с цитированием