UNIT PARSER;
Interface
Uses Windows, Sysutils, Messages, Classes, Graphics, Controls, Forms, Dialogs
TYPE TGETVAREVENT = Procedure (Sender: Tobject; Varname: string; var value: extended; var Found: boolean) of object;
TPARSEERREERREVENT = Procedure (Sender: Tobject; Parseerror: Integer) OF Object;
const ParserStackSize = 15; MaxFuncNameLen = 5; ExpLimit = 11356; SqrLimit = 1E2466; MaxExpLen = 4; TotalErrors = 7; ErrParserStack = 1; ErrBadRange = 2; ErrExpression = 3; ErrOperator = 4; ErrOpenParen = 5; ErrOpCloseParen = 6; ErrInvalidNum = 7;
Type errorRrange = 0..totalerrors;
TokenTypes = (Plus, Minus, Times, Divide, Expo, Oparen, Cparen, Num, Func, EOL, BAD, ERR, MODU)
Tokenrec = Record State: Byte; Case Byte of 0: (value: extended); 2: (FuncName: String [MAXFUNFUNCNAMELEN]); End; {tokenrec}
type TMathParser = class (TComponent) private {Private declarations} FInput: string; FOutput: string; FOnGetVar: TGetVarEvent; FOnParseError: TParseErrorEvent; protected {Protected declarations} CurrToken: TokenRec; MathError: Boolean; Stack: array [1..ParserStackSize] of TokenRec; stackTop: 0..ParserStackSize; TokenError: ErrorRange; TokenLen: Word; TokenType: TokenTypes; function GotoState (Production: Word): Word; function IsFunc (S: String): Boolean; function IsVar (var Value: Extended) : Boolean; function NextToken: TokenTypes; procedure Push (Token: TokenRec); procedure Pop (var Token: TokenRec); procedure Reduce (Reduction: Word); procedure Shift (State: Word); public {public declarations} Position: Word; Parseerror: Boolean; parsevalue: Extended; Constructor Create (Aowner: tComponent); Procedure Parse; Published {Published Declarations} P roperty OnGetVar: TGetVarEvent read FOnGetVar write FOnGetVar; property OnParseError: TParseErrorEvent read FOnParseError write FOnParseError; property ParseString: string read FInput write FInput; property OutPutString: string read FOutput write FOutPut; end; procedure Register;
{$ R * .res}
IMPLEMENTATION
Const letters: set of char = ['a' .. 'z', 'a' .. 'z']; numbers: set of char = ['0' .. '9'];
Constructor TMATHPARSER.CREATE (AOWNER: TComponent); Begin inherited Create (Aowner); {Defaults} Finput: = '; foutput: ='; END;
function TMathParser.GotoState (Production: Word): Word; {Finds the new state based on the just-completed production and the top state.} var State: Word; begin State: = Stack [StackTop] .State; if (Production < = 3) The begin case: = 1; 9: gotostate: = 19; 20: gotostate: = 28; end; {copy} end else = {copy} end else = {cas} end else = 20: gotostate: = 2; 12: gotostate: = 21; 13: gotostate: = 22; end; {copy} end else if (Production <= 8) or Begin Case State of 0, 9, 12, 13, 20: Gotostate: = 3; 14: gotostate: = 23; 15: gotostate: = 25; 40: gotostate: = 80; end; {copy} end else if products <= 10 THEN BEGIN CASE STATE OF Zi 0, 9, 12..16, 20, 40: gotostate: = 4; end; {copy} end else if produuction <= 12 Then Begin Case State Of 0, 9, 12..16, 20, 40: gotostate: = 6; 5: Gotostate: = 17; end; {case} END ELSE BEGIN Case State of 0, 5, 9, 12..16, 20, 40: gotostate: = 8; end; {copy} end; end; {gotostate}
Function TMATHPARSER.ISFUNC (S: String): Boolean; {Checks to See eti the Parser IS About to read a function} var p, slen: word; funcname: string; begin p: = position; funcname: = '; while (P <= Length (Finput)) and (Finput [P] in ['a' .. 'Z', 'A' .. 'Z', '0' .. '9', '_']) DO Begin funcname: = FuncName Finput [P]; INC (P); end; {while} if Uppercase (FUNCNAME) = S1N Begin Slen: = Length (s); currtoken.funcname: = Uppercase (Copy) , INC: = true; end {= false; end; {isfunc} function tmathparser.isvar (var value: extend): boolean; var varname: string; "VAR VARUE: STRING; Varfound: boolean; begin varFound: = false; varName: = '; while (position <= length (finput)) and (finput [position] in [' a '..' z ',' a '..' Z ',' 0 '.' 9 ',' _ ']) Do Begin VarName: = VarName Finput [Position]; Inc (position); end; {while} IF assigned (fongetvar) THEN FONGETVAR (Self, Varname, Valu E, VARFOUND); isvar: = varFound; end; {isvar}
function TMathParser.NextToken: TokenTypes; {Gets the next Token from the Input stream} var NumString: String [80]; FormLen, Place, TLen, NumLen: Word; Check: Integer; Ch, FirstChar: Char; Decimal: Boolean; begin While (Position <= Length (Finput)) and (Finput [Position] = '') Do INC (Position); tokenlen: = Position; if Position> Length (Finput) THEN BEGIN NEXTTOKEN: = EOL; Tokenlen: = 0; EXIT; END; {if} ch: = Upcase (Finput [Position]); if Chin ['!'] The begin nextToken: = Err; tokenlen: = 0; EXIT; End; {if} if chin [' 0 '..' 9 ','. '] The begin numstring: ='; tlen: = position; decimal: = false; while (tlen <= length (finput)) and (Finput [tlen] in [" 0 '..' 9 ']) or (Finput [tlen] ='. ') AND (not decimal)) DO begin numstring: = NumString Finput [TLEN]; if ch ='. 'Then Decal: = True; INC; End; {while} IF (tlen = 2) and (ch = '.') THEN B EGIN NEXTTOKEN: = Bad; tokenlen: = 0; exit; end; {if} IF (tlen <= length (finput)) and (file (Finput [tlen]) = 'E') THEN BEGIN NUMSTRING: = NumString ' E '; Inc (TLEN); if Finput [TLEN] IN [' ',' - '] The begin Numstring: = NumString Finput [TLEN]; INC; END; {if} Numlen: = 1; While (Tlen <= Length (Finput)) and (Finput [TLEN] IN ['0' .. '9']) AND (Numlen <=
MaxExplen) Do Begin NumString: = NumString Finput [TLEN]; Inc (Numlen); INC; End; {while} end; {if} if Numstring [1] = '.' Ten Numstring: = '0' NumString; Val (Numstring, Currtoken.Value, Check); if CHECK <> 0 THEN BEGIN MATHERROR: = true; TokenError: = ErrinvalidNum; Inc; INC; End {if} else begin nexttoken: = Num; Inc (position, system.length); tokenlen: = position - tokenlen; end; {else} exit; end {if} else} {iSfunc ('ABS') or isfunc (' Atan ') or isfunc (' exp ') or isfunc (' l ') or isfunc (' int ') or isfunc (' sin ') or isfunc (' SQRT ') or isfunc (' sqr ') or isfunc (' trunc ') Then Begin NextToken: = func; tokenlen: = position - tokenlen; exit; end; {ix } If isfunc ('mod') THEN Begin NextToken: = MODU; tokenlen: = position - tokenlen; EXIT; End; {if} if isvar (currtoken.value) THENES NEXTTOKEN: = Num; Tokenlen: = position - tokenlen; EXIT; END; tokenlen: = 0; exit; end; {else} end {if} else begin case: = plus; '-': NextToken: = Minus; '
* ': NextToken: = Times;' / ': NextToken: = Divide;' ^ ': NextToken: = Expo;' ('): NEXTTOKEN: = Oparen;') ': NextToken: = CParen; Else Begin NextToken: = Bad {Case ELSE} end; {copy; {copy; {copy} inckey; tokenlen: = position - tokenlen; exit; end; {else if} end; {nextToken} process; {nextToken} procedure TMATHPARSER.POP (var) Token: tokenrec); {pops the top token off of the stack} begin token: = stack [stacktop]; dec (stacktop); end; {pop}
procedure TMathParser.Push (Token: TokenRec); {Pushes a new Token onto the stack} begin if StackTop = ParserStackSize then TokenError: = ErrParserStack else begin Inc (StackTop); Stack [StackTop]: = Token; end; {else} end {Push}
procedure TMathParser.Parse; {Parses an input stream} var FirstToken: TokenRec; Accepted: Boolean; begin FOutPut: = FInPut; Position: = 1; StackTop: = 0; TokenError: = 0; MathError: = False; ParseError: = False ACCEPTED: = false; firsttoken.State: = 0; firsttoken.Value: = 0; push (firsttoken); tokentype: = nextToken; Repeat Case Stack [stacktop] .state of 0, 9, 12..16, 20, 40: begin if TokenType = NUM then Shift (10) else if TokenType = FUNC then Shift (11) else if TokenType = MINUS then Shift (5) else if TokenType = OPAREN then Shift (9) else if TokenType = ERR then begin MathError : = True; Accepted: = true; end {else if} else begin tokenerror: = errexpression; dec (position, tokenlen); end; {else} end; {else} end; {case of} 1: begin if tokentype = eol damped: = True else if tokentype = Plus T Hen Shift (12) else if to gokentype = minus kiln; = erroperator; dec (position, tokenlen); end; {else} end; {case of} 2: begin if tokentype = Times Then Shift ({CASE OF = TIMES THEN SHIFT 14) Else if tokentype = Divide Then Shift (15) Else Reduce (3); End; {Case of} 3: Begin if tokentype = modu Then Shift (40) Else Reduce (6); end; {copy of} 4: BEGIN if tokentype = expo kilq t (16) else redument (8);
{Case of} 5: Begin if tokentype = Num Then Shift (10) Else if tokentype = func dam = oparen thift (9) else begin tokenerror: = errexpression; DEC (position, tokenlen); End; {else} end; {case of} 6: redu (10); 7: redu (13); 8: reduce (12); 10: Reduce (15); 11: begin if tokentype = oparen kiln shift (20 Else Begin tokenError: = erropenparen; dec (position, tokenlen); end; {else} end; {case of} 17: reduce (9); 18: raate eXception.create ('bad token stat "; 19: Begin If TOKENTYPE = Plus dam (12) else if tokentype = minus dam = cparen dam = erropcloseparen; DEC (position, tokenlen); End; End; {Case of} 21: Begin if tokentype = Times Then Shift (14) Else if tokentype = Divide Then Shift (15) Else Reduce (1); End; {CASE OF} 22: Begin if tokentype = Times Then Shift (14) Else if tokentype = Divide Then Shift (15) Else Reduce (2); End; {Case of} 23: Reduce (4); 24: Reduce (5); 25: Reduce (7); 26: reduuce (11); 27: Reduce (14); 28: Begin if tokentype = plus dam (12) else if tokentype = minus dam (13) else if Token =
Cparen dam tokenerror: = erropcloseparen; dec (position, tokenlen); end; {else} end; {case of} 29: reduction (16); 80: reduction (100); end; {cas} until Accepted or (TokenError <> 0); if TokenError <> 0 then begin if TokenError = ErrBadRange then Dec (Position, TokenLen); if Assigned (FOnParseError) then FOnParseError (Self, TokenError); end; {if} if MathError or (TokenError <> 0) THEN BEGIN PARSEERROR: = true; parsevalue: = 0; exit; end; {if} parseerror: = false; parsevalue: = stack [stacktop] .value; end; {parse} procedure TMATHPARSER.REDUCE Reduction: Word); {Completes a reduuction} var token1, token2: tokenrec; begin case reduction of 1: begin Pop (token1); POP (token2); POP (token2); currtoken.value: = Token1.Value token2. Value; End; 2: Begin Pop (token1); POP (token2); POP (token2); Currtoken.Valu E: = token2.value - token1.value; end; 4: begin pop (token1); POP (token2); POP (token2); currtoken.value: = token1.value * token2.value; end; 5: Begin Pop (Token1); POP (token2); POP (token2); if token1.value = 0 Then Matherror: = true else currtoken.value: = token2.value / token1.value;
{MOD OPERATOR} 100: Begin Pop (token1); POP (token2); POP (token2); if token1.value = 0 Then Matherror: = true else currtoken.value: = round (token2.value) Mod Round (token1. Value);
7: Begin Pop (token1); POP (token2); POP (token2); if token2.value <= 0 THEN MATHERROR: = True else if (token1.value * ln (token2.value) <-explimit) or (token1 .Value * ln (token2.value)> Explimit) THEN MATHERROR: = true else currtoken.value: = exp (token1.value * ln (token2.value); end; 9: begin pop (token1); POP (token2 Currtoken.Value: = -token1.value; end; 11: raise exception.create ('invalid reduction "; 13: raise exception.create (' invalid reduction '); 14: Begin Pop (token1); POP Currtoken; POP (token1); end; 16: begin pop (token1); POP (Currtoken); POP (token1); POP (token1); if token1.funcname = 'abs' Ten Currtoken.Value: = ABS (Currtoken) Else if token1.funcName = 'Atan' Ten Currtoken.Value: = Arctan (currtoken.value) else if token1.funcname = 'cos' Then Begin IF (currtoken.value <-9e18) or (Currtok En.Value> 9e18) THEN MATHERROR: = true else currtoken.value: = cos (currtoken.value) end {... if token1.funcname = 'sin'} else if token1.funcname = 'Exp' The Begin IF CurrToken.Value <-ExpLimit) or (CurrToken.Value> ExpLimit) then MathError: = True else CurrToken.Value: = Exp (CurrToken.Value); end else if Token1.FuncName = 'LN' then begin if CurrToken.Value < = 0 THEN MATHERROR: = True else currtoken.value: = ln (currtoken.value);
Else if token1.funcname = 'round' Then Begin if (currtoken.value <-1e9) or (currtoken.value> 1e9) Then Matherror: = true else currtoken.Value: = round (currtoken.value); Else IF Token1.FuncName = 'sin' The beginness (currtoken.value <-9e18) or (currtoken.value> 9e18) THEN MATHERROR: = true else currtoken.Value: = sin (currtoken.value) end {... if token1 .FuncName = 'SIN'} else if Token1.FuncName = 'SQRT' then begin if CurrToken.Value <0 then MathError: = True else CurrToken.Value: = Sqrt (CurrToken.Value); end else if Token1.FuncName = ' SQR 'then begin if (CurrToken.Value <-SQRLIMIT) or (CurrToken.Value> SQRLIMIT) then MathError: = True else CurrToken.Value: = Sqr (CurrToken.Value); end else if Token1.FuncName =' TRUNC 'then Begin if (Currtoken.Value <-1e9) or (currto Ken.Value> 1E9) THEN MATHERROR: = true else currtoken.value: = trunc (currtoken.value); end else if token1.funcname = 'int' Then Begin if (currtoken.value <-1e9) or (Currtoken.Value > 1E9) THEN MATHERROR: = True else currtoken.value: = int (currtoken.value); end; end; 3, 6, 8, 10, 12, 15: POP (currtoken); end; {copy} currtoken.state : = Gotostate (reduction); push (currtoken); end; {reduce}
procedure TMathParser.Shift (State: Word); {Shifts a Token onto the stack} begin CurrToken.State: = State; Push (CurrToken); TokenType: = NextToken; end; {Shift} procedure Register; begin RegisterComponents ( 'BkSoft' , [TMATHPARSER]);
End.
