home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug120.arc / PASCAL.LBR / CALC.PQS / CALC.PAS
Pascal/Delphi Source File  |  1979-12-31  |  7KB  |  226 lines
  1. program Calc;
  2.  
  3. (* - A non-recursive parser, using the method of assigning a numerical
  4.    - value to each operator,
  5.    - based on a program by Scott Magruder, published in Computer Language,
  6.    - June 1987.
  7.    - revised by Jim Friend, Sydney Microbee Users Group  *)
  8.  
  9. const
  10.    STORESIZE = 100;
  11.    HOLDSIZE = 80;
  12.    DigitWidth: Integer = 18;
  13.    Decimals: Integer = 2;
  14.  
  15. var
  16.    Code, LoopCount: Integer;
  17.    Format: string[2];
  18.    StoredVars: Integer;
  19.    FormulaLine: string[80];
  20.    VOP: array[1..HOLDSIZE] of Integer;
  21.    TEO: array[1..HOLDSIZE] of Char;
  22.    StoreName: array[1..STORESIZE] of string[15];
  23.    StoreValue: array[1..STORESIZE] of real;
  24.    HoldName: array[1..HOLDSIZE] of string[15];
  25.    HoldValue: array[1..HOLDSIZE] of real;
  26.    Blunder: Boolean;
  27.  
  28. procedure CheckVar(K: Integer);
  29.    var
  30.       Found: Boolean;
  31.  
  32.    begin
  33.       Found := False;
  34.       for LoopCount := 1 to StoredVars do
  35.       begin
  36.          if HoldName[K] = StoreName[LoopCount] then
  37.          begin
  38.             Found := True;
  39.             if K <> 1 then HoldValue[K] := StoreValue[LoopCount];
  40.          end;
  41.       end;
  42.       if (K = 1) and (not Found) then
  43.       begin
  44.          Found := True;
  45.          StoredVars := StoredVars + 1;
  46.          StoreName[StoredVars] := HoldName[K];
  47.          StoreValue[StoredVars] := 0.0;
  48.       end;
  49.       if not Found then
  50.       begin
  51.          Writeln('Error - Variable ',HoldName[K],' not found.');
  52.          Blunder := True;
  53.       end;
  54.    end;
  55.  
  56. procedure Assignment;
  57.    begin
  58.       for LoopCount := 1 to StoredVars do
  59.       begin
  60.          if HoldName[1] = StoreName[LoopCount] then
  61.             StoreValue[LoopCount] := HoldValue[1];
  62.       end;
  63.    end;
  64.  
  65. procedure EvaluateTable(var K, L: Integer);
  66.    begin
  67.       while (TEO[1] <> '<') and (VOP[L] <= VOP[K]) do
  68.       begin
  69.          case TEO[K] of
  70.             '+': HoldValue[K - 1] := HoldValue[K - 1] + HoldValue[K];
  71.             '-': HoldValue[K - 1] := HoldValue[K - 1] - HoldValue[K];
  72.             '*': HoldValue[K - 1] := HoldValue[K - 1] * HoldValue[K];
  73.             '/': begin
  74.                     if HoldValue[K] <> 0 then
  75.                        HoldValue[K - 1] := HoldValue[K - 1] / HoldValue[K]
  76.                     else
  77.                        begin
  78.                           Writeln('Division by zero error.');
  79.                           Blunder := True;
  80.                        end;
  81.                  end;
  82.             '^': HoldValue[K - 1] := Exp(HoldValue[K] * Ln(HoldValue[K - 1]));
  83.             '=': HoldValue[K - 1] := HoldValue[K];
  84.             'E': HoldValue[K - 1] := Exp(HoldValue[K]);
  85.             '~': HoldValue[K - 1] := -1 * HoldValue[K];
  86.          end;
  87.          VOP[K] := VOP[K + 1];
  88.          TEO[K] := TEO[K + 1];
  89.          K := K - 1;
  90.          L := K + 1;
  91.          if L <> 1 then HoldName[L] := '';
  92.          if L <> 1 then HoldValue[L] := 0.0;
  93.       end;
  94.    end;
  95.  
  96. function Unary(J, K: Integer): Boolean;
  97.    begin
  98.       repeat
  99.          J := J - 1
  100.       until FormulaLine[J] in ['A'..'Z', 'a'..'z', '0'..'9', '+', '-',
  101.                                '*', '/', '^', '~', '='];
  102.       Unary := (FormulaLine[J] in ['+', '-', '*', '/', '^', '~', '=']) or
  103.                (TEO[K] = 'E');
  104.    end;
  105.  
  106. procedure ScanLine;
  107.    var
  108.       Found: Boolean;
  109.       TempName: string[15];
  110.       K, L, IncPar, I, Code: Integer;
  111.  
  112.    begin
  113.       for K := 1 to HOLDSIZE do HoldName[K] := '';
  114.       for K := 1 to HOLDSIZE do VOP[K] := 0;
  115.       K := 1;
  116.       IncPar := 0;
  117.       for I := 1 to Length(FormulaLine) do
  118.       begin
  119.          L := K + 1;
  120.          if FormulaLine[I] = '<' then
  121.             VOP[L] := IncPar;
  122.          if FormulaLine[I] = '-' then
  123.             if Unary(I, K) then
  124.                FormulaLine[I] := '~';
  125.          if (FormulaLine[I] = '+') or (FormulaLine[I] = '-') then
  126.             VOP[L] := 2 + IncPar;
  127.          if FormulaLine[I] = '=' then
  128.             VOP[L] := 1 + IncPar;
  129.          if FormulaLine[I] = '^' then
  130.             VOP[L] := 5 + IncPar;
  131.          if FormulaLine[I] = '~' then
  132.             VOP[L] := 200 + IncPar;
  133.          if (FormulaLine[I] = '*') or (FormulaLine[I] = '/') then
  134.             VOP[L] := 3 + IncPar;
  135.          if FormulaLine[I] = '(' then
  136.          begin
  137.             IncPar := IncPar + 10;
  138.             Found := False;
  139.             if HoldName[K] = 'EXP' then Found := True;
  140.             if Found then
  141.             begin
  142.                VOP[L] := 100 + IncPar;
  143.                TEO[L] := 'E';
  144.                K := K + 1;
  145.                L := K + 1;
  146.             end;
  147.          end;
  148.          if FormulaLine[I] = ')' then
  149.             IncPar := IncPar - 10;
  150.          if FormulaLine[I] in ['A'..'Z', 'a'..'z', '0'..'9', '.', '~'] then
  151.             HoldName[K] := HoldName[K] + UpCase(FormulaLine[I]);
  152.          if FormulaLine[I] in ['+', '-', '=', '*', '/', '^', '<', '~'] then
  153.          begin
  154.             TEO[L] := FormulaLine[I];
  155.             TempName := HoldName[K];
  156.             if TempName[1] in ['0'..'9'] then
  157.             begin
  158.                if HoldValue[K] = 0 then
  159.                   Val(HoldName[K], HoldValue[K], Code);
  160.                if Code <> 0 then
  161.                begin
  162.                   Writeln('Error in converting string to number.');
  163.                   Blunder := True;
  164.                end;
  165.             end;
  166.             if TempName[1] in ['A'..'Z', 'a'..'z'] then CheckVar(K);
  167.             EvaluateTable(K, L);
  168.             K := K + 1;
  169.          end;
  170.          if FormulaLine[I] = '<' then
  171.          begin
  172.             VOP[L] := IncPar;
  173.             if VOP[L] > 0 then Writeln('Error - expected ) not found.');
  174.             if VOP[L] < 0 then Writeln('Error - too many )s.');
  175.             if VOP[L] <> 0 then Blunder := True;
  176.          end;
  177.       end;
  178.    end;
  179.  
  180. begin
  181.    ClrScr;
  182.    Writeln('CALCULATOR': 45);
  183.    Writeln;
  184.    Writeln('Usage: enter name of formula result, then =, then formula.');
  185.    Writeln('Terminate program by entering "\".');
  186.    Writeln;
  187.    Writeln('Default output is fixed point with 2 digits after decimal point.');
  188.    Writeln('Enter RETURN for default, S for scientific format, number of');
  189.    Write('digits for fixed point:  ');
  190.    Readln(Format);
  191.    if Format = '' then
  192.       Decimals := 2
  193.    else
  194.       if UpCase(Format[1]) = 'S' then
  195.          Decimals := -1
  196.    else
  197.       begin
  198.          Val(Format, Decimals, Code);
  199.          if Code <> 0 then Decimals := 2;
  200.       end;
  201.    Writeln;
  202.    Writeln;
  203.    StoredVars := 0;
  204.    repeat
  205.       Blunder := False;
  206.       for LoopCount := 1 to HOLDSIZE do
  207.       begin
  208.          HoldName[LoopCount] := '';
  209.          HoldValue[LoopCount] := 0.0;
  210.       end;
  211.       TEO[1] := '>';
  212.       Write('Enter formula:   ');
  213.       FormulaLine := '';
  214.       Readln(FormulaLine);
  215.       FormulaLine := FormulaLine + '<';
  216.       ScanLine;
  217.       if not Blunder then
  218.       begin
  219.          Assignment;
  220.          for LoopCount := 1 to StoredVars do
  221.             Writeln(StoreName[LoopCount]: 15,
  222.                     ': Value ', StoreValue[LoopCount]: DigitWidth: Decimals);
  223.       end;
  224.    until FormulaLine[1] = '\';
  225. end.
  226.