Модуль Expr.

unit Expr;

interface

uses

SysUtils, Strings;

type

TOperationType = (noneOp, eqOp, lessOp, moreOp, lessEqOp, moreEqOp, addOp, negOp, posOp,

subOp, mulOp, divOp, nonEqOp, notOp, andOp, orOp);

TOperandType = (unary, binary);

TOperation = record

name : string;

itsType : TOperationType;

operandType : TOperandType;

prior : byte;

end;

const

MAX_OPS_IN_EXPR = $FF;

OPD_MAX_VAL = 4095;

OPD_MIN_VAL = -4096;

NUM_OPS = 15;

BAD_INDEX = -1;

DEFAULT_RESULT = 0;

NORM_EXPR = 0;

ERR_BAD_BRACKETS_ORDER = 39;

ERR_NUM_BRACKETS = 40;

ERR_BAD_OPD_TYPE = 41;

ERR_OPERAND_EXPECTED = 42;

ERR_BAD_OPER_TYPE = 43;

ERR_OPERAND_OUT_OF_RANGE = 44;

OPERATIONS: array [0..NUM_OPS - 1] of TOperation =

((name:'=='; itsType: eqOp; operandType: Binary; prior: 0),

(name:'!='; itsType: nonEqOp; operandType: Binary; prior: 0),

(name:'<'; itsType: lessOp; operandType: Binary; prior: 0),

(name:'>'; itsType: moreOp; operandType: Binary; prior: 0),

(name:'<='; itsType: lessEqOp; operandType: Binary; prior: 0),

(name:'>='; itsType: moreEqOp; operandType: Binary; prior: 0),

(name:'+'; itsType: addOp; operandType: Binary; prior: 4),

(name:'-'; itsType: subOp; operandType: Binary; prior: 4),

(name:'*'; itsType: mulOp; operandType: Binary; prior: 5),

(name:'/'; itsType: divOp; operandType: Binary; prior: 5),

(name:'+'; itsType: posOp; operandType: Unary; prior: 6),

(name:'-'; itsType: negOp; operandType: Unary; prior: 6),

(name:'NOT'; itsType: notOp; operandType: Unary; prior: 3),

(name:'AND'; itsType: andOp; operandType: Binary; prior: 2),

(name:'OR'; itsType: orOp; operandType: Binary; prior: 1));

OPERATION_SEPARATOR = ' 0123456789()';

OPERAND_SEPARATOR = ' ()=!<>+-*/ABCDEFGHIJKLMNOPQRSTUVWXYZ';

function tryEvalExpr(expr: string; var err: byte; var errSubExpr: string): integer;

implementation

function checkValBounds(val: integer): byte;

begin

if ((val >= OPD_MIN_VAL) and (val <= OPD_MAX_VAL)) then

result := NORM_EXPR

else

result := ERR_OPERAND_OUT_OF_RANGE;

end;

function getOpIndex(str: string): integer;

var

i: integer;

begin

result := BAD_INDEX;

for i := 0 to NUM_OPS - 1 do

begin

if (str = OPERATIONS[i].name) then

begin

result := i;

exit;

end;

end;

end;

function checkBrackets(expr: string): byte;

var

i : integer;

numBrackets : byte;

begin

numBrackets := 0;

for i := 1 to length(expr) do

begin

if (expr[i] = '(') then

inc(numBrackets)

else

begin

if (expr[i] = ')') then

begin

if ((i < length(expr)) and (expr[i + 1] = '(')) then

begin

result := ERR_BAD_BRACKETS_ORDER;

exit;

end else

dec(numBrackets);

end;

end;

end;

if (numBrackets = 0) then

result := NORM_EXPR

else

result := ERR_NUM_BRACKETS;

end;

function getMaxOpPrior: byte;

var

i: byte;

begin

result := 0;

for i := 0 to NUM_OPS - 1 do

begin

if (OPERATIONS[i].prior > result) then

result := OPERATIONS[i].prior;

end;

end;

function evalExpr(expr: string; var err: byte; var errSubExpr: string): integer;

var

isFirstOp,

isLastOp : boolean;

opdStr1,

opdStr2,

currLexem : string;

i,

minPriorOp,

maxPrior,

currPriorOp,

level,

numOps : byte;

charPos,

tmpCharPos,

minOpCharPos,

minPriorOpIndex,

currOpIndex,

opdVal1,

opdVal2 : integer;

begin

result := DEFAULT_RESULT;

if (expr = '') then

exit;

numOps := 0;

level := 0;

minPriorOp := $FF;

maxPrior := getMaxOpPrior;

isFirstOp := true;

