The parser is made out of 3 units:

- uTurboParser -- TurboParser class(based on TJvInterpreterParser)

- uTurboParserConst -- constants and variables that TurboParser needs

- uTurboUtils -- this is a work in progress

and here are comes the source code starting with

*uTurboParser.pas*(* uTurboParser -- is part of Turbo project Copyright© Dorin Duminica Usage of this file is permited for comercial and non-comercial programs. NOTE: if you optimize some of the bellow functions please let me know *) unit uTurboParser; interface uses SysUtils, Classes, uTurboUtils, uTurboParserConst; type TurboParser = class private FSource, FPCPos : PChar; SourceString : string; function GetPos: Integer; procedure SetPos(Value: Integer); procedure RaiseParserError(const Msg: string; const Args: array of TVarRec); public TokenValue : string; public procedure LoadFromFile(const FileName: string); function GetNextTokenString: string; function GetNextToken: TurboTokenType; function TokenAsBoolean: Boolean; function TokenAsChar: Char; function TokenAsDouble: Double; function TokenAsInteger: Integer; function TokenAsString: string; public property Position: Integer read GetPos write SetPos; public constructor Create(const FileName: string = ''); destructor Destroy; override; end; implementation uses Windows, Dialogs; { TurboParser } constructor TurboParser.Create(const FileName: string); begin LoadFromFile(FileName); end; destructor TurboParser.Destroy; begin SourceString := EmptyStr; end; function TurboParser.GetNextTokenString: string; var P, F: PChar; F1: PChar; I: Integer; PrevPoint: Boolean; procedure Skip; begin case P[0] of '(': if P[1] = '*' then begin F := P + 2; while True do begin F := StrScan(F, '*'); if F = nil then RaiseParserError(SBadRemark, [P - PChar(FSource)]); if F[1] = ')' then begin Inc(F); Break; end;// if F[1] = ')' then begin Inc(F); end;// while True do begin P := F + 1; end;// if P[1] = '*' then begin '*': if (P[1] = ')') then RaiseParserError(SBadRemark, [P - PChar(FSource)]); '/': if (P[1] = '/') then while not CharInSet(P[0], TURBO_LF_CR_NULL) do Inc(P) else if (P[1] = '*') then begin F := P + 2; while True do begin F := StrScan(F, '*'); if F = nil then RaiseParserError(SBadRemark, [P - PChar(FSource)]); if F[1] = '/' then begin Inc(F); Break; end;// if F[1] = '/' then begin Inc(F); end;// while True do begin P := F + 1; end;// if (P[1] = '*') then begin end;// case P[0] of while CharInSet(P[0], TURBO_SPACE_LF_CR_TAB) do Inc(P); end;// procedure Skip; begin { New Token } F := FPCPos; P := FPCPos; PrevPoint := false; if (P > PChar(FSource)) and (P[-1] = '.') then PrevPoint := true; { Firstly skip spaces and remarks } repeat F1 := P; Skip; until F1 = P; F := P; if CharInSet(P[0], TURBO_IDFIRSTSYMBOLS) or PrevPoint and IsCharAlpha(P[0]) then begin { token } while CharInSet(P[0], TURBO_IDSYMBOLS) or PrevPoint and IsCharAlpha(P[0]) do Inc(P); SetString(Result, F, P - F); end else if CharInSet(P[0], TURBO_CONSTSYMBOLS10) then begin { number } while CharInSet(P[0], TURBO_CONSTSYMBOLS10) or (P[0] = '.') do begin if (P[0] = '.') and (P[1] = '.') then Break; Inc(P); end;// while CharInSet(P[0], TURBO_CONSTSYMBOLS10) or (P[0] = '.') do begin SetString(Result, F, P - F); end else if ((P[0] = '$') and CharInSet(P[1], TURBO_CONSTSYMBOLS)) then begin { hex number } Inc(P); while CharInSet(P[0], TURBO_CONSTSYMBOLS) do Inc(P); SetString(Result, F, P - F); end else if P[0] = '''' then begin { string constant } Inc(P); while not CharInSet(P[0], TURBO_LF_CR_NULL) do begin if P[0] = '''' then if P[1] = '''' then Inc(P) else Break; Inc(P); end;// while not CharInSet(P[0], TURBO_LF_CR_NULL) do begin Inc(P); SetString(Result, F, P - F); I := 2; while I < Length(Result) - 1 do begin if Result[I] = '''' then Delete(Result, I, 1); Inc(I); end;// while I < Length(Result) - 1 do begin end else if ((P[0] = '#') and CharInSet(P[1], TURBO_CONSTSYMBOLS10)) then begin { Char constant } Inc(P); while CharInSet(P[0], TURBO_CONSTSYMBOLS10) do Inc(P); SetString(Result, F + 1, P - F - 1); Result := '''' + Chr(StrToInt(Result)) + ''''; end else if CharInSet(P[0], ['>', '=', '<', '.']) then begin if (P[0] = '.') and (P[1] = '.') then begin Result := '..'; Inc(P, 2); end else if (P[0] = '>') and (P[1] = '=') then begin Result := '>='; Inc(P, 2); end else if (P[0] = '<') and (P[1] = '=') then begin Result := '<='; Inc(P, 2); end else if (P[0] = '<') and (P[1] = '>') then begin Result := '<>'; Inc(P, 2); end else begin Result := P[0]; Inc(P); end; end else if P[0] = #0 then Result := EmptyStr else begin Result := P[0]; Inc(P); end; FPCPos := P; end; function TurboParser.GetNextToken: TurboTokenType; begin TokenValue := GetNextTokenString; Result := StringToTurboToken(TokenValue); end; function TurboParser.GetPos: Integer; begin Result := FPCPos - PChar(FSource); end; procedure TurboParser.LoadFromFile(const FileName: string); begin SourceString := FileToString(FileName); FSource := PChar(SourceString); FPCPos := PChar(FSource); end; procedure TurboParser.RaiseParserError(const Msg: string; const Args: array of TVarRec); begin raise Exception.CreateFmt(Msg, Args); end; procedure TurboParser.SetPos(Value: Integer); begin FPCPos := PChar(FSource) + Value; end; function TurboParser.TokenAsBoolean: Boolean; begin Result := (StringToTurboToken(TokenValue) = ttTrue); end; function TurboParser.TokenAsChar: Char; begin StringIsChar(TokenValue, Result); end; function TurboParser.TokenAsDouble: Double; begin StringIsDouble(TokenValue, Result); end; function TurboParser.TokenAsInteger: Integer; begin StringIsInteger(TokenValue, Result); end; function TurboParser.TokenAsString: string; begin StringIsString(TokenValue, Result); end; end.

