home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / turbo5 / mcparser.pas < prev    next >
Pascal/Delphi Source File  |  1988-10-09  |  14KB  |  579 lines

  1.  
  2. { Copyright (c) 1985, 88 by Borland International, Inc. }
  3.  
  4. unit MCPARSER;
  5.  
  6. interface
  7.  
  8. uses Crt, Dos, MCVars, MCUtil, MCDisply;
  9.  
  10. function CellValue(Col, Row : Word) : Real;
  11. { Finds the Value of a particular cell }
  12.  
  13. function Parse(S : String; var Att : Word) : Real;
  14. { Parses the string s - returns the Value of the evaluated string, and puts
  15.    the attribute in Att: TXT = 0, CONSTANT = 1, FORMULA = 2, +4 = ERROR.
  16. }
  17.  
  18. implementation
  19.  
  20. const
  21.   PLUS = 0;
  22.   MINUS = 1;
  23.   TIMES = 2;
  24.   DIVIDE = 3;
  25.   EXPO = 4;
  26.   COLON = 5;
  27.   OPAREN = 6;
  28.   CPAREN = 7;
  29.   NUM = 8;
  30.   CELLT = 9;
  31.   FUNC = 10;
  32.   EOL = 11;
  33.   BAD = 12;
  34.   MAXFUNCNAMELEN = 5;
  35.  
  36. type
  37.   TokenRec = record
  38.     State : Byte;
  39.     case Byte of
  40.       0 : (Value : Real);
  41.       1 : (Row, Col : Word);
  42.       2 : (FuncName : String[MAXFUNCNAMELEN]);
  43.   end;
  44.  
  45. var
  46.   Stack : array [1..PARSERSTACKSIZE] of TokenRec;
  47.   CurToken : TokenRec;
  48.   StackTop, TokenType : Word;
  49.   MathError, TokenError, IsFormula : Boolean;
  50.   Input : IString;
  51.  
  52. function IsFunc(S : String) : Boolean;
  53. { Checks to see if the start of the Input string is a legal function.
  54.   Returns TRUE if it is, FALSE otherwise.
  55. }
  56. var
  57.   Len : Word;
  58. begin
  59.   Len := Length(S);
  60.   if Pos(S, Input) = 1 then
  61.   begin
  62.     CurToken.FuncName := Copy(Input, 1, Len);
  63.     Delete(Input, 1, Len);
  64.     IsFunc := True;
  65.   end
  66.   else
  67.     IsFunc := False;
  68. end; { IsFunc }
  69.  
  70. function NextToken : Word;
  71. { Gets the next Token from the Input stream }
  72. var
  73.   NumString : String[80];
  74.   FormLen, Place, Len, NumLen, Check : Word;
  75.   FirstChar : Char;
  76.   Decimal : Boolean;
  77. begin
  78.   if Input = '' then
  79.   begin
  80.     NextToken := EOL;
  81.     Exit;
  82.   end;
  83.   while (Input <> '') and (Input[1] = ' ') do
  84.     Delete(Input, 1, 1);
  85.   if Input[1] in ['0'..'9', '.'] then
  86.   begin
  87.     NumString := '';
  88.     Len := 1;
  89.     Decimal := False;
  90.     while (Len <= Length(Input)) and
  91.           ((Input[Len] in ['0'..'9']) or
  92.            ((Input[Len] = '.') and (not Decimal))) do
  93.     begin
  94.       NumString := NumString + Input[Len];
  95.       if Input[1] = '.' then
  96.         Decimal := True;
  97.       Inc(Len);
  98.     end;
  99.     if (Len = 2) and (Input[1] = '.') then
  100.     begin
  101.       NextToken := BAD;
  102.       Exit;
  103.     end;
  104.     if (Len <= Length(Input)) and (Input[Len] = 'E') then
  105.     begin
  106.       NumString := NumString + 'E';
  107.       Inc(Len);
  108.       if Input[Len] in ['+', '-'] then
  109.       begin
  110.         NumString := NumString + Input[Len];
  111.         Inc(Len);
  112.       end;
  113.       NumLen := 1;
  114.       while (Len <= Length(Input)) and (Input[Len] in ['0'..'9']) and
  115.             (NumLen <= MAXEXPLEN) do
  116.       begin
  117.         NumString := NumString + Input[Len];
  118.         Inc(NumLen);
  119.         Inc(Len);
  120.       end;
  121.     end;
  122.     if NumString[1] = '.' then
  123.       NumString := '0' + NumString;
  124.     Val(NumString, CurToken.Value, Check);
  125.     if Check <> 0 then
  126.       MathError := True;
  127.     NextToken := NUM;
  128.     Delete(Input, 1, Length(NumString));
  129.     Exit;
  130.   end
  131.   else if Input[1] in LETTERS then
  132.   begin
  133.     if IsFunc('ABS') or
  134.        IsFunc('ATAN') or
  135.        IsFunc('COS') or
  136.        IsFunc('EXP') or
  137.        IsFunc('LN') or
  138.        IsFunc('ROUND') or
  139.        IsFunc('SIN') or
  140.        IsFunc('SQRT') or
  141.        IsFunc('SQR') or
  142.        IsFunc('TRUNC') then
  143.     begin
  144.       NextToken := FUNC;
  145.       Exit;
  146.     end;
  147.     if FormulaStart(Input, 1, CurToken.Col, CurToken.Row, FormLen) then
  148.     begin
  149.       Delete(Input, 1, FormLen);
  150.       IsFormula := True;
  151.       NextToken := CELLT;
  152.       Exit;
  153.     end
  154.     else begin
  155.       NextToken := BAD;
  156.       Exit;
  157.     end;
  158.   end
  159.   else begin
  160.     case Input[1] of
  161.       '+' : NextToken := PLUS;
  162.       '-' : NextToken := MINUS;
  163.       '*' : NextToken := TIMES;
  164.       '/' : NextToken := DIVIDE;
  165.       '^' : NextToken := EXPO;
  166.       ':' : NextToken := COLON;
  167.       '(' : NextToken := OPAREN;
  168.       ')' : NextToken := CPAREN;
  169.       else
  170.         NextToken := BAD;
  171.     end;
  172.     Delete(Input, 1, 1);
  173.     Exit;
  174.   end; { case }
  175. end; { NextToken }
  176.  
  177. procedure Push(Token : TokenRec);
  178. { Pushes a new Token onto the stack }
  179. begin
  180.   if StackTop = PARSERSTACKSIZE then
  181.   begin
  182.     ErrorMsg(MSGSTACKERROR);
  183.     TokenError := True;
  184.   end
  185.   else begin
  186.     Inc(StackTop);
  187.     Stack[StackTop] := Token;
  188.   end;
  189. end; { Push }
  190.  
  191. procedure Pop(var Token : TokenRec);
  192. { Pops the top Token off of the stack }
  193. begin
  194.   Token := Stack[StackTop];
  195.   Dec(StackTop);
  196. end; { Pop }
  197.  
  198. function GotoState(Production : Word) : Word;
  199. { Finds the new state based on the just-completed production and the
  200.    top state.
  201. }
  202. var
  203.   State : Word;
  204. begin
  205.   State := Stack[StackTop].State;
  206.   if (Production <= 3) then
  207.   begin
  208.     case State of
  209.       0 : GotoState := 1;
  210.       9 : GotoState := 19;
  211.       20 : GotoState := 28;
  212.     end; { case }
  213.   end
  214.   else if Production <= 6 then
  215.   begin
  216.     case State of
  217.       0, 9, 20 : GotoState := 2;
  218.       12 : GotoState := 21;
  219.       13 : GotoState := 22;
  220.     end; { case }
  221.   end
  222.   else if Production <= 8 then
  223.   begin
  224.     case State of
  225.       0, 9, 12, 13, 20 : GotoState := 3;
  226.       14 : GotoState := 23;
  227.       15 : GotoState := 24;
  228.       16 : GotoState := 25;
  229.     end; { case }
  230.   end
  231.   else if Production <= 10 then
  232.   begin
  233.     case State of
  234.       0, 9, 12..16, 20 : GotoState := 4;
  235.     end; { case }
  236.   end
  237.   else if Production <= 12 then
  238.   begin
  239.     case State of
  240.       0, 9, 12..16, 20 : GotoState := 6;
  241.       5 : GotoState := 17;
  242.     end; { case }
  243.   end
  244.   else begin
  245.     case State of
  246.       0, 5, 9, 12..16, 20 : GotoState := 8;
  247.     end; { case }
  248.   end;
  249. end; { GotoState }
  250.  
  251. function CellValue;
  252. var
  253.   CPtr : CellPtr;
  254. begin
  255.   CPtr := Cell[Col, Row];
  256.   if (CPtr = nil) then
  257.     CellValue := 0
  258.   else begin
  259.     if (CPtr^.Error) or (CPtr^.Attrib = TXT) then
  260.       MathError := True;
  261.     if CPtr^.Attrib = FORMULA then
  262.       CellValue := CPtr^.FValue
  263.     else
  264.       CellValue := CPtr^.Value;
  265.   end;
  266. end; { CellValue }
  267.  
  268. procedure Shift(State : Word);
  269. { Shifts a Token onto the stack }
  270. begin
  271.   CurToken.State := State;
  272.   Push(CurToken);
  273.   TokenType := NextToken;
  274. end; { Shift }
  275.  
  276. procedure Reduce(Reduction : Word);
  277. { Completes a reduction }
  278. var
  279.   Token1, Token2 : TokenRec;
  280.   Counter : Word;
  281. begin
  282.   case Reduction of
  283.     1 : begin
  284.       Pop(Token1);
  285.       Pop(Token2);
  286.       Pop(Token2);
  287.       CurToken.Value := Token1.Value + Token2.Value;
  288.     end;
  289.     2 : begin
  290.       Pop(Token1);
  291.       Pop(Token2);
  292.       Pop(Token2);
  293.       CurToken.Value := Token2.Value - Token1.Value;
  294.     end;
  295.     4 : begin
  296.       Pop(Token1);
  297.       Pop(Token2);
  298.       Pop(Token2);
  299.       CurToken.Value := Token1.Value * Token2.Value;
  300.     end;
  301.     5 : begin
  302.       Pop(Token1);
  303.       Pop(Token2);
  304.       Pop(Token2);
  305.       if Token1.Value = 0 then
  306.         MathError := True
  307.       else
  308.         CurToken.Value := Token2.Value / Token1.Value;
  309.     end;
  310.     7 : begin
  311.       Pop(Token1);
  312.       Pop(Token2);
  313.       Pop(Token2);
  314.       if Token2.Value <= 0 then
  315.         MathError := True
  316.       else if (Token1.Value * Ln(Token2.Value) < -EXPLIMIT) or
  317.               (Token1.Value * Ln(Token2.Value) > EXPLIMIT) then
  318.         MathError := True
  319.       else
  320.         CurToken.Value := Exp(Token1.Value * Ln(Token2.Value));
  321.     end;
  322.     9 : begin
  323.       Pop(Token1);
  324.       Pop(Token2);
  325.       CurToken.Value := -Token1.Value;
  326.     end;
  327.     11 : begin
  328.       Pop(Token1);
  329.       Pop(Token2);
  330.       Pop(Token2);
  331.       CurToken.Value := 0;
  332.       if Token1.Row = Token2.Row then
  333.       begin
  334.         if Token1.Col < Token2.Col then
  335.           TokenError := True
  336.         else begin
  337.           for Counter := Token2.Col to Token1.Col do
  338.             CurToken.Value := CurToken.Value + CellValue(Counter, Token1.Row);
  339.         end;
  340.       end
  341.       else if Token1.Col = Token2.Col then
  342.       begin
  343.         if Token1.Row < Token2.Row then
  344.           TokenError := True
  345.         else begin
  346.           for Counter := Token2.Row to Token1.Row do
  347.             CurToken.Value := CurToken.Value + CellValue(Token1.Col, Counter);
  348.         end;
  349.       end
  350.       else
  351.         TokenError := True;
  352.     end;
  353.     13 : begin
  354.       Pop(CurToken);
  355.       CurToken.Value := CellValue(CurToken.Col, CurToken.Row);
  356.     end;
  357.     14 : begin
  358.       Pop(Token1);
  359.       Pop(CurToken);
  360.       Pop(Token1);
  361.     end;
  362.     16 : begin
  363.       Pop(Token1);
  364.       Pop(CurToken);
  365.       Pop(Token1);
  366.       Pop(Token1);
  367.       if Token1.FuncName = 'ABS' then
  368.         CurToken.Value := Abs(CurToken.Value)
  369.       else if Token1.FuncName = 'ATAN' then
  370.         CurToken.Value := ArcTan(CurToken.Value)
  371.       else if Token1.FuncName = 'COS' then
  372.         CurToken.Value := Cos(CurToken.Value)
  373.       else if Token1.FuncName = 'EXP' then
  374.       begin
  375.         if (CurToken.Value < -EXPLIMIT) or (CurToken.Value > EXPLIMIT) then
  376.           MathError := True
  377.         else
  378.           CurToken.Value := Exp(CurToken.Value);
  379.       end
  380.       else if Token1.FuncName = 'LN' then
  381.       begin
  382.         if CurToken.Value <= 0 then
  383.           MathError := True
  384.         else
  385.           CurToken.Value := Ln(CurToken.Value);
  386.       end
  387.       else if Token1.FuncName = 'ROUND' then
  388.       begin
  389.         if (CurToken.Value < -1E9) or (CurToken.Value > 1E9) then
  390.           MathError := True
  391.         else
  392.           CurToken.Value := Round(CurToken.Value);
  393.       end
  394.       else if Token1.FuncName = 'SIN' then
  395.         CurToken.Value := Sin(CurToken.Value)
  396.       else if Token1.FuncName = 'SQRT' then
  397.       begin
  398.         if CurToken.Value < 0 then
  399.           MathError := True
  400.         else
  401.           CurToken.Value := Sqrt(CurToken.Value);
  402.       end
  403.       else if Token1.FuncName = 'SQR' then
  404.       begin
  405.         if (CurToken.Value < -SQRLIMIT) or (CurToken.Value > SQRLIMIT) then
  406.           MathError := True
  407.         else
  408.           CurToken.Value := Sqr(CurToken.Value);
  409.       end
  410.       else if Token1.FuncName = 'TRUNC' then
  411.       begin
  412.         if (CurToken.Value < -1E9) or (CurToken.Value > 1E9) then
  413.           MathError := True
  414.         else
  415.           CurToken.Value := Trunc(CurToken.Value);
  416.       end;
  417.     end;
  418.     3, 6, 8, 10, 12, 15 : Pop(CurToken);
  419.   end; { case }
  420.   CurToken.State := GotoState(Reduction);
  421.   Push(CurToken);
  422. end; { Reduce }
  423.  
  424. function Parse;
  425. var
  426.   FirstToken : TokenRec;
  427.   Accepted : Boolean;
  428.   Counter : Word;
  429. begin
  430.   Accepted := False;
  431.   TokenError := False;
  432.   MathError := False;
  433.   IsFormula := False;
  434.   Input := UpperCase(S);
  435.   StackTop := 0;
  436.   FirstToken.State := 0;
  437.   FirstToken.Value := 0;
  438.   Push(FirstToken);
  439.   TokenType := NextToken;
  440.   repeat
  441.     case Stack[StackTop].State of
  442.       0, 9, 12..16, 20 : begin
  443.         if TokenType = NUM then
  444.           Shift(10)
  445.         else if TokenType = CELLT then
  446.           Shift(7)
  447.         else if TokenType = FUNC then
  448.           Shift(11)
  449.         else if TokenType = MINUS then
  450.           Shift(5)
  451.         else if TokenType = OPAREN then
  452.           Shift(9)
  453.         else
  454.           TokenError := True;
  455.       end;
  456.       1 : begin
  457.         if TokenType = EOL then
  458.           Accepted := True
  459.         else if TokenType = PLUS then
  460.           Shift(12)
  461.         else if TokenType = MINUS then
  462.           Shift(13)
  463.         else
  464.           TokenError := True;
  465.       end;
  466.       2 : begin
  467.         if TokenType = TIMES then
  468.           Shift(14)
  469.         else if TokenType = DIVIDE then
  470.           Shift(15)
  471.         else
  472.           Reduce(3);
  473.       end;
  474.       3 : Reduce(6);
  475.       4 : begin
  476.        if TokenType = EXPO then
  477.          Shift(16)
  478.        else
  479.          Reduce(8);
  480.       end;
  481.       5 : begin
  482.         if TokenType = NUM then
  483.           Shift(10)
  484.         else if TokenType = CELLT then
  485.           Shift(7)
  486.         else if TokenType = FUNC then
  487.           Shift(11)
  488.         else if TokenType = OPAREN then
  489.           Shift(9)
  490.         else
  491.           TokenError := True;
  492.       end;
  493.       6 : Reduce(10);
  494.       7 : begin
  495.         if TokenType = COLON then
  496.           Shift(18)
  497.         else
  498.           Reduce(13);
  499.       end;
  500.       8 : Reduce(12);
  501.       10 : Reduce(15);
  502.       11 : begin
  503.         if TokenType = OPAREN then
  504.           Shift(20)
  505.         else
  506.           TokenError := True;
  507.       end;
  508.       17 : Reduce(9);
  509.       18 : begin
  510.         if TokenType = CELLT then
  511.           Shift(26)
  512.         else
  513.           TokenError := True;
  514.       end;
  515.       19 : begin
  516.         if TokenType = PLUS then
  517.           Shift(12)
  518.         else if TokenType = MINUS then
  519.           Shift(13)
  520.         else if TokenType = CPAREN then
  521.           Shift(27)
  522.         else
  523.           TokenError := True;
  524.       end;
  525.       21 : begin
  526.         if TokenType = TIMES then
  527.           Shift(14)
  528.         else if TokenType = DIVIDE then
  529.           Shift(15)
  530.         else
  531.           Reduce(1);
  532.       end;
  533.       22 : begin
  534.         if TokenType = TIMES then
  535.           Shift(14)
  536.         else if TokenType = DIVIDE then
  537.           Shift(15)
  538.         else
  539.           Reduce(2);
  540.       end;
  541.       23 : Reduce(4);
  542.       24 : Reduce(5);
  543.       25 : Reduce(7);
  544.       26 : Reduce(11);
  545.       27 : Reduce(14);
  546.       28 : begin
  547.         if TokenType = PLUS then
  548.           Shift(12)
  549.         else if TokenType = MINUS then
  550.           Shift(13)
  551.         else if TokenType = CPAREN then
  552.           Shift(29)
  553.         else
  554.           TokenError := True;
  555.       end;
  556.       29 : Reduce(16);
  557.     end; { case }
  558.   until Accepted or TokenError;
  559.   if TokenError then
  560.   begin
  561.     Att := TXT;
  562.     Parse := 0;
  563.     Exit;
  564.   end;
  565.   if IsFormula then
  566.     Att := FORMULA
  567.   else
  568.     Att := VALUE;
  569.   if MathError then
  570.   begin
  571.     Inc(Att, 4);
  572.     Parse := 0;
  573.     Exit;
  574.   end;
  575.   Parse := Stack[StackTop].Value;
  576. end; { Parse }
  577.  
  578. end.
  579.