source: cprs/branches/HealthSevak-CPRS/VA/HRParser.pas@ 1689

Last change on this file since 1689 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27

File size: 7.6 KB
Line 
1// HRParser v1.0.1 (25.Sep.2000)
2// Simple and fast parser classes.
3// by Colin A Ridgewell
4//
5// Copyright (C) 1999,2000 Hayden-R Ltd
6// http://www.haydenr.com
7//
8// This program is free software; you can redistribute it and/or modify it
9// under the terms of the GNU General Public License as published by the
10// Free Software Foundation; either version 2 of the License, or (at your
11// option) any later version.
12//
13// This program is distributed in the hope that it will be useful, but
14// WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15// or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
16// more details.
17//
18// You should have received a copy of the GNU General Public License along
19// with this program (gnu_license.htm); if not, write to the
20//
21// Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22//
23// To contact us via e-mail use the following addresses...
24//
25// bug@haydenr.u-net.com - to report a bug
26// support@haydenr.u-net.com - for general support
27// wishlist@haydenr.u-net.com - add new requirement to wish list
28//
29unit HRParser;
30
31interface
32
33uses
34 Classes, SysUtils, HRBuffers;
35
36type
37 THRTokenType = Byte;
38
39const
40 HR_PARSER_STREAM_BUFFER_SIZE = 2048; {bytes}
41 HR_PARSER_TOKEN_BUFFER_SIZE = 1024; {bytes}
42
43 {THRParser tokens}
44 HR_TOKEN_NIL = 0;
45 HR_TOKEN_EOF = 1;
46 HR_TOKEN_CHAR = 2;
47
48 {THRParserText tokens}
49 HR_TOKEN_TEXT_SPACE = 3;
50 HR_TOKEN_TEXT_SYMBOL = 4;
51 HR_TOKEN_TEXT_INTEGER = 5;
52 HR_TOKEN_TEXT_FLOAT = 6;
53
54type
55 THRToken = record
56 Token: PChar;
57 TokenType: THRTokenType;
58 SourcePos: Longint;
59 Line: Longint;
60 LinePos: Integer;
61 end;
62
63 THRParser = class( TObject )
64 private
65 function GetSource: TStream;
66 procedure SetSource(Value: TStream);
67 procedure SetSourcePos(Value: LongInt);
68 protected
69 FSourceBuf: THRBufferStream;
70 FSourcePos: LongInt;
71 FLine: Longint;
72 FLineStartSourcePos: Longint;
73 FTokenBuf: THRBufferChar;
74 FToken: THRToken;
75 procedure IncLine;
76 procedure SkipToSourcePos(const Pos: Longint);
77 procedure SkipBlanks;
78 procedure GetNextToken; virtual;
79 public
80 constructor Create; virtual;
81 destructor Destroy; override;
82 property Source: TStream read GetSource write SetSource;
83 property SourcePos: Longint read FSourcePos write SetSourcePos;
84 property Token: THRToken read FToken;
85 function NextToken: THRToken;
86 end;
87
88 THRParserText = class( THRParser )
89 private
90 protected
91 procedure GetNextToken; override;
92 public
93 constructor Create; override;
94 destructor Destroy; override;
95 end;
96
97implementation
98
99
100{ T H R P a r s e r }
101
102constructor THRParser.Create;
103begin
104 FSourceBuf := THRBufferStream.Create;
105 FSourceBuf.Size := HR_PARSER_STREAM_BUFFER_SIZE;
106 FTokenBuf := THRBufferChar.Create;
107 FTokenBuf.Size := HR_PARSER_TOKEN_BUFFER_SIZE;
108 FSourcePos := 0;
109end;
110
111
112destructor THRParser.Destroy;
113begin
114 FTokenBuf.Free;
115 FTokenBuf := nil;
116 FSourceBuf.Free;
117 FSourceBuf := nil;
118 inherited Destroy;
119end;
120
121
122function THRParser.GetSource: TStream;
123begin
124 Result := FSourceBuf.Stream;
125end;
126
127
128procedure THRParser.SetSource(Value: TStream);
129begin
130 FSourceBuf.Stream := Value;
131end;
132
133
134procedure THRParser.SetSourcePos(Value: LongInt);
135begin
136 SkipToSourcePos( Value );
137end;
138
139
140procedure THRParser.IncLine;
141begin
142 Inc( FLine );
143 FLineStartSourcePos := FSourcePos;
144end;
145
146
147procedure THRParser.SkipToSourcePos(const Pos: Longint);
148begin
149 FSourcePos := 0;
150 FLine := 0;
151 FLineStartSourcePos := 0;
152 FSourceBuf[ FSourcePos ];
153 while not FSourceBuf.EOB and ( FSourcePos < Pos ) do
154 begin
155 if FSourceBuf[ FSourcePos ] = #10 then IncLine;
156 Inc( FSourcePos );
157 FSourceBuf[ FSourcePos ];
158 end;
159end;
160
161
162procedure THRParser.SkipBlanks;
163begin
164 FSourceBuf[ FSourcePos ];
165 while not FSourceBuf.EOB do
166 begin
167 case FSourceBuf[ FSourcePos ] of
168 #32..#255 : Exit;
169 #10 : IncLine;
170 end;
171 Inc( FSourcePos );
172 FSourceBuf[ FSourcePos ];
173 end;
174end;
175
176
177procedure THRParser.GetNextToken;
178begin
179 FSourceBuf[ FSourcePos ];
180 if not FSourceBuf.EOB then
181 begin
182 {single char}
183 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
184 Inc( FSourcePos );
185 FToken.TokenType := HR_TOKEN_CHAR;
186 end
187 else
188 begin
189 {end of buffer}
190 FToken.TokenType := HR_TOKEN_EOF;
191 end;
192end;
193
194
195
196function THRParser.NextToken: THRToken;
197begin
198 FTokenBuf.Position := 0;
199
200 SkipBlanks;
201
202 {store start pos of token}
203 with FToken do
204 begin
205 SourcePos := FSourcePos;
206 Line := FLine;
207 LinePos := FSourcePos - FLineStartSourcePos;
208 end;
209
210 GetNextToken;
211
212 FTokenBuf.Write( #0 ); {null terminate.}
213 FToken.Token := FTokenBuf.Buffer;
214 Result := FToken;
215end;
216
217
218{ T H R P a r s e r T e x t }
219
220constructor THRParserText.Create;
221begin
222 inherited Create;
223end;
224
225
226destructor THRParserText.Destroy;
227begin
228 inherited Destroy;
229end;
230
231
232procedure THRParserText.GetNextToken;
233begin
234 repeat
235
236 {spaces}
237 if FSourceBuf[ FSourcePos ] = ' ' then
238 begin
239 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
240 Inc( FSourcePos );
241 while FSourceBuf[ FSourcePos ] = ' ' do
242 begin
243 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
244 Inc( FSourcePos );
245 end;
246 FToken.TokenType := HR_TOKEN_TEXT_SPACE;
247 Break;{out of repeat}
248 end;
249
250 {symbols}
251 if FSourceBuf[ FSourcePos ] in [ 'A'..'Z', 'a'..'z', '_' ] then
252 begin
253 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
254 Inc( FSourcePos );
255 while True do
256 begin
257 case FSourceBuf[ FSourcePos ] of
258
259 'A'..'Z', 'a'..'z', '0'..'9', '_' :
260 begin
261 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
262 Inc( FSourcePos );
263 end;
264
265 '''' :
266 begin{apostrophies}
267 if FSourceBuf[ FSourcePos + 1 ] in [ 'A'..'Z', 'a'..'z', '0'..'9', '_' ] then
268 begin
269 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
270 Inc( FSourcePos );
271 end
272 else
273 Break;
274 end;
275
276 '-' :
277 begin{hyphenated words}
278 if FSourceBuf[ FSourcePos + 1 ] in [ 'A'..'Z', 'a'..'z', '0'..'9', '_' ] then
279 begin
280 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
281 Inc( FSourcePos );
282 end
283 else
284 Break;
285 end;
286
287 else
288 Break;
289 end;{case}
290 end;
291 FToken.TokenType := HR_TOKEN_TEXT_SYMBOL;
292 Break;{out of repeat}
293 end;
294
295 {numbers}
296 if ( FSourceBuf[ FSourcePos ] in [ '0'..'9' ] ) or
297 ( ( FSourceBuf[ FSourcePos ] = '-' ) and ( FSourceBuf[ FSourcePos + 1 ] in [ '.', '0'..'9' ] ) ) then
298 begin
299
300 {integer numbers}
301 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
302 Inc( FSourcePos );
303 while FSourceBuf[ FSourcePos ] in [ '0'..'9' ] do
304 begin
305 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
306 Inc( FSourcePos );
307 FToken.TokenType := HR_TOKEN_TEXT_INTEGER;
308 end;
309
310 {floating point numbers}
311 while ( FSourceBuf[ FSourcePos ] in [ '0'..'9', 'e', 'E', '+', '-' ] ) or
312 ( ( FSourceBuf[ FSourcePos ] = '.') and ( FSourceBuf[ FSourcePos + 1 ] <> '.' ) ) do
313 begin
314 FTokenBuf.Write( FSourceBuf[ FSourcePos ] );
315 Inc( FSourcePos );
316 FToken.TokenType := HR_TOKEN_TEXT_FLOAT;
317 end;
318
319 Break;{out of repeat}
320 end;
321
322 inherited GetNextToken;
323 {Break;}{out of repeat}
324
325 until( True );
326end;
327
328
329end.
330
Note: See TracBrowser for help on using the repository browser.