1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279: 280: 281: 282: 283: 284: 285: 286: 287: 288: 289: 290: 291: 292: 293: 294: 295: 296: 297: 298: 299: 300: 301: 302: 303: 304: 305: 306: 307: 308: 309: 310: 311: 312: 313: 314: 315: 316: 317: 318: 319: 320: 321: 322: 323: 324: 325: 326: 327: 328: 329: 330: 331: 332: 333: 334: 335: 336: 337: 338: 339: 340: 341: 342: 343: 344: 345: 346: 347: 348: 349: 350: 351: 352: 353: 354: 355: 356: 357: 358: 359: 360: 361: 362: 363: 364: 365: 366: 367: 368: 369: 370: 371: 372: 373: 374: 375: 376: 377: 378: 379: 380: 381: 382: 383: 384: 385: 386: 387: 388: 389: 390: 391: 392: 393: 394: 395: 396: 397: 398: 399: 400: 401: 402: 403: 404: 405: 406: 407: 408: 409: 410: 411: 412: 413: 414: 415: 416: 417: 418: 419: 420: 421: 422: 423: 424: 425: 426: 427: 428: 429: 430: 431: 432: 433: 434: 435: 436: 437: 438: 439: 440: 441: 442: 443: 444: 445: 446: 447: 448: 449: 450: 451: 452: 453: 454: 455: 456: 457: 458: 459: 460: 461: 462: 463: 464: 465: 466: 467: 468: 469: 470: 471: 472: 473: 474: 475: 476: 477: 478: 479: 480: 481: 482: 483: 484: 485: 486: 487: 488: 489: 490: 491: 492: 493: 494: 495: 496: 497: 498: 499: 500: 501: 502: 503: 504: 505: 506: 507: 508: 509: 510: 511: 512: 513: 514: 515: 516: 517: 518: 519: 520: 521: 522: 523: 524: 525: 526: 527: 528: 529: 530: 531: 532: 533: 534: 535: 536: 537: 538: 539: 540: 541: 542: 543: 544: 545: 546:
| unit uMathParser;
interface
uses strutils, sysutils;
type EOp = (Op_None, Op_Equal, Op_NotEqual, Op_Less, Op_Greater, Op_Modulo, Op_EqualOrLess, Op_EqualOrGreater, Op_Addition, Op_Subtraction, Op_Multiplication, Op_IDivision, Op_Or, Op_Xor, Op_And, Op_ShiftLeft, Op_ShiftRight, Op_Negate, Op_RDivision);
EType = (T_Op, T_Boolean, T_Integer, T_Extended);
TExpNode = class private fContent: EType; public property Content: EType read fContent; destructor Destroy; virtual; abstract; function ResultInt: Integer; virtual; abstract; function ResultExt: Extended; virtual; abstract; function ResultBool: Boolean; virtual; abstract; end;
TOpNode = class(TExpNode) private fl, fr: TExpNode; fOp: EOp; public constructor Create(s: string; posi, len: Integer; Op: EOp); destructor Destroy; override; function ResultInt: Integer; override; function ResultExt: Extended; override; function ResultBool: Boolean; override; end;
TConstNode = class(TExpNode) private fData: Pointer; public constructor Create(s: string); destructor Destroy; override; function ResultInt: Integer; override; function ResultExt: Extended; override; function ResultBool: Boolean; override; end;
TMath = class(TExpNode) private fStart: TExpNode; public constructor Create(s: string); destructor destroy; override; function ResultInt: Integer; override; function ResultExt: Extended; override; function ResultBool: Boolean; override; end;
function GetType(s:string):EType; function GetOp(var s:string; var posi, len: integer):EOp;
implementation
function GetSubStr(s: string; StartPos, EndPos: Integer):string; begin result := Copy(s, Startpos, Endpos + 1 - Startpos); trim(result); end;
function Is_NumberNo0(s: char):boolean; begin result := (Byte(s) >= 49) and (Byte(s) <= 57); end;
function Is_Number(s: char):boolean; begin result := Is_NumberNo0(s) or (s = '0'); end;
function Is_Integer(s: string):boolean; var i:byte; begin if (s[1] = '-') or (s[1] = '+') then delete(s, 1, 1); if length(s) > 1 then begin if Is_NumberNo0(s[1]) then begin i := 2; while (i <> length(s)) and Is_Number(s[i]) do inc(i); result := Is_Number(s[i]); end else result := false; end else result := Is_Number(s[1]); end;
function Is_IntegerWL0(s: string):boolean; var i:byte; begin if length(s) > 1 then begin i := 1; while (i <> length(s)) and Is_Number(s[i]) do inc(i); result := Is_Number(s[i]); end else result := Is_Number(s[1]); end;
function Is_Real(s: string):boolean; var i: integer; begin i := PosEx(',', s, 1); if i > 0 then begin if PosEx(',', s, i + 1) > 0 then result := false else result := Is_Integer(GetSubStr(s, 1, i - 1)) and Is_IntegerWL0(GetSubStr(s, i + 1, length(s))) end else result := Is_Integer(s); end;
function Is_Boolean(s: string):boolean; begin result := (s = 'true') or (s = 'false'); end;
function GetOp(var s:string; var posi, len: integer):EOp; var Priority: integer; bracketcount: integer; begin result := Op_None; bracketcount := 0; Priority := 0; repeat posi := length(s) + 1; repeat dec(posi); if s[posi] = ')' then inc(bracketcount); if s[posi] = '(' then dec(bracketcount); if bracketcount = 0 then case Priority of 0: if s[posi] = '|' then result := Op_Or; 1: if s[posi] = '^' then result := Op_XOr; 2: if s[posi] = '&' then result := Op_And; 3: begin if s[posi] = '=' then result := Op_Equal; if s[posi-1] + s[posi] = '<>' then result := Op_NotEqual; end; 4: begin if (s[posi - 1] <> '<') and (s[posi] = '<') and (s[posi + 1] <> '<') then result := Op_Less; if (s[posi - 1] <> '>') and (s[posi] = '>') and (s[posi + 1] <> '>') then result := Op_Greater; if s[posi-1] + s[posi] = '<=' then result := Op_EqualOrLess; if s[posi-1] + s[posi] = '>=' then result := Op_EqualOrGreater; end; 5: begin if s[posi-1] + s[posi] = '<<' then result := Op_ShiftLeft; if s[posi-1] + s[posi] = '>>' then result := Op_ShiftRight; end; 6: begin if (s[posi] = '+') and (posi > 1) then result := Op_Addition; if (s[posi] = '-') and (posi > 1) then result := Op_Subtraction; end; 7: begin if s[posi] = '*' then result := Op_Multiplication; if s[posi] = '/' then result := Op_RDivision; if s[posi - 1] + s[posi] = '*/' then result := Op_IDivision; if s[posi] = '%' then result := Op_Modulo; end; 8: begin if s[posi] = '!' then result := Op_Negate; end; end; until (result <> Op_None) or (posi = 1); if (result = Op_None) and (Priority < 9) then inc(Priority); if (Priority = 9) and (s[1] = '(') and (s[length(s)] = ')') then begin Priority := 0; delete(s, 1, 1); delete(s, length(s), 1); end; until (result <> Op_None) or (Priority = 9);
if (result <> Op_None) then begin case result of Op_ShiftLeft, Op_ShiftRight, Op_EqualOrLess, Op_EqualOrGreater, Op_NotEqual, Op_IDivision: len := 2; Op_Or, Op_XOr, Op_And, Op_Less, Op_Greater, Op_Addition, Op_Equal, Op_Subtraction, Op_Multiplication, Op_RDivision, Op_Negate, Op_Modulo: len := 1; end; end; end;
function GetType(s:string):EType; begin if Is_Integer(s) then result := T_Integer else begin if Is_Real(s) then result := T_Extended; if Is_Boolean(s) then result := T_Boolean; end; end;
constructor TConstNode.Create(s: string); begin self.fContent := GetType(s); case self.fContent of T_Integer: begin New(PInteger(self.fData)); PInteger(self.fData)^ := StrToInt(s); end; T_Extended: begin New(PExtended(self.fData)); PExtended(self.fData)^ := StrToFloat(s); end; T_Boolean: begin New(PBoolean(self.fData)); PBoolean(self.fData)^ := StrToBool(s); end; end; end;
constructor TOpNode.Create(s: string; posi, len: Integer; Op: EOp); var newposi, newlen: integer; newOp: EOp; tempstring: string; begin fOp := Op; if fOp = Op_Negate then begin tempstring := GetSubStr(s, 1 + len, length(s)); newOp := GetOp(tempstring, newposi, newlen); if newOp = Op_None then fr := TConstNode.Create(s) else fr := TOpNode.Create(s, newposi, newlen, newOp); fContent := fr.content; end else begin tempstring := GetSubStr(s, 1, posi - len); newOp := GetOp(tempstring, newposi, newlen); if newOp = Op_None then fl := TConstNode.Create(tempstring) else fl := TOpNode.Create(tempstring, newposi, newlen, newOp); tempstring := GetSubStr(s, posi + 1, length(s)); newOp := GetOp(tempstring, newposi, newlen); if newOp = Op_None then fr := TConstNode.Create(tempstring) else fr := TOpNode.Create(tempstring, newposi, newlen, newOp); case fOp of Op_ShiftLeft, Op_ShiftRight, Op_Modulo, Op_IDivision, Op_Negate: fContent := T_Integer; Op_RDivision: fContent := T_Extended; Op_Equal, Op_NotEqual, Op_Less, Op_Greater, Op_EqualOrLess, Op_EqualOrGreater: fContent := T_Boolean; Op_Multiplication, Op_Addition, Op_Subtraction: if (fl.Content = T_Extended) or (fr.Content = T_Extended) then fContent := T_Extended else fContent := T_Integer; Op_And, Op_Or, Op_XOr: if (fl.content = T_Boolean) or (fr.content = T_Boolean) then fContent := T_Boolean else fContent := T_Integer; end; end; end;
constructor TMath.Create(s: string); var posi, len: integer; Op: EOp; begin Op := GetOp(s, posi, len); if Op = Op_None then fStart := TConstNode.Create(s) else fStart := TOpNode.Create(s, posi, len, Op); fContent := fStart.Content; end;
function TConstNode.ResultInt: Integer; begin result := PInteger(fData)^; end;
function TOpNode.ResultInt: Integer; begin case fOp of Op_Addition: result := fl.ResultInt + fr.ResultInt; Op_Subtraction: result := fl.ResultInt - fr.ResultInt; Op_Multiplication: result := fl.ResultInt * fr.ResultInt; Op_IDivision: result := fl.ResultInt div fr.ResultInt; Op_Modulo: result := fl.ResultInt mod fr.ResultInt; Op_XOr: result := fl.ResultInt xor fr.ResultInt; Op_And: result := fl.ResultInt and fr.ResultInt; Op_Or: result := fl.ResultInt or fr.ResultInt; Op_Negate: result := Not fr.ResultInt; Op_ShiftLeft: result := fl.ResultInt shl fr.ResultInt; Op_ShiftRight: result := fl.ResultInt shr fr.ResultInt; end; end;
function TMath.ResultInt: Integer; begin result := fStart.ResultInt; end;
function TConstNode.ResultExt: Extended; begin result := PExtended(fdata)^; end;
function TOpNode.ResultExt: Extended; begin case fOp of Op_Addition: begin if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt + fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt + fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt + fr.ResultExt; end; Op_Subtraction: begin if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt - fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt - fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt - fr.ResultExt; end; Op_Multiplication: begin if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt * fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt * fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt * fr.ResultExt; end; Op_RDivision: begin if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt / fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt / fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt / fr.ResultExt; if (fl.Content = T_Integer) and (fr.Content = T_Integer) then result := fl.ResultInt / fr.ResultInt; end; end; end;
function TMath.ResultExt: Extended; begin result := fStart.ResultExt; end;
function TConstNode.ResultBool: Boolean; begin result := PBoolean(fdata)^; end;
function TOpNode.ResultBool: Boolean; begin case fOp of Op_Equal: begin if (fl.Content = T_Integer) and (fr.Content = T_Integer) then result := fl.ResultInt = fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt = fr.ResultInt; if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt = fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt = fr.ResultExt; end; Op_NotEqual: begin if (fl.Content = T_Integer) and (fr.Content = T_Integer) then result := fl.ResultInt <> fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt <> fr.ResultInt; if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt <> fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt <> fr.ResultExt; end; Op_Less: begin if (fl.Content = T_Integer) and (fr.Content = T_Integer) then result := fl.ResultInt < fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt < fr.ResultInt; if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt < fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt < fr.ResultExt; end; Op_Greater: begin if (fl.Content = T_Integer) and (fr.Content = T_Integer) then result := fl.ResultInt > fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt > fr.ResultInt; if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt > fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt > fr.ResultExt; end; Op_EqualOrLess: begin if (fl.Content = T_Integer) and (fr.Content = T_Integer) then result := fl.ResultInt <= fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt <= fr.ResultInt; if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt <= fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt <= fr.ResultExt; end; Op_EqualOrGreater: begin if (fl.Content = T_Integer) and (fr.Content = T_Integer) then result := fl.ResultInt >= fr.ResultInt; if (fl.Content = T_Extended) and (fr.Content = T_Integer) then result := fl.ResultExt >= fr.ResultInt; if (fl.Content = T_Integer) and (fr.Content = T_Extended) then result := fl.ResultInt >= fr.ResultExt; if (fl.Content = T_Extended) and (fr.Content = T_Extended) then result := fl.ResultExt >= fr.ResultExt; end; Op_Or: result := fl.ResultBool or fr.ResultBool; Op_And: result := fl.ResultBool and fr.ResultBool; Op_Xor: result := fl.ResultBool xor fr.ResultBool; Op_Negate: result := not fr.ResultBool; end; end;
function TMath.ResultBool: Boolean; begin result := fStart.ResultBool; end;
destructor TConstNode.Destroy; begin case fContent of T_Integer: Dispose(PInteger(fData)); T_Extended: Dispose(PExtended(fData)); T_Boolean: Dispose(PBoolean(fData)); end; inherited; end;
destructor TOpNode.Destroy; begin fr.Destroy; if not (fOp = Op_Negate) then fl.Destroy; inherited; end;
destructor TMath.Destroy; begin fStart.Destroy; inherited; end;
end. |