isLastOp := false;

charPos := 1;

while (charPos <= length(expr)) do

begin

if (pos(expr[charPos], OPERATION_SEPARATOR) <> 0) then

begin

if (expr[charPos] = '(') then

inc(level);

if (expr[charPos] = ')') then

dec(level);

inc(charPos);

continue;

end;

currLexem := trim(getNextLexem(expr, charPos, OPERATION_SEPARATOR));

if (currLexem = '') then

continue;

currOpIndex := getOpIndex(currLexem);

if (currOpIndex <> BAD_INDEX) then

begin

tmpCharPos := charPos - length(currLexem);

if (expr[tmpCharPos - 1] = '(') then

opdStr1 := ''

else

opdStr1 := trim(getPrevLexem(expr, tmpCharPos, OPERAND_SEPARATOR));

// if the first operand is not set then we are looking for an unary

// operation with the same name

if (opdStr1 = '') then

begin

for i := 0 to NUM_OPS - 1 do

begin

if ((OPERATIONS[i].name = OPERATIONS[currOpIndex].name) and

(OPERATIONS[i].operandType = Unary)) then

begin

currOpIndex := i;

break;

end;

end;

end;

currPriorOp := OPERATIONS[currOpIndex].prior + level * (maxPrior + 1);

if (currPriorOp <= minPriorOp) then

begin

minPriorOp := currPriorOp;

minPriorOpIndex := currOpIndex;

minOpCharPos := charPos - length(currLexem);

isFirstOp := (numOps = 0);

isLastOp := true;

end else

isLastOp := false;

inc(numOps);

end else

begin

err := ERR_BAD_OPER_TYPE;

errSubExpr := currLexem;

exit;

end;

end;

if (numOps = 0) then

begin

if (not tryStrToInt(expr, opdVal1)) then

begin

err := ERR_BAD_OPD_TYPE;

errSubExpr := expr;

end;

err := checkValBounds(opdVal1);

result := opdVal1;

exit;

end;

charPos := minOpCharPos - 1;

if (OPERATIONS[minPriorOpIndex].operandType = Binary) then

begin

if (not isFirstOp) then

begin

opdVal1 := evalExpr(getPrevLexem(expr, charPos, ''), err, errSubExpr);

if (err <> NORM_EXPR) then

begin

errSubExpr := expr;

exit;

end;

end else

begin

opdStr1 := trim(getPrevLexem(expr, charPos, '()'));

if (not tryStrToInt(opdStr1, opdVal1)) then

begin

err := ERR_BAD_OPD_TYPE;

errSubExpr := opdStr1;

exit;

end;

err := checkValBounds(opdVal1);

if (err <> NORM_EXPR) then

exit;

end;

end;

charPos := minOpCharPos + length(OPERATIONS[minPriorOpIndex].name);

if (not isLastOp) then

begin

opdVal2 := evalExpr(getNextLexem(expr, charPos, ''), err, errSubExpr);

if (err <> NORM_EXPR) then

begin

errSubExpr := expr;

exit;

end;

end else

begin

opdStr2 := trim(getNextLexem(expr, charPos, '()'));

if (not tryStrToInt(opdStr2, opdVal2)) then

begin

err := ERR_BAD_OPD_TYPE;

errSubExpr := opdStr2;

exit;

end;

err := checkValBounds(opdVal2);

if (err <> NORM_EXPR) then

exit;

end;

case (OPERATIONS[minPriorOpIndex].itsType) of

eqOp : result := ord(opdVal1 = opdVal2);

nonEqOp : result := ord(opdVal1 <> opdVal2);

lessOp : result := ord(opdVal1 < opdVal2);

moreOp : result := ord(opdVal1 > opdVal2);

lessEqOp : result := ord(opdVal1 <= opdVal2);

moreEqOp : result := ord(opdVal1 >= opdVal2);

addOp : result := opdVal1 + opdVal2;

subOp : result := opdVal1 - opdVal2;

mulOp : result := opdVal1 * opdVal2;

divOp : result := opdVal1 div opdVal2;

posOp : result := opdVal2;

negOp : result := -opdVal2;

notOp : result := ord(not (opdVal2 <> 0));

andOp : result := ord((opdVal1 <> 0) and (opdVal2 <> 0));

orOp : result := ord((opdVal1 <> 0) or (opdVal2 <> 0));

end;

end;

function tryEvalExpr(expr: string; var err: byte; var errSubExpr: string): integer;

begin

err := checkBrackets(expr);

if (err <> NORM_EXPR) then

exit;

result := evalExpr(expr, err, errSubExpr);

end;

end.