*uTurboParserConst.pas*(* uTurboParserConst -- is part of Turbo project Copyright© Dorin Duminica Usage of this file is permited for comercial and non-comercial programs. NOTE: if you optimize some of the bellow functions please let me know *) unit uTurboParserConst; interface type TurboHash = type Integer; type TurboTokenType = ( ttEndOfFile, ttInternalError, ttUnknown, ttIdentifier, ttApplication, ttConsole, ttLibrary, ttInclude, ttSemicolumn, ttResource, ttIn, ttConst, ttEnum, ttVar, ttClass, ttLB, ttRB, ttLS, ttRS, ttPoint, ttFunction, ttBegin, ttEnd, ttReturn, ttInitialization, ttFinalization, ttIf, ttElse, ttWhile, ttDo, ttSwitch, ttColumn, ttDefault, ttTry, ttExcept, ttFinally, ttLabel, ttGoTo, ttFactorial, ttNot, ttPower, ttAnd, ttOr, ttXor, ttShl, ttShr, ttMod, ttIntDiv, ttPercent, ttMul, ttDiv, ttPlus, ttMinus, ttEqual, ttNotEqual, ttGreater, ttLess, ttGreaterOrEqual, ttLessOrEqual, ttAssign, ttAssignMul, ttAssignDiv, ttAssignPlus, ttAssignMinus, ttTrue, ttFalse, ttVInteger, ttVChar, ttVString, ttVDouble ); const szTurboTokenType = sizeof(TurboTokenType); type TurboTokenRec = record TokenType: TurboTokenType; Value: string; Hash: TurboHash; end; const CTURBO_KEYWORD_COUNT = 61; // this is a map of all available tokens in Turbo initializaed with // hash = 0, because in the initialization section of unit // each token will be hashed var TurboTokens: array[0..CTURBO_KEYWORD_COUNT -1] of TurboTokenRec = ( (TokenType: ttApplication ; Value: 'application'; Hash: 0), (TokenType: ttConsole ; Value: 'console'; Hash: 0), (TokenType: ttLibrary ; Value: 'Library'; Hash: 0), (TokenType: ttInclude ; Value: 'include'; Hash: 0), (TokenType: ttSemicolumn ; Value: ';'; Hash: 0), (TokenType: ttResource ; Value: 'resource'; Hash: 0), (TokenType: ttIn ; Value: 'in'; Hash: 0), (TokenType: ttConst ; Value: 'const'; Hash: 0), (TokenType: ttEnum ; Value: 'enum'; Hash: 0), (TokenType: ttVar ; Value: 'var'; Hash: 0), (TokenType: ttClass ; Value: 'class'; Hash: 0), (TokenType: ttLB ; Value: '('; Hash: 0), (TokenType: ttRB ; Value: ')'; Hash: 0), (TokenType: ttLS ; Value: '['; Hash: 0), (TokenType: ttRS ; Value: ']'; Hash: 0), (TokenType: ttPoint ; Value: '.'; Hash: 0), (TokenType: ttFunction ; Value: 'function'; Hash: 0), (TokenType: ttBegin ; Value: '{'; Hash: 0), (TokenType: ttEnd ; Value: '}'; Hash: 0), (TokenType: ttReturn ; Value: 'return'; Hash: 0), (TokenType: ttInitialization ; Value: 'initialization'; Hash: 0), (TokenType: ttFinalization ; Value: 'finalization'; Hash: 0), (TokenType: ttIf ; Value: 'if'; Hash: 0), (TokenType: ttElse ; Value: 'else'; Hash: 0), (TokenType: ttWhile ; Value: 'while'; Hash: 0), (TokenType: ttDo ; Value: 'do'; Hash: 0), (TokenType: ttSwitch ; Value: 'switch'; Hash: 0), (TokenType: ttColumn ; Value: ':'; Hash: 0), (TokenType: ttDefault ; Value: 'default'; Hash: 0), (TokenType: ttTry ; Value: 'try'; Hash: 0), (TokenType: ttExcept ; Value: 'except'; Hash: 0), (TokenType: ttFinally ; Value: 'finally'; Hash: 0), (TokenType: ttLabel ; Value: 'label'; Hash: 0), (TokenType: ttGoTo ; Value: 'goto'; Hash: 0), (TokenType: ttFactorial ; Value: '!'; Hash: 0), (TokenType: ttNot ; Value: 'not'; Hash: 0), (TokenType: ttAnd ; Value: 'and'; Hash: 0), (TokenType: ttOr ; Value: 'or'; Hash: 0), (TokenType: ttXor ; Value: 'xor'; Hash: 0), (TokenType: ttShl ; Value: 'shl'; Hash: 0), (TokenType: ttShr ; Value: 'shr'; Hash: 0), (TokenType: ttMod ; Value: 'mod'; Hash: 0), (TokenType: ttIntDiv ; Value: 'div'; Hash: 0), (TokenType: ttPercent ; Value: '%'; Hash: 0), (TokenType: ttMul ; Value: '*'; Hash: 0), (TokenType: ttDiv ; Value: '/'; Hash: 0), (TokenType: ttPlus ; Value: '+'; Hash: 0), (TokenType: ttMinus ; Value: '-'; Hash: 0), (TokenType: ttEqual ; Value: '='; Hash: 0), (TokenType: ttNotEqual ; Value: '<>'; Hash: 0), (TokenType: ttGreater ; Value: '>'; Hash: 0), (TokenType: ttLess ; Value: '<'; Hash: 0), (TokenType: ttGreaterOrEqual ; Value: '>='; Hash: 0), (TokenType: ttLessOrEqual ; Value: '<='; Hash: 0), (TokenType: ttAssign ; Value: ':='; Hash: 0), (TokenType: ttAssignMul ; Value: '*='; Hash: 0), (TokenType: ttAssignDiv ; Value: '/='; Hash: 0), (TokenType: ttAssignPlus ; Value: '+='; Hash: 0), (TokenType: ttAssignMinus ; Value: '-='; Hash: 0), (TokenType: ttTrue ; Value: 'true'; Hash: 0), (TokenType: ttFalse ; Value: 'false'; Hash: 0) ); const LowTurboTokens = Low(TurboTokens); HighTurboTokens = High(TurboTokens); const TURBO_UNDERSCORE = ['_']; TURBO_DIGITS = ['0'..'9']; TURBO_DOUBLE_CHARS = TURBO_DIGITS + ['.']; TURBO_A_TO_F = ['A'..'F', 'a'..'f']; TURBO_A_TO_Z = ['A'..'Z', 'a'..'z']; TURBO_HEX = TURBO_DIGITS + TURBO_A_TO_F; TURBO_IDSYMBOLS = TURBO_UNDERSCORE + TURBO_DIGITS + TURBO_A_TO_Z; TURBO_IDFIRSTSYMBOLS = TURBO_UNDERSCORE + TURBO_A_TO_Z; TURBO_CONSTSYMBOLS = TURBO_DIGITS + TURBO_A_TO_F; TURBO_CONSTSYMBOLS10 = TURBO_DIGITS; TURBO_SEPARATORS = ['(', ')', ',', '.', ';']; TURBO_CR = #$D; TURBO_LF = #$A; TURBO_TAB = #9; TURBO_NULL = #0; TURBO_SPACE = ' '; TURBO_CRLF = TURBO_CR + TURBO_LF; TURBO_LF_CR_TAB = [TURBO_LF, TURBO_CR, TURBO_TAB]; TURBO_SPACE_LF_CR_TAB = [TURBO_SPACE, TURBO_LF, TURBO_CR, TURBO_TAB]; TURBO_LF_CR_NULL = [TURBO_LF, TURBO_CR, TURBO_NULL]; resourcestring SBadRemark = 'Bad remark at position: %d'; implementation uses uTurboUtils; procedure HashTokens; var i : integer; s : string; begin for i := LowTurboTokens to HighTurboTokens do begin s := TurboTokens[i].Value; TurboTokens[i].Hash := TurboHashString(s); end;// for i := LowTurboTokens to HighTurboTokens do begin end; initialization HashTokens; end.

*uTurboUtils.pas*(* uTurboUtils -- is part of Turbo project Copyright© Dorin Duminica Usage of this file is permited for comercial and non-comercial programs. NOTE: if you optimize some of the bellow functions please let me know *) unit uTurboUtils; interface uses SysUtils, uTurboParserConst; function TurboHashString(const s: string): TurboHash; function FileToString(const FileName: string): string; function FileToStringA(const FileName: string): AnsiString; function FileToStringU(const FileName: string): string; function TurboTokenToString(thisToken: TurboTokenType): string; function StringToTurboToken(const s: string): TurboTokenType; function StringIsHex(const s: string): Boolean; overload; function StringIsHex(const s: string; var Value: Integer): Boolean; overload; function StringIsChar(const s: string): Boolean; overload; function StringIsChar(const s: string; var Value: Char): Boolean; overload; function StringIsString(const s: string): Boolean; overload; function StringIsString(const s: string; var Value: string): Boolean; overload; function StringIsInteger(const s: string): Boolean; overload; function StringIsInteger(const s: string; var Value: Integer): Boolean; overload; function StringIsDouble(const s: string): Boolean; overload; function StringIsDouble(const s: string; var Value: Double): Boolean; overload; function IsFileUnicode(const FileName: string): Boolean; function IsFileUTF8(const FileName: string): Boolean; implementation uses Classes, Windows; function TurboHashString(const s: string): TurboHash; var i : integer; c : Char; begin Result := 0; for i := 1 to Length(s) do begin c := s[i]; c := UpCase(c); Result := ((Result shl 7) or (Result shr 25)) + Ord(c); end;// for i := 1 to Length(s) do begin end; function FileToString(const FileName: string): string; begin Result := EmptyStr; if not FileExists(FileName) then Exit; if IsFileUnicode(FileName) or IsFileUTF8(FileName) then Result := FileToStringU(FileName) else Result := String(FileToStringA(FileName)); end; function FileToStringA(const FileName: string): AnsiString; var FileStream : TFileStream; begin Result := AnsiString(EmptyStr); if not FileExists(FileName) then Exit; FileStream := TFileStream.Create(FileName, fmOpenRead); SetLength(Result, FileStream.Size); FileStream.Read(Pointer(Result)^, FileStream.Size); FreeAndNil(FileStream); end; function FileToStringU(const FileName: string): string; var FileStream : TFileStream; begin Result := EmptyStr; if not FileExists(FileName) then Exit; FileStream := TFileStream.Create(FileName, fmOpenRead); SetLength(Result, FileStream.Size); FileStream.Read(Pointer(Result)^, FileStream.Size); FreeAndNil(FileStream); end; function TurboTokenToString(thisToken: TurboTokenType): string; var i : integer; begin Result := EmptyStr; for i := LowTurboTokens to HighTurboTokens do if TurboTokens[i].TokenType = thisToken then begin Result := TurboTokens[i].Value; Exit; end;// if TurboTokens[i].TokenType = thisToken then begin end; function StringToTurboToken(const s: string): TurboTokenType; var i : integer; h : TurboHash; begin if s = EmptyStr then begin Result := ttEndOfFile; Exit; end;// if s = EmptyStr then begin Result := ttUnknown; h := TurboHashString(s); for i := LowTurboTokens to HighTurboTokens do if TurboTokens[i].Hash = h then begin Result := TurboTokens[i].TokenType; Exit; end;// if TurboTokens[i].Hash = h then begin if StringIsHex(s) or StringIsInteger(s) then begin Result := ttVInteger; Exit; end;// if StringIsHex(s) or StringIsInteger(s) then begin if StringIsString(s) then begin Result := ttVString; Exit; end;// if StringIsString(s) then begin if StringIsChar(s) then begin Result := ttVChar; Exit; end;// if StringIsChar(s) then begin if StringIsDouble(s) then begin Result := ttVDouble; Exit; end;// if StringIsDouble(s) then begin end; function StringIsHex(const s: string): Boolean; var i : integer; begin Result := False; if Length(s) > 1 then begin if s[1] = '$' then for i := 2 to Length(s) do if not CharInSet(s[i], TURBO_HEX) then Exit; end else Exit; Result := True; end; function StringIsHex(const s: string; var Value: Integer): Boolean; begin Value := 0; Result := StringIsHex(s); if Result then Value := StrToInt(s); end; function StringIsChar(const s: string): Boolean; var c : char; begin Result := StringIsChar(s, c); end; function StringIsChar(const s: string; var Value: Char): Boolean; const CHAR_ORDINAL = '#'; CHAR_HEX = '#$'; var i, p, len : integer; begin Result := True; len := Length(s); p := Pos(CHAR_HEX, s); if p = 1 then begin // in this case we have something like #$HEX_VALUE // check if remaining chars are hex for i := 3 to Len do if not CharInSet(s[i], TURBO_HEX) then Exit; Value := Char(StrToInt(Copy(s, 2, Length(s) -1))); Exit; end else begin // in this case we have something like #ORDINAL_VALUE // check if remaining chars are digits for i := 2 to Len do if not CharInSet(s[i], TURBO_DIGITS) then Exit; p := Pos(CHAR_ORDINAL, s); if p = 1 then begin Value := Char(StrToInt(Copy(s, 2, Length(s) -1))); Exit; end;// if p = 1 then begin end;// if p = 1 then begin Result := False; end; function StringIsString(const s: string): Boolean; begin Result := (Length(s) >= 2) and ((s[1] = '"') and (s[Length(s)] = '"')); end; function StringIsString(const s: string; var Value: string): Boolean; begin Result := StringIsString(s); if Result then Value := Copy(s, 2, Length(s) -1); end; function StringIsInteger(const s: string): Boolean; var i : integer; begin Result := False; for i := 1 to Length(s) do if not CharInSet(s[i], TURBO_DIGITS) then Exit; Result := True; end; function StringIsInteger(const s: string; var Value: Integer): Boolean; begin Result := StringIsInteger(s); if Result then Value := StrToInt(s); end; function StringIsDouble(const s: string): Boolean; var d : Double; begin Result := StringIsDouble(s, d); end; function StringIsDouble(const s: string; var Value: Double): Boolean; var i, PointCount : integer; begin Result := False; PointCount := 0; for i := 1 to Length(s) do case s[i] of '.': Inc(PointCount); '0'..'9': ; else Exit; end;// case s[i] of if PointCount <= 1 then begin Value := StrToFloat(s); Result := True; Exit; end;// if PointCount <= 1 then begin end; function IsFileUnicode(const FileName: string): Boolean; var hFile : THandle; Buffer: Word; BytesRead: DWORD; begin Result := False; hFile := FileOpen(FileName, FILE_SHARE_READ); if hFile <> INVALID_HANDLE_VALUE then try Buffer := 0; SetFilePointer(hFile, 0, nil, FILE_BEGIN); Result := ReadFile(hFile, Buffer, SizeOf(Buffer), BytesRead, nil) and (BytesRead>=SizeOf(Buffer)) and ((Buffer=$FEFF) or (Buffer=$FFFE)); finally CloseHandle(hFile); end;// try... end; function IsFileUTF8(const FileName: string): Boolean; var hFile : THandle; Buffer: packed array[0..2] of byte; BytesRead: DWORD; begin Result := False; hFile := FileOpen(FileName, FILE_SHARE_READ); if hFile <> INVALID_HANDLE_VALUE then try FillChar(Buffer, SizeOf(Buffer), 0); SetFilePointer(hFile, 0, nil, FILE_BEGIN); Result := ReadFile(hFile, Buffer, SizeOf(Buffer), BytesRead, nil) and (BytesRead>=SizeOf(Buffer)) and ((Buffer[0]=$EF) and (Buffer[1]=$BB) and (Buffer[2]=$BF)); finally CloseHandle(hFile); end; end; end.

Turbo roadmap[X] complete grammar [X] dynamic parser which can be easily extended in the future [-] expression evaluator [-] compiler [-] first program(GUI and console) [-] Turbo IDE(which can be extended using Turbo)- medium Delphi knowledge - the will to learn new thingsNote that anyone can join the project if he/she has:

## No comments:

## Post a Comment