1 unit PreProcessorExpressionTokenise;
2
3 {(*}
4 (*------------------------------------------------------------------------------
5 Delphi Code formatter source code
6
7 The Original Code is PreProcessorExpressionTokenise, released August 2003.
8 The Initial Developer of the Original Code is Anthony Steele.
9 Portions created by Anthony Steele are Copyright (C) 2003 Anthony Steele.
10 All Rights Reserved.
11 Contributor(s): Anthony Steele.
12
13 The contents of this file are subject to the Mozilla Public License Version 1.1
14 (the "License"). you may not use this file except in compliance with the License.
15 You may obtain a copy of the License at http://www.mozilla.org/NPL/
16
17 Software distributed under the License is distributed on an "AS IS" basis,
18 WITHOUT WARRANTY OF ANY KIND, either express or implied.
19 See the License for the specific language governing rights and limitations
20 under the License.
21
22 Alternatively, the contents of this file may be used under the terms of
23 the GNU General Public License Version 2 or later (the "GPL")
24 See http://www.gnu.org/licenses/gpl.html
25 ------------------------------------------------------------------------------*)
26 {*)}
27
28 {$I JcfGlobal.inc}
29
30 interface
31
32 {
33 AFS 26 Aug 2003
34
35 lexer for preprocessor $IF expressions
36 Turns text into a list of tokens
37 The tokens are defined in PreProcessorTokens
38 Whitespace is discarded
39 }
40 uses PreProcessorExpressionTokens;
41
42 type
43 TPreProcessorExpressionTokeniser = class
44 private
45 fsExpr: String;
46 fiCurrentIndex: integer;
47 fbHasError: boolean;
48
49 fcTokens: TPreProcessorExpressionTokenList;
50
Restnull51 function Rest: string;
StartsWithnull52 function StartsWith(const ps: string): boolean;
53
TryConsumeFixedSymbolnull54 function TryConsumeFixedSymbol: boolean;
TryConsumeIdentifiernull55 function TryConsumeIdentifier: boolean;
56 procedure ConsumeWhiteSpace;
57
58 public
59 constructor Create;
60 destructor Destroy; override;
61
62 procedure Tokenise;
63
64 property Expression: String Read fsExpr Write fsExpr;
65 property Tokens: TPreProcessorExpressionTokenList Read fcTokens;
66 property HasError: boolean Read fbHasError;
67 end;
68
69 implementation
70
71 uses
72 { delphi }
73 {$IFNDEF FPC}Windows,{$ENDIF} SysUtils,
74 { local }
75 JcfStringUtils;
76
77
78 constructor TPreProcessorExpressionTokeniser.Create;
79 begin
80 inherited;
81 fcTokens := TPreProcessorExpressionTokenList.Create;
82 end;
83
84 destructor TPreProcessorExpressionTokeniser.Destroy;
85 begin
86 FreeAndNil(fcTokens);
87 inherited;
88 end;
89
Restnull90 function TPreProcessorExpressionTokeniser.Rest: string;
91 begin
92 Result := string(StrRestOf(fsExpr, fiCurrentIndex));
93 end;
94
TPreProcessorExpressionTokeniser.StartsWithnull95 function TPreProcessorExpressionTokeniser.StartsWith(const ps: string): boolean;
96 begin
97 Result := AnsiSameText(StrLeft(Rest, Length(ps)), ps);
98 end;
99
100 procedure TPreProcessorExpressionTokeniser.Tokenise;
101 begin
102 fcTokens.Clear;
103 fiCurrentIndex := 1;
104 fbHasError := False;
105
106 while fiCurrentIndex <= Length(fsExpr) do
107 begin
108 if not TryConsumeFixedSymbol then
109 if not TryConsumeIdentifier then
110 begin
111 // unknown/unsupported Syntax. :(
112 fbHasError := True;
113 break;
114 end;
115
116 ConsumeWhiteSpace;
117 end;
118
119 end;
120
TryConsumeFixedSymbolnull121 function TPreProcessorExpressionTokeniser.TryConsumeFixedSymbol: boolean;
122 var
123 leLoop: TPreProcessorSymbol;
124 lbFound: boolean;
125 begin
126 Result := False;
127
128 for leLoop := low(SYMBOL_DATA) to high(SYMBOL_DATA) do
129 begin
130 lbFound := StartsWith(SYMBOL_DATA[leLoop]);
131
132 if lbFound then
133 begin
134 fcTokens.Add(leLoop, SYMBOL_DATA[leLoop]);
135
136 fiCurrentIndex := fiCurrentIndex + Length(SYMBOL_DATA[leLoop]);
137 Result := True;
138 break;
139 end;
140 end;
141 end;
142
143
TPreProcessorExpressionTokeniser.TryConsumeIdentifiernull144 function TPreProcessorExpressionTokeniser.TryConsumeIdentifier: boolean;
145 var
146 liStart: integer;
147 lsIdentifierText: string;
148 begin
149 Result := False;
150
151 if CharIsAlpha(fsExpr[fiCurrentIndex]) then
152 begin
153 liStart := fiCurrentIndex;
154 while CharIsAlphaNum(fsExpr[fiCurrentIndex]) do
155 Inc(fiCurrentIndex);
156
157 Result := True;
158
159 lsIdentifierText := string(copy(fsExpr, liStart, fiCurrentIndex - liStart));
160 fcTokens.Add(eIdentifier, lsIdentifierText);
161 end;
162 end;
163
164
165 procedure TPreProcessorExpressionTokeniser.ConsumeWhiteSpace;
166 begin
167 // this lexer can ignore the white space
168 while (fiCurrentIndex < Length(fsExpr)) and CharIsWhiteSpace(fsExpr[fiCurrentIndex]) do
169 Inc(fiCurrentIndex);
170 end;
171
172 end.
173