🚀 go-pugleaf

In article <3422EC5A.5B3E@club-internet.fr>,
Timomai  <timomai@club-internet.fr> wrote:
>Dr Zeed wrote:
>> 
>> Hello!
>> 
>> I just started with Pascal.. now I got a little problem! I want to do a
>> Calculator.. I want the calculator to look like this:
>> 
>> 3+4+5+9 [enter]
>> Answer: 21
>> 
>> I want to be able to use +,-,*,/ and write many numbers on the same row. I
>> hope someone can help me, maybe you know a good idea...
>> 
>> Dr_Zeed@hotmail.com
>Hi,
>
>	That is a very hard problem in Pascal to solve. You have 2 solutions :
>   1 you take a such function from a book or from a website
>   2 you write it
>
>        If you decide to write it, you should be a good programmer in
>Pascal. (you have to know pointers...) So, if you want to have your
>function now, it is better to download it. But it can be a good exercise
>to write it. If you want, i can explain you better how to write such
>function. For instance, i wrote, 2 years ago, a such function which
>recognizes more thatn + \ * and -, and which can derivate the function
>given by the string..

Well there is little need for pointers. Sure one can form an expression
tree and calculate it but the same routine that builds the tree can
instead return the value directly. Expression trees are probably useful
when one needs to calculate same value repeatedly.

Here is part of an earlier message by me in slightly modified form:

Basic is an interpreted language, so the EVAL can just use the
interpreter to do the job. Pascal on the other hand is compiled and
there is no way to use any interpreter. For example the compiled Pascal
program has no knowledge of variable names. One has to write the
procedures oneself.

A good way to do is to write a recursive parser. First begin with the
syntax of the expression, like:

expression = term {+ | - term }
term = factor {* | / factor }
factor = number | '(' expression ')'

Then the rest is just coding. Here is an example. To use it just set
variables, like

v['X']:=1;
v['Y']:=5;
v['Z']:=7.3;

Or you could use

vl['x']:=1; etc.
 ^

Then call the routine

res:=value('2*x+(5*y)/z')

Use Errorposition>0  (or errocode>0) to detect errors.
(Errorcode=1 in case of syntax errors, in case of floating point and
stack errors it is as specified in TP manual. If the line is 255
characters long then errocode:=255)

The routine does not support raising to power or functions. If you want
to add them, first change the syntax in comments and then the code.

If you need longint version then just change real to longint (uyou can
even put type real=longint in the _implemntation_ part and change
"/" to "DIV" (in code, not inside quotes)


Unit Eval;

Interface


{$IFOPT N+}
  Type Real=Double; {or extended, or single. Make sure that it is the }
                    {type as the variables you use }
{$ENDIF}

Function Value(const str:string):real;

var v:array['A'..'Z'] of real;              {  Variables used in evaluation }
    vl:array['a'..'z'] of real absolute v;
                          
{ You can change this to a simple array of values. In this case the
  types do not need to be exactly same but one has to change the values
  directly to the array }

var errorcode:byte;
    errorposition:integer;

Implementation

{ Set jump and longjump routines for error handling. Setjump returns
  always value TRUE. When Longjump is called, the program returns from the
  previous setjump call, but so that the value returned is FALSE. (Note
  the numeric equivalents of those are just the opposite of those used
  in C)

  for Turbo pascals before 6.0 use external assembler routines

}


Var JRec:record
            sp_:word;
            bp_:word;
            case Boolean of
                 false: (ip_,cs_:word);
                 true:  (RetAddr:Pointer);
         End;


Function SetJump:Boolean; far; Assembler;
          Asm
          Pop JRec.ip_
          Pop JRec.cs_
          Mov JRec.Bp_,bp
          Mov JRec.Sp_,sp
          Mov al,1
          Jmp JRec.RetAddr
          End;

Procedure LongJump; far; Assembler;
          Asm
          Mov bp,Jrec.bp_
          Mov sp,Jrec.sp_
          xor ax,ax
          Jmp Jrec.RetAddr
          end;


{
  Error handling routines to get back from runtime error: 
  division by zero, overflow. Jumping out from Exitprocedure is not
  something from Borland manual, but it seems to work
}


var ExitSave:pointer;

Procedure ExitP; Far;
Begin
  ExitProc:=ExitSave;
  If (ErrorAddr<>Nil) then begin
     errorcode:=Exitcode;
     LongJump;
  End;
End;



Procedure SetErrorRoutine;
Begin
  If ExitProc<>@ExitP Then Begin
    ExitSave:=ExitProc;
    ExitProc:=@ExitP;
  End;
End;



Procedure RemoveErrorRoutine;
Begin
  ExitProc:=ExitSave;
End;

{ Function to convert a sting to upper case. Used in MOD. }

function UpcaseStr(st:string): string;
var i:integer;
begin
  for i:=1 to length(st) do st[i]:=upcase(st[i]);
  UpcaseStr:=st;
End;

var st:string;
    index:integer;

Procedure SkipBlank;
begin
  while st[index]=' ' do inc(index);
End;

(* Syntax:

       expression = term {'+'|'-' term}
       term       = factor {'*'|'/' factor }
       factor     = {'+'| '-'}  ( number | '(' expression ')' | variable )

       number     = a real value
       variable   = A..Z


*)


Function term:real; forward;
Function factor:real; forward;

Function Expression:real;
var x:real;
begin
  x:=term;
  repeat
    SkipBlank;
    case st[index] of
         '+': begin inc(index); x:=x+term; End;
         '-': begin inc(index); x:=x-term; End;
         else begin expression:=x; exit; end;
    End;
  until false;
End;


Function term:real;
var x:real;
begin
  x:=factor;
  repeat
    SkipBlank;
    case upcase(st[index]) of
         '*': begin inc(index); x:=x*factor; end;
         '/': begin inc(index); x:=x/factor; end;
        else  begin term:=x; exit; end;
    End;
 until false;
End;


Procedure ValCopy(const st:string; first, count:integer; var x:real;
                  var error:integer);
begin
  val(copy(st,first,count),x,error);
End;


Function factor:real;
var x:real;
    err,err2:integer;
    s:-1..1;
begin
  if sptr<700 then begin
     errorcode:=202;
     longjump;
  End;
{  writeln(sptr);}
  SkipBlank;
  s:=1;
  while (st[index]='-') or (st[index]='+') do begin
      if st[index]='-' then s:=-s;
      inc(index);
      skipblank;
  End;
  case st[index] of
       '0'..'9': begin
                     valcopy(st,index,255,x,err);
                     if err=0 then longjump;         { Just in case }
                     valcopy(st,index,err-1,x,err2);
                     inc(index,err-1);
                     if err2>0 then longjump;
                   End;
         '(':      begin
                     inc(index);
                     x:=expression;
                     SkipBlank;
                     if st[index]<>')' then longjump;
                     inc(index);
                   End;
        else if upcase(st[index]) in ['A'..'Z'] then begin
                     x:=v[upcase(st[index])];
                     inc(index);
             end else longjump;
  End;
  factor:=x*s;
End;


Function Value(const str:string):real;
Begin
  if length(str)=255 then begin 
                             errorposition:=255; 
                             errorcode:=255;
                             Value:=0;
                             exit; 
                           end;
  st:=str+#0;
  errorcode:=0;
  errorposition:=0;
  if SetJump then begin
    SetErrorRoutine;
    index:=1;
    value:=expression;
    if index<=length(str) then longjump;
  End
  else begin
         value:=0;
         errorposition:=index;
         if errorcode=0 then errorcode:=1;
       End;
  RemoveErrorRoutine;
End;

begin
  fillchar(v,sizeof(v),#0);
end.