[ главная ]   [ рейтинг статей ]   [ справочник радиолюбителя ]   [ новости мира ИТ ]



Ответов: 0
25-02-12 07:01







   Web - программирование
PHP


ASP






XML



CSS

SSI





   Программирование под ОС











   Web - технологии








   Базы Данных









   Графика






Данные




Программирование под ОС / Pascal - Delphi /

Лабораторная работа СПО

Написать интерпретатор арифметических выражений с построением таблицы четверок и выполнить ее. Считать, что выражение включает только целые числа, количество вложенных скобок и операций неограниченно. {операции: +, -, *, /,(,) }.
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type
  TypeTok = (_num, _plus, _minus, _mul, _div, _lparent, _rparent, _stop);
var
  S: string;
  TTok: TypeTok;
  RTok: real;
  STok: string;
  _pos: byte;



  f:textfile;

procedure Expression(var x: real); forward;

procedure Get;
var
  e: integer;
begin
  if _pos>length(S) then begin
    TTok:=_stop;
    exit;
  end;

  STok:='';

  while S[_pos] in [' ', #9] do inc(_pos);
  case S[_pos] of
    '0'..'9': begin
                while S[_pos] in ['0'..'9'] do begin
                  STok:=STok+S[_pos];
                  inc(_pos);
                end;
                if S[_pos]='.' then begin
                  STok:=STok+S[_pos];
                  inc(_pos);
                  while S[_pos] in ['0'..'9'] do begin
                    STok:=STok+S[_pos];
                    inc(_pos);
                  end;
                end;
                TTok:=_num;
                val(STok, RTok, e);
              end;
    '+':      begin TTok:=_plus; inc(_pos); end;
    '-':      begin TTok:=_minus; inc(_pos); end;
    '*':      begin TTok:=_mul; inc(_pos); end;
    '/':      begin TTok:=_div; inc(_pos); end;
    '(':      begin TTok:=_lparent; inc(_pos); end;
    ')':      begin TTok:=_rparent; inc(_pos); end;
    else
      {error}
  end;
end;


procedure Factor(var x: real);
var
 e: integer;
begin
  case TTok of
    _num:     begin
                x:=RTok;
                Get;
              end;
    _lparent: begin
                Get;
                Expression(x);
                if TTok=_rparent then
                  Get
                else
                  {error};
              end;
  end;
end;

procedure Term(var x: real);
var
  y: real;
  op: TypeTok;
begin
  Factor(x);
  while TTok in [_mul, _div] do begin
    op:=TTok;
    Get;
    Factor(y);
    case op of
      _mul: begin writeln('mul  ',x:0:5,'  ',y:0:5,'  ',(x*y):0:5);
                  writeln(f,'mul  ',x:0:5,'  ',y:0:5,'  ',(x*y):0:5);  x:=x*y;
            end;
      _div: begin writeln('div  ',x:0:5,'  ',y:0:5,'  ',(x/y):0:5);
                  writeln(f,'div  ',x:0:5,'  ',y:0:5,'  ',(x/y):0:5); x:=x/y;
            end;
    end;
  end;
end;

procedure Expression(var x: real);
var
  y:  real;
  op: TypeTok;
begin
  Term(x);
  while TTok in [_plus, _minus] do begin
    op:=TTok;
    Get;
    Term(y);
    case op of
      _plus:  begin writeln('add  ',x:0:5,'  ',y:0:5,'  ',(x+y):0:5);
                    writeln(f,'add  ',x:0:5,'  ',y:0:5,'  ',(x+y):0:5);  x:=x+y;
               end;
      _minus:  begin writeln('sub  ',x:0:5,'  ',y:0:5,'  ',(x-y):0:5);
                     writeln(f,'sub  ',x:0:5,'  ',y:0:5,'  ',(x-y):0:5);  x:=x-y;
                end;
    end;
  end
end;

procedure init;
begin
  STok:='';
  RTok:=0.0;
  _pos:=1;
  Get;
end;



 var
  x: real;


begin


  write('> ');
  readln(S);
  while S<>'' do begin
    AssignFile(f,'table.txt');
    rewrite(f);
    init;
    expression(x);
    writeln('   result = ', x:0:5);
    CloseFile(f);
    write('> ');
    readln(S);
  end;
end.




Комментарии

Евгений
11-08-2009   
Интересное решение задачи. Жаль автор не дал своего комментария к данному материалу(

 Ваш комментарий к данному материалу будет интересен нам и нашим читателям!



Последние статьи: Программирование под ОС / Pascal - Delphi /

Работа со шрифтами на Win API
06-06-2010   

Сегодня поговорим о шрифтах, и о том, каким образом работать с ними на Win API. Нам потребуется переменная типа HFONT. Изменить стиль шрифта можно у любого компонента, я покажу это на примере кнопки... подробнее

Кол. просмотров: общее - 3739 сегодня - 0

Работа с таймером на Win API
06-06-2010   

Таймер - вещь в хозяйстве очень полезная. Если некое действие нужно повторять с определенной периодичностью, то таймер, это как раз то, что нужно... подробнее

Кол. просмотров: общее - 3715 сегодня - 0

Работа с мультимедийным таймером на Win API
06-06-2010   

Мы уже знакомы с системным таймером, сегодня познакомимся с мультимедийным, основное отличие которого, более высокая скорость (точность) работы... подробнее

Кол. просмотров: общее - 3838 сегодня - 0

Создание CheckBoxов средствами Win API
06-06-2010   

Сегодня наша программа научится работать с CheckBoxами. CheckBox можно представить как флаг, который можно установить или сбросить, и в зависимости от его состояния выполнять определенные действия... подробнее

Кол. просмотров: общее - 3971 сегодня - 0

Создание группы RadioButton средствами Win API
06-06-2010   

В прошлый раз мы сделали несколько радио-кнопок, которые автоматически объединялись в одну группу. Сейчас рассмотрим, как создавать несколько независимых групп радио-кнопок... подробнее

Кол. просмотров: общее - 3774 сегодня - 0



  WWW.COMPROG.RU - 2009-2012 | Designed and Powered by Zaipov Renat | Projects