SRL Archive - Research & Development Lounge

Hey. It seemed to me a funny idea to interpret something in interpreter:) And on the basis of this idea turned out that's a script that interprets the mathematical expression in the Lape interpreter:)

Requirements:
1) Simba => 1.0
2) Lape interpreter

program MathInterpreter;

var
  DecimalSeparator: Char;

function IsDigit(Ch: Char): Boolean;
begin
  Result := Ch in ['0'..'9']
end;

function IsSign(Ch: Char): Boolean;
begin
  Result := (Ch = '+') or (Ch = '-')
end;

function IsSeparator(Ch: Char): Boolean;
begin
  Result := Ch = DecimalSeparator
end;

function IsExponent(Ch: Char): Boolean;
begin
  Result := (Ch = 'E') or (Ch = 'e')
end;

function Number(const S: string; var P: Integer): Extended;
var
  InitPos: Integer;
begin
  InitPos := P;
  if (P > Length(S)) or not IsDigit(S[P]) then
  begin
    WriteLn('Waiting for number in pos: ' + IntToStr(P));
    TerminateScript;
  end;
  repeat
    Inc(P)
  until (P > Length(S)) or not IsDigit(S[P]);
  if (P <= Length(S)) and IsSeparator(S[P]) then
  begin
    Inc(P);
    if (P > Length(S)) or not IsDigit(S[P]) then
    begin
      WriteLn('Waiting for number in pos: ' + IntToStr(P));
      TerminateScript;
    end;
    repeat
      Inc(P)
    until (P > Length(S)) or not IsDigit(S[P]);
  end;
  if (P <= Length(S)) and IsExponent(S[P]) then
  begin
    Inc(P);
    if P > Length(S) then
    begin
      writeln('Wtf? EOF?');
      TerminateScript;
    end;
    if IsSign(S[P]) then
      Inc(P);
    if (P > Length(S)) or not IsDigit(S[P]) then
    begin
      WriteLn('Waiting for number in pos: ' + IntToStr(P));
      TerminateScript;
    end;
    repeat
      Inc(P)
    until (P > Length(S)) or not IsDigit(S[P]);
  end;
  Result := StrToFloat(Copy(S, InitPos, P - InitPos))
end;

function IsOperator1(Ch: Char): Boolean;
begin
  Result := Ch in ['+', '-']
end;

function IsOperator2(Ch: Char): Boolean;
begin
  Result := Ch in ['*', '/']
end;

function Expr(const S: string; var P: Integer): Extended; forward;

function Func(const FuncName, S: string; var P: Integer): Extended;
var
  Arg: Extended;
begin
  Arg := Expr(S, P);
  if AnsiCompareText(FuncName, 'sin') = 0 then
    Result := Sin(Arg)
  else if AnsiCompareText(FuncName, 'cos') = 0 then
    Result := Cos(Arg)
  else if AnsiCompareText(FuncName, 'ln') = 0 then
    Result := Ln(Arg)
  else
  begin
    writeln('Unknown function ' + FuncName);
    TerminateScript;
  end;
end;

function Identifier(const S: string; var P: Integer): Extended;
var
  InitP: Integer;
  IDStr, VarValue: string;
begin
  InitP := P;
  Inc(P);
  while (P <= Length(S)) and (S[P] in ['A'..'Z', 'a'..'z', '_', '0'..'9']) do
    Inc(P);
  IDStr := Copy(S, InitP, P - InitP);
  if (P <= Length(S)) and (S[P] = '(') then
  begin
    Inc(P);
    Result := Func(IDStr, S, P);
    if (P > Length(S)) or (S[P] <> ')') then
    begin
      WriteLn('Wait for ")" in pos: ' + IntToStr(P));
      TerminateScript;
    end;
    Inc(P)
  end
end;

function Base(const S: string; var P: Integer): Extended;
begin
  if P > Length(S) then
  begin
    writeln('wtf? eof?');
    TerminateScript;
  end;
  case S[P] of
    '(':
      begin
        Inc(P);
        Result := Expr(S, P);
        if (P > Length(S)) or (S[P] <> ')') then
        begin
          WriteLn('Wait for ")" in pos: ' + IntToStr(P));
          TerminateScript;
        end;
        Inc(P)
      end;
    '0'..'9': Result := Number(S, P);
    'A'..'Z', 'a'..'z', '_': Result := Identifier(S, P)
    else
    begin
      writeln('invalid char in pos: ' + IntToStr(P));
      TerminateScript;
    end;
  end
end;

function Factor(const S: string; var P: Integer): Extended;
begin
  if P > Length(S) then
  begin
    writeln('wtf? eof?');
    TerminateScript;
  end;
  case S[P] of
    '+':
      begin
        Inc(P);
        Result := Factor(S, P)
      end;
    '-':
      begin
        Inc(P);
        Result := - Factor(S, P)
      end
    else
    begin
      Result := Base(S, P);
      if (P <= Length(S)) and (S[P] = '^') then
      begin
        Inc(P);
        Result := Power(Result, Factor(S, P))
      end
    end
  end
end;

function Term(const S: string; var P: Integer): Extended;
var
  OpSymb: Char;
begin
  Result := Factor(S, P);
  while (P <= Length(S)) and IsOperator2(S[P]) do
  begin
    OpSymb := S[P];
    Inc(P);
    case OpSymb of
      '*': Result := Result * Factor(S, P);
      '/': Result := Result / Factor(S, P)
    end
  end
end;

function Expr(const S: string; var P: Integer): Extended;
var
  OpSymb: Char;
begin
  Result := Term(S, P);
  while (P <= Length(S)) and IsOperator1(S[P]) do
  begin
    OpSymb := S[P];
    Inc(P);
    case OpSymb of
      '+': Result := Result + Term(S, P);
      '-': Result := Result - Term(S, P)
    end
  end
end;

function Calculate(const S: string): Extended;
var
  P: Integer;
begin
  P := 1;
  Result := Expr(S, P);
  if P <= Length(S) then
  begin
    writeln('Invalid character in pos: ' + IntToStr(P));
    TerminateScript;
  end;
end;

begin
  DecimalSeparator := '.';
  WriteLn(FloatToStr(Calculate('11+24')));
  WriteLn(FloatToStr(Calculate('(11+24)*2')));
  WriteLn(FloatToStr(Calculate('11+24*2')));
  WriteLn(FloatToStr(Calculate('22+33')));
  WriteLn(FloatToStr(Calculate('6/2')));
  WriteLn(FloatToStr(Calculate('9/6')));
  WriteLn(FloatToStr(Calculate('9.2*1.3')));
  WriteLn(FloatToStr(Calculate('((22+44/2)*6)/2')));
end.

Compiled successfully in 327 ms.
35
70
59
55
3
1.5
11.96
132
Successfully executed.

How I can use that?

Well, this approach can be used for obfuscating the private scripts, or just for fun:)

Enjoy!

Cheers,
Cynic.

but… what about this…

function IsExponent(Ch: Char): Boolean;
begin
  Result := (Ch = 'E') or (Ch = 'e')
end;

and using e = 2.7182818284…?

Nice thing!

btw.

(S[P] in ['A'..'Z', 'a'..'z', '_', '0'..'9'])

I see first time this syntax. What is it?

From: bg5
Nice thing!

btw.

(S[P] in ['A'..'Z', 'a'..'z', '_', '0'..'9'])

I see first time this syntax. What is it?

a in SomeArray will return if element a is in the array.

SomeChar .. OtherChar will be interpreted as SomeChar, SomeChar +1, SomeChar +2 etc etc OtherChar. So 'A'..'D' is interpreted as 'A', 'B', 'C', 'D'

@masterBB thought "in" keyword used for testing / iterating of a set, more over an array

also Cynic, nice job again :]
cheers,
-lj

From: Le Jingle
@masterBB thought "in" keyword used for testing / iterating of a set, more over an array

also Cynic, nice job again :]
cheers,
-lj

That is right.

Over simplistic code example(I know you don't need it ;) )

var
  Farm: Array of TCow;
  SomeCow: TCow;
  Betty: TCow;

begin
  Betty := CreateCow('Betty');
  Farm := [Betty, CreateCow('cow 124'), CreateCow('cow 489'), CreateCow('cow 954'), CreateCow('cow 627')];

  For SomeCow in Farm do
  begin
    SomeCow.fetch();
    SomeCow.milk();
  end;

  If Betty in Farm then
    writeln('Betty is in the farm!');

end.