home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / math.swg / 0003_EQUATE.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  3.6 KB  |  156 lines
  1. { Author: Gavin Peters. }
  2.  
  3. Program PostFixConvert;
  4. (*
  5.  * This Program will convert a user entered expression to postfix, and
  6.  * evaluate it simultaniously.  Written by Gavin Peters, based slightly
  7.  * on a stack example given in Algorithms (Pascal edition), pg
  8.  *
  9.  *)
  10. Var
  11.   Stack : Array[1 .. 3] of Array[0 .. 500] of LongInt;
  12.  
  13. Procedure Push(which : Integer; p : LongInt);
  14. begin
  15.   Stack[which,0] := Stack[which,0]+1;
  16.   Stack[which,Stack[which,0]] := p
  17. end;
  18.  
  19. Function Pop(which : Integer) : LongInt;
  20. begin
  21.   Pop := Stack[which,Stack[which,0]];
  22.   Stack[which,0] := Stack[which,0]-1
  23. end;
  24.  
  25. Var
  26.   c       : Char;
  27.   x,t,
  28.   bedmas  : LongInt;
  29.   numbers : Boolean;
  30.  
  31. Procedure Evaluate( ch : Char );
  32.  
  33.   Function Power( exponent, base : LongInt ) : LongInt;
  34.   begin
  35.     if Exponent > 0 then
  36.       Power := Base*Power(exponent-1, base)
  37.     ELSE
  38.       Power := 1
  39.   end;
  40.  
  41. begin
  42.   Write(ch);
  43.   if Numbers and not (ch = ' ') then
  44.     x := x * 10 + (Ord(c) - Ord('0'))
  45.   ELSE
  46.   begin
  47.     Case ch OF
  48.       '*' : x := pop(2)*pop(2);
  49.       '+' : x := pop(2)+pop(2);
  50.       '-' : x := pop(2)-pop(2);
  51.       '/' : x := pop(2) div pop(2);
  52.       '%' : x := pop(2) MOD pop(2);
  53.       '^' : x := Power(pop(2),pop(2));
  54.       'L' : x := pop(2) SHL pop(2);
  55.       'R' : x := pop(2) SHR pop(2);
  56.       '|' : x := pop(2) or pop(2);
  57.       '&' : x := pop(2) and pop(2);
  58.       '$' : x := pop(2) xor pop(2);
  59.       '=' : if pop(2) = pop(2) then
  60.               x := 1
  61.             else
  62.               x := 0;
  63.       '>' : if pop(2) > pop(2) then
  64.               x := 1
  65.             else
  66.               x := 0;
  67.       '<' : if pop(2) < pop(2) then
  68.               x := 1
  69.             else
  70.               x := 0;
  71.       '0','1'..'9' :
  72.             begin
  73.               Numbers := True;
  74.               x := Ord(c) - Ord('0');
  75.               Exit
  76.             end;
  77.       ' ' : if not Numbers then
  78.               Exit;
  79.     end;
  80.  
  81.     Numbers := False;
  82.     Push(2,x);
  83.   end;
  84. end;
  85.  
  86. begin
  87.   Writeln('Gavin''s calculator, version 1.00');
  88.   Writeln;
  89.   For x := 1 to 3 DO
  90.     Stack[x, 0] := 0;
  91.   x := 0;
  92.   numbers := False;
  93.   Bedmas := 50;
  94.   Writeln('Enter an expression in infix:');
  95.   Repeat
  96.     Read(c);
  97.     Case c OF
  98.       ')' :
  99.         begin
  100.           Bedmas := Pop(3);
  101.           Evaluate(' ');
  102.           Evaluate(Chr(pop(1)));
  103.         end;
  104.  
  105.       '^','%','+','-','*','/','L','R','|','&','$','=','<','>' :
  106.         begin
  107.           t := bedmas;
  108.           Case c Of
  109.  
  110.             '>','<' : bedmas := 3;
  111.             '|','$',
  112.             '+','-' : bedmas := 2;
  113.             '%','L','R','&',
  114.             '*','/' : bedmas := 1;
  115.             '^'     : bedmas := 0;
  116.           end;
  117.           if t <= bedmas then
  118.           begin
  119.             Evaluate(' ');
  120.             Evaluate(Chr(pop(1)));
  121.           end;
  122.           Push(1,ord(c));
  123.           Evaluate(' ');
  124.         end;
  125.       '(' :
  126.         begin
  127.           Push(3,bedmas);
  128.           bedmas := 50;
  129.         end;
  130.       '0','1'..'9' : Evaluate(c);
  131.     end;
  132.  
  133.   Until Eoln;
  134.  
  135.   While Stack[1,0] <> 0 DO
  136.   begin
  137.     Evaluate(' ');
  138.     Evaluate(Chr(pop(1)));
  139.   end;
  140.   Evaluate(' ');
  141.   Writeln;
  142.   Writeln;
  143.   Writeln('The result is ',Pop(2));
  144. end.
  145.  
  146. {
  147. That's it, all.  This is an evaluator, like Reuben's, With a few
  148. more features, and it's shorter.
  149.  
  150. Okay, there it is (the above comment was in the original post). I've
  151. never tried it, but it looks good. :-) BTW, if it does work you might
  152. want to thank Gavin Peters... after all, he wrote it. I was just
  153. interested when I saw it, and stored it along With a bunch of other
  154. source-code tidbits I've git here...
  155. }
  156.