1 {-----------------------------------------------------------------------------
2 The contents of this file are subject to the Mozilla Public License Version
3 1.1 (the "License"); you may not use this file except in compliance with the
4 License. You may obtain a copy of the License at
5 http://www.mozilla.org/NPL/NPL-1_1Final.html
6
7 Software distributed under the License is distributed on an "AS IS" basis,
8 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
9 the specific language governing rights and limitations under the License.
10
11 The Original Code is: mwGenericLex.pas, released April, 2001.
12
13 The Initial Developer of the Original Code is Martin Waldenburg
14 (Martin.Waldenburg@T-Online.de).
15 Portions created by Martin Waldenburg are Copyright (C) 2001 Martin Waldenburg.
16 All Rights Reserved.
17
18 Contributor(s): _____________________________________.
19
20
21 Last Modified: mm/dd/yyyy
22 Current Version: 0.9
23
24 Notes: This program is a fast generic scriptable lexical analyser.
25
26 Modification history:
27
28 Known Issues:
29 -----------------------------------------------------------------------------}
30 {$A+,B-,C-,D-,E-,I+,J-,O+,Q-,R-,S-,V-}
31 unit mwGenericLex;
32
33 {$IFDEF FPC}
34 {$MODE DELPHI}
35 {$ENDIF}
36
37 interface
38
39 uses
40 Classes;
41
42 const
43 piAtEnd = High(Word);
44 piZero = High(Word) - 1;
45 piUnknown = High(Word) - 2;
46 piSymbol = 0;
47 piSpace = 1;
48 piLineEnd = 2;
49 piInnerLineEnd = 3;
50 piIdent = 4;
51 piKeyWord = 5;
52 piString = 6;
53 piComment = 7;
54 piNumber = 8;
55 piAssembler = 9;
56 piBadString = 10;
57 piDirective = 11;
58 piChar = 12;
59 piBadChar = 13;
60
61
62
63 type
64 TAny = class;
65 TmwGenLex = class;
66
67 TmwLexInitProc = procedure(Lex: TmwGenLex);
68 TmwLexInitMethod = procedure(Lex: TmwGenLex) of object;
69
70 TmwCharClass = set of Char;
71 PmwChars = ^TmwChars;
72 TmwChars = record
73 Chars: TmwCharClass;
74 end;
75
76 TAnyKind = (
77 pkAny,
78 pkChar,
79 pkCharClass,
80 pkInnerLineEnd,
81 pkKey,
82 pkLineEnd,
83 pkTillChars,
84 pkTillKey
85 );
86
87 TAnyStatus = (
88 psMultiLine,
89 psNegative,
90 psProcessingNeeded,
91 psRegress
92 );
93
94 TAnyStorage = packed record
95 Count: Byte;
96 Kind: TAnyKind;
97 Status: set of TAnyStatus;
98 Min: Byte;
99 Id: Word;
100 ExId: Word;
101 Max: Word;
102 end;
103
104 PmwOptionsList = ^TmwOptionsList;
105 TmwOptionsList = array[0..0] of TAny;
106
107 TAny = class(TPersistent)
108 private
109 fOptionsList: PmwOptionsList;
110 fToRegress: TAny;
111 FKey: string;
112 FFollow: TAny;
GetNodesnull113 function GetNodes(Index: Byte): TAny;
GetMultiLinenull114 function GetMultiLine: Boolean;
GetNegativenull115 function GetNegative: Boolean;
GetProcessingNeedednull116 function GetProcessingNeeded: Boolean;
117 procedure SetMultiLine(const Value: Boolean);
118 procedure SetNegative(const Value: Boolean);
119 procedure SetProcessingNeeded(const Value: Boolean);
120 procedure SetKey(const Value: string);
121 procedure SetCharClass(const Value: TmwCharClass);
GetCharClassnull122 function GetCharClass: TmwCharClass;
GetRegressnull123 function GetRegress: Boolean;
124 procedure SetRegress(const Value: Boolean);
125 protected
126 Storage: TAnyStorage;
127 ToRestore: TAny;
128 public
129 constructor Create(AParent: TAny); virtual;
130 destructor Destroy; override;
AddOptionnull131 function AddOption(const Value: TAny): Integer;
IndexOfnull132 function IndexOf(const Any: TAny): Integer;
133 property CharClass: TmwCharClass read GetCharClass write SetCharClass;
134 property Count: Byte read Storage.Count;
135 property Options[Index: Byte]: TAny read GetNodes; default;
136 property ToRegress: TAny read fToRegress write FToRegress;
137 published
138 property ExId: Word read Storage.ExId write Storage.ExId;
139 property Follow: TAny read FFollow write FFollow;
140 property Id: Word read Storage.Id write Storage.Id;
141 property Max: Word read Storage.Max write Storage.Max;
142 property Min: Byte read Storage.Min write Storage.Min;
143 property Key: string read FKey write SetKey;
144 property Kind: TAnyKind read Storage.Kind write Storage.Kind;
145 property MultiLine: Boolean read GetMultiLine write SetMultiLine;
146 property Negative: Boolean read GetNegative write SetNegative;
147 property ProcessingNeeded: Boolean read GetProcessingNeeded write SetProcessingNeeded;
148 property Regress: Boolean read GetRegress write SetRegress;
149 end;
150
151 TLineEnd = class(TAny)
152 public
153 constructor Create(AParent: TAny); override;
154 end;
155
156 TAlpha = class(TAny)
157 public
158 constructor Create(AParent: TAny); override;
159 end;
160
161 TAlphaNumeric = class(TAny)
162 public
163 constructor Create(AParent: TAny); override;
164 end;
165
166 (*
167 TCharAlpha = class(TAny)
168 public
169 constructor Create(AParent: TAny); override;
170 end;
171
172 TCharAlphaNumeric = class(TAny)
173 public
174 constructor Create(AParent: TAny); override;
175 end;
176
177 TCharLower = class(TAny)
178 public
179 constructor Create(AParent: TAny); override;
180 end;
181
182 TCharUpper = class(TAny)
183 public
184 constructor Create(AParent: TAny); override;
185 end;
186 *)
187
188 TIdentifier = class(TAlpha)
189 public
190 constructor Create(AParent: TAny); override;
191 end;
192
193 TCRLF = class(TAny)
194 public
195 constructor Create(AParent: TAny); override;
196 end;
197
198 TLF = class(TAny)
199 public
200 constructor Create(AParent: TAny); override;
201 end;
202
203 TNotZero = class(TAny)
204 public
205 constructor Create(AParent: TAny); override;
206 end;
207
208 TNumeric = class(TAny)
209 public
210 constructor Create(AParent: TAny); override;
211 end;
212
213 TTill = class(TAny)
214 public
215 constructor Create(AParent: TAny); override;
216 end;
217
218 TTillChars = class(TAny)
219 public
220 constructor Create(AParent: TAny); override;
221 end;
222
223 TTillLineEnd = class(TAny)
224 public
225 constructor Create(AParent: TAny); override;
226 end;
227
228 TZero = class(TAny)
229 public
230 constructor Create(AParent: TAny); override;
231 end;
232
233 TmwGenLex = class(TPersistent)
234 private
235 FChain: TList;
236 FCurrent: TAny;
237 FSensitive: Boolean;
238 FInitMethod: TmwLexInitMethod;
239 FInitProc: TmwLexInitProc;
240 FRange: TAny;
241 FOrigin: PChar;
242 FProcessingNeeded: Boolean;
ApplyAnynull243 function ApplyAny: Boolean;
ApplyCharnull244 function ApplyChar: Boolean;
ApplyCharClassnull245 function ApplyCharClass: Boolean;
ApplyInnerLineEndnull246 function ApplyInnerLineEnd: Boolean;
ApplyKeynull247 function ApplyKey: Boolean;
ApplyLineEndnull248 function ApplyLineEnd: Boolean;
ApplyTillCharsnull249 function ApplyTillChars: Boolean;
ApplyTillKeynull250 function ApplyTillKey: Boolean;
GetTokennull251 function GetToken: string;
252 procedure SetInitMethod(const Value: TmwLexInitMethod);
253 procedure SetInitProc(const Value: TmwLexInitProc);
254 procedure SetInput(const Value: string);
255 procedure SetOrigin(const Value: PChar);
GetRunPosnull256 function GetRunPos: Integer;
257 procedure SetRunPos(const Value: Integer);
GetEndPosnull258 function GetEndPos: Integer;
259 procedure SetEndPos(const Value: Integer);
SubNextnull260 function SubNext: Boolean;
GetLinePosnull261 function GetLinePos: Integer;
262 protected
263 fLineCount : Longint;
264 FExId: Word;
265 FId: Word;
266 Run: PChar;
267 Start: PChar;
268 TheEnd: PChar;
269 InnerLineEnd: TAny;
270 MainSelector: array[#0..#255] of TAny;
Booleannull271 Selector: array[Low(TAnyKind)..High(TAnyKind)] of function: Boolean of object;
272 procedure AddToMainSelector(Pattern: TAny);
273 procedure Clear;
Executenull274 function Execute: Boolean;
275 procedure InitMainSelector;
276 procedure InitSelector;
277 property Current: TAny read FCurrent write FCurrent;
278 property Chain: TList read FChain write FChain;
279 public
280 constructor Create;
281 destructor Destroy; override;
282 procedure Add(Pattern: TAny);
AtEndnull283 function AtEnd: Boolean;
284 procedure Next;
285 procedure SetStartData(Ptr: Pointer; aLen: Integer);
286 property EndPos: Integer read GetEndPos write SetEndPos;
287 property Id: Word read FId;
288 property ExId: Word read FExId;
289 property Input: string write SetInput;
290 property Origin: PChar read FOrigin write SetOrigin;
291 property ProcessingNeeded: Boolean read FProcessingNeeded;
292 property Range: TAny read FRange write FRange;
293 property RunPos: Integer read GetRunPos write SetRunPos;
294 property LinePos : Integer read GetLinePos;
295 property Sensitive: Boolean read FSensitive write FSensitive;
296 property Token: string read GetToken;
297 property InitProc: TmwLexInitProc read FInitProc write SetInitProc;
298 property InitMethod: TmwLexInitMethod read FInitMethod write SetInitMethod;
299 end;
300
301 implementation
302
303 uses
304 SysUtils;
305
306 var
307 CompTable: array[#0..#255] of Char;
308
309 procedure InitTables;
310 var
311 I: Char;
312 begin
313 for I := #0 to #255 do
314 CompTable[I] := AnsiUpperCase(I)[1];
315 end;
316
317 { TAny }
318
AddOptionnull319 function TAny.AddOption(const Value: TAny): Integer;
320 begin
321 Result := -1;
322 if Assigned(Value) then
323 begin
324 Result := Storage.Count;
325 inc(Storage.Count);
326 ReallocMem(fOptionsList, Storage.Count * SizeOf(TAny));
327 fOptionsList^[Result] := Value;
328 end;
329 end;
330
331 constructor TAny.Create(AParent: TAny);
332 begin
333 inherited Create;
334 if Assigned(AParent) then AParent.Follow := Self;
335 end;
336
337 destructor TAny.Destroy;
338 var
339 I: Integer;
340 begin
341 if Assigned(Follow) then Follow.Free;
342 for I := 0 to Storage.Count - 1 do
343 fOptionsList^[I].Free;
344 ReallocMem(fOptionsList, 0);
345 inherited Destroy;
346 end;
347
GetItnull348 function GetIt(const C): TmwCharClass;
349 begin
350 Result := TmwCharClass(C);
351 end;
352
TAny.GetCharClassnull353 function TAny.GetCharClass: TmwCharClass;
354 begin
355 Result := PmwChars(FKey).Chars;
356 end;
357
GetMultiLinenull358 function TAny.GetMultiLine: Boolean;
359 begin
360 Result := psMultiLine in Storage.Status;
361 end;
362
GetNegativenull363 function TAny.GetNegative: Boolean;
364 begin
365 Result := psNegative in Storage.Status;
366 end;
367
GetNodesnull368 function TAny.GetNodes(Index: Byte): TAny;
369 begin
370 Result := nil;
371 if Index < Storage.Count then Result := fOptionsList^[Index];
372 end;
373
GetProcessingNeedednull374 function TAny.GetProcessingNeeded: Boolean;
375 begin
376 Result := psProcessingNeeded in Storage.Status;
377 end;
378
TAny.GetRegressnull379 function TAny.GetRegress: Boolean;
380 begin
381 Result := psRegress in Storage.Status;
382 end;
383
IndexOfnull384 function TAny.IndexOf(const Any: TAny): Integer;
385 var
386 I: Integer;
387 begin
388 Result := -1;
389 for I := 0 to Count - 1 do
390 if FOptionsList[I] = Any then
391 begin
392 Result := I;
393 break;
394 end;
395 end;
396
397 procedure TAny.SetCharClass(const Value: TmwCharClass);
398 begin
399 SetLength(FKey, 32);
400 PmwChars(FKey).Chars := Value;
401 Storage.Kind := pkCharClass;
402 end;
403
404 procedure TAny.SetKey(const Value: string);
405 begin
406 FKey := Value;
407 case Storage.Kind of
408 pkTillChars: ;
409 else
410 if Length(Value) > 1 then
411 Storage.Kind := pkKey
412 else
413 if Length(Value) = 1 then
414 Storage.Kind := pkChar
415 else
416 Storage.Kind := pkAny;
417 end;
418 end;
419
420 procedure TAny.SetMultiLine(const Value: Boolean);
421 begin
422 case Value of
423 True: Include(Storage.Status, psMultiLine);
424 False: Exclude(Storage.Status, psMultiLine);
425 end;
426 end;
427
428 procedure TAny.SetNegative(const Value: Boolean);
429 begin
430 case Value of
431 True: Include(Storage.Status, psNegative);
432 False: Exclude(Storage.Status, psNegative);
433 end;
434 end;
435
436 procedure TAny.SetProcessingNeeded(const Value: Boolean);
437 begin
438 case Value of
439 True: Include(Storage.Status, psProcessingNeeded);
440 False: Exclude(Storage.Status, psProcessingNeeded);
441 end;
442 end;
443
444 procedure TAny.SetRegress(const Value: Boolean);
445 begin
446 case Value of
447 True: Include(Storage.Status, psRegress);
448 False: Exclude(Storage.Status, psRegress);
449 end;
450 end;
451
452 { TLineEnd }
453
454 constructor TLineEnd.Create(AParent: TAny);
455 var
456 Pattern, Option: TAny;
457 begin
458 inherited Create(AParent);
459 Key := #13;
460 Max := 1;
461 Option := TAny.Create(nil);
462 Option.Key := #10;
463 Option.Min := 1;
464 AddOption(Option);
465 Pattern := TAny.Create(Self);
466 Pattern.Key := #10;
467 Pattern.Max := 1;
468 end;
469
470 { TCRLF }
471
472 constructor TCRLF.Create(AParent: TAny);
473 begin
474 inherited Create(AParent);
475 Key := #13#10;
476 Min := 1;
477 Max := 1;
478 end;
479
480 { TLF }
481
482 constructor TLF.Create(AParent: TAny);
483 begin
484 inherited Create(AParent);
485 Key := #10;
486 Min := 1;
487 Max := 1;
488 end;
489
490 { TNotZero }
491
492 constructor TNotZero.Create(AParent: TAny);
493 begin
494 inherited Create(AParent);
495 Storage.Kind := pkCharClass;
496 CharClass := [#0];
497 Negative := True;
498 end;
499
500 { TTill }
501
502 constructor TTill.Create(AParent: TAny);
503 begin
504 inherited Create(AParent);
505 Storage.Kind := pkTillKey;
506 end;
507
508 { TTillChars }
509
510 constructor TTillChars.Create(AParent: TAny);
511 begin
512 inherited Create(AParent);
513 Storage.Kind := pkTillChars;
514 end;
515
516 { TTillLineEnd }
517
518 constructor TTillLineEnd.Create(AParent: TAny);
519 begin
520 inherited Create(AParent);
521 Storage.Kind := pkTillChars;
522 CharClass := [#10, #13];
523 Negative := True;
524 end;
525
526 { TZero }
527
528 constructor TZero.Create(AParent: TAny);
529 begin
530 inherited Create(AParent);
531 Key := #0;
532 Id := piZero;
533 end;
534
535 { TAlpha }
536
537 constructor TAlpha.Create(AParent: TAny);
538 begin
539 inherited Create(AParent);
540 Min := 1;
541 Id := piIdent;
542 Storage.Kind := pkCharClass;
543 CharClass := ['_', 'A'..'Z', 'a'..'z'];
544 end;
545
546 { TAlphaNumeric }
547
548 constructor TAlphaNumeric.Create(AParent: TAny);
549 begin
550 inherited Create(AParent);
551 Min := 1;
552 Id := piIdent;
553 Storage.Kind := pkCharClass;
554 CharClass := ['_', '0'..'9', 'A'..'Z', 'a'..'z'];
555 end;
556
557 { TNumeric }
558
559 constructor TNumeric.Create(AParent: TAny);
560 begin
561 inherited Create(AParent);
562 Min := 1;
563 Storage.Kind := pkCharClass;
564 CharClass := ['0'..'9'];
565 end;
566
567 { TIdentifier }
568
569 constructor TIdentifier.Create(AParent: TAny);
570 begin
571 inherited Create(AParent);
572 TAlphaNumeric.Create(Self);
573 end;
574
575 (*
576 { TCharAlpha }
577
578 constructor TCharAlpha.Create(AParent: TAny);
579 var
580 I: Char;
581 begin
582 inherited Create(AParent);
583 Storage.Kind := pkCharClass;
584 SetLength(FKey, 32);
585 for I := #0 to #255 do
586 if IsCharAlpha(I) then Include(PmwChars(FKey).Chars, I);
587 end;
588
589 { TCharAlphaNumeric }
590
591 constructor TCharAlphaNumeric.Create(AParent: TAny);
592 var
593 I: Char;
594 begin
595 inherited Create(AParent);
596 Storage.Kind := pkCharClass;
597 SetLength(FKey, 32);
598 for I := #0 to #255 do
599 if IsCharAlphaNumeric(I) then Include(PmwChars(FKey).Chars, I);
600 end;
601
602 { TCharLower }
603
604 constructor TCharLower.Create(AParent: TAny);
605 var
606 I: Char;
607 begin
608 inherited Create(AParent);
609 Storage.Kind := pkCharClass;
610 SetLength(FKey, 32);
611 for I := #0 to #255 do
612 if IsCharLower(I) then Include(PmwChars(FKey).Chars, I);
613 end;
614
615 { TCharUpper }
616
617 constructor TCharUpper.Create(AParent: TAny);
618 var
619 I: Char;
620 begin
621 inherited Create(AParent);
622 Storage.Kind := pkCharClass;
623 SetLength(FKey, 32);
624 for I := #0 to #255 do
625 if IsCharUpper(I) then Include(PmwChars(FKey).Chars, I);
626 end;
627 *)
628
629 { TmwGenLex }
630
631 procedure TmwGenLex.Add(Pattern: TAny);
632 var
633 I: Integer;
634 begin
635 FChain.Add(Pattern);
636 AddToMainSelector(Pattern);
637 for I := 0 to Pattern.Count - 1 do
638 AddToMainSelector(Pattern[Byte(I)]);
639 end;
640
641 procedure TmwGenLex.AddToMainSelector(Pattern: TAny);
642 var
643 I: Char;
644 begin
645 case Pattern.Kind of
646 pkAny, pkTillChars, pkTillKey:
647 raise exception.Create('pkAny, pkTillChars, pkTillKey not allowed here');
648 pkCharClass:
649 for I := #0 to #255 do
650 case Pattern.Negative of
651 True:
652 if not (I in Pattern.CharClass) then
653 MainSelector[Char(I)] := Pattern;
654 False:
655 if I in Pattern.CharClass then
656 MainSelector[I] := Pattern;
657 end;
658 pkLineEnd:
659 begin
660 MainSelector[#10] := Pattern;
661 MainSelector[#13] := Pattern;
662 end;
663 else
664 if Length(Pattern.Key) > 0 then
665 MainSelector[Pattern.Key[1]] := Pattern;
666 end;
667 end;
668
ApplyAnynull669 function TmwGenLex.ApplyAny: Boolean;
670 begin
671 Range := nil;
672 Result := True;
673 if Run >= TheEnd then
674 begin
675 Result := False;
676 exit;
677 end;
678 inc(Run);
679 end;
680
TmwGenLex.ApplyCharnull681 function TmwGenLex.ApplyChar: Boolean;
682 var
683 Temp: PChar;
684 begin
685 Range := nil;
686 Temp := Run;
687 case psNegative in Current.Storage.Status of
688 True:
689 case Sensitive of
690 True: if Current.Key <> Run^ then
691 begin
692 if Run >= TheEnd then
693 begin
694 Result := False;
695 exit;
696 end;
697 inc(Run)
698 end;
699 False: if CompTable[Current.Key[1]] <> CompTable[Run^] then
700 begin
701 if Run >= TheEnd then
702 begin
703 Result := False;
704 exit;
705 end;
706 inc(Run)
707 end;
708 end;
709 False:
710 case Sensitive of
711 True: if Current.Key = Run^ then
712 begin
713 if Run >= TheEnd then
714 begin
715 Result := False;
716 exit;
717 end;
718 inc(Run)
719 end;
720 False: if CompTable[Current.Key[1]] = CompTable[Run^] then
721 begin
722 if Run >= TheEnd then
723 begin
724 Result := False;
725 exit;
726 end;
727 inc(Run)
728 end;
729 end;
730 end;
731 Result := Run - Temp = 1;
732 end;
733
TmwGenLex.ApplyCharClassnull734 function TmwGenLex.ApplyCharClass: Boolean;
735 var
736 Temp: PChar;
737 begin
738 Range := nil;
739 Temp := Run;
740 case psNegative in Current.Storage.Status of
741 True:
742 if Current.Max > 0 then
743 begin
744 if not (Run^ in PmwChars(Current.FKey).Chars) then
745 if not AtEnd then inc(Run)
746 end else
747 while not (Run^ in PmwChars(Current.FKey).Chars) do
748 begin
749 if Run >= TheEnd then break;
750 inc(Run);
751 end;
752 False:
753 if Current.Max > 0 then
754 begin
755 if Run^ in PmwChars(Current.FKey).Chars then
756 if not AtEnd then inc(Run)
757 end else
758 while Run^ in PmwChars(Current.FKey).Chars do
759 begin
760 if Run >= TheEnd then break;
761 inc(Run);
762 end;
763 end;
764 Result := Run > Temp;
765 end;
766
TmwGenLex.ApplyInnerLineEndnull767 function TmwGenLex.ApplyInnerLineEnd: Boolean;
768 begin
769 Result := True;
770 case Run^ of
771 #13:
772 begin
773 inc(Run);
774 if Run < TheEnd then if Run^ = #10 then inc(Run);
775 end;
776 #10: inc(Run);
777 end;
778 if Result then
779 Inc(fLineCount);
780 Range := Current.ToRestore;
781 end;
782
TmwGenLex.ApplyKeynull783 function TmwGenLex.ApplyKey: Boolean;
784 var
785 I: Integer;
786 Temp: PChar;
787 begin
788 Range := nil;
789 Temp := Run;
790 for I := 1 to Length(Current.Key) do
791 begin
792 if Run >= TheEnd then break;
793 case Sensitive of
794 True: if Current.Key[I] = Run^ then inc(Run) else break;
795 False: if CompTable[Current.Key[I]] = CompTable[Run^] then inc(Run) else break;
796 end;
797 end;
798 Result := (Run - Temp) = Length(Current.Key);
799 if not Result then Run := Temp;
800 end;
801
ApplyLineEndnull802 function TmwGenLex.ApplyLineEnd: Boolean;
803 begin
804 Range := nil;
805 Result := True;
806 case Run^ of
807 #13:
808 begin
809 inc(Run);
810 if Run < TheEnd then if Run^ = #10 then inc(Run);
811 end;
812 #10: inc(Run);
813 else Result := False;
814 end;
815 if Result then
816 Inc(fLineCount);
817 end;
818
ApplyTillCharsnull819 function TmwGenLex.ApplyTillChars: Boolean;
820 var
821 Temp: PChar;
822 begin
823 Temp := Run;
824 Result := False;
825 while Result = False do
826 begin
827 if Run >= TheEnd then break;
828 case Run^ of
829 #10, #13:
830 case Current.Multiline of
831 True:
832 begin
833 Range := InnerLineEnd;
834 InnerLineEnd.ToRestore := Current;
835 Exit;
836 end;
837 False:
838 begin
839 Result := False;
840 break;
841 end;
842 end;
843 else
844 Temp := Run;
845 Result := ApplyCharClass;
846 if Result = False then inc(Run);
847 end;
848 end;
849 if Result then
850 begin
851 Range := nil;
852 if psNegative in Current.Storage.Status then Run := Temp;
853 end else
854 case Current.Multiline of
855 True: Range := Current;
856 False:
857 begin
858 Range := nil;
859 Run := Temp;
860 end;
861 end;
862 end;
863
TmwGenLex.ApplyTillKeynull864 function TmwGenLex.ApplyTillKey: Boolean;
865 var
866 Temp: PChar;
867 begin
868 Temp := Run;
869 Result := False;
870 while Result = False do
871 begin
872 if Run >= TheEnd then break;
873 case Run^ of
874 #10, #13:
875 case Current.Multiline of
876 True:
877 begin
878 Range := InnerLineEnd;
879 InnerLineEnd.ToRestore := Current;
880 Exit;
881 end;
882 False:
883 begin
884 Result := False;
885 break;
886 end;
887 end;
888 else
889 if Run^ = Current.Key[1] then
890 begin
891 Result := ApplyKey;
892 if Result = False then inc(Run);
893 end else inc(Run)
894 end;
895 end;
896 if Result then
897 begin
898 Range := nil;
899 if psNegative in Current.Storage.Status then Run := Run - Length(Current.Key);
900 end else
901 case Current.Multiline of
902 True: Range := Current;
903 False:
904 begin
905 Range := nil;
906 Run := Temp;
907 end;
908 end;
909 end;
910
AtEndnull911 function TmwGenLex.AtEnd: Boolean;
912 begin
913 Result := Run >= TheEnd;
914 end;
915
916 procedure TmwGenLex.Clear;
917 var
918 I: Integer;
919 begin
920 for I := 0 to fChain.Count - 1 do
921 if Assigned(fChain[I]) then TObject(fChain[I]).Free;
922 fChain.Clear;
923 end;
924
925 constructor TmwGenLex.Create;
926 begin
927 inherited Create;
928 fLineCount := 0;
929 InnerLineEnd := TAny.Create(nil);
930 InnerLineEnd.Kind := pkInnerLineEnd;
931 InnerLineEnd.Id := piInnerLineEnd;
932 InitSelector;
933 FChain := TList.Create;
934 InitMainSelector;
935 FId := piUnknown;
936 FExId := piUnknown;
937 end;
938
939 destructor TmwGenLex.Destroy;
940 begin
941 InnerLineEnd.Free;
942 Clear;
943 FChain.Free;
944 inherited Destroy;
945 end;
946
Executenull947 function TmwGenLex.Execute: Boolean;
948 var
949 I: Integer;
950 Temp: PChar;
951 begin
952 Temp := Run;
953 Result := True;
954 if (Current.Max = 0) and (Current.Min = 0) then Selector[Current.Kind] else
955 begin
956 for I := 0 to Current.Min - 1 do Result := Selector[Current.Kind];
957 if not Result then Run := Temp;
958 for I := Current.Min to Current.Max - 1 do Selector[Current.Kind];
959 end;
960 end;
961
GetEndPosnull962 function TmwGenLex.GetEndPos: Integer;
963 begin
964 Result := TheEnd - FOrigin;
965 end;
966
GetLinePosnull967 function TmwGenLex.GetLinePos: Integer;
968 begin
969 Result := fLineCount;
970 end;
971
GetRunPosnull972 function TmwGenLex.GetRunPos: Integer;
973 begin
974 Result := Run - FOrigin;
975 end;
976
TmwGenLex.GetTokennull977 function TmwGenLex.GetToken: string;
978 begin
979 SetLength(Result, Run - Start);
980 Move(Start^, Result[1], Run - Start);
981 end;
982
983 procedure TmwGenLex.InitMainSelector;
984 var
985 I: Char;
986 Default: TAny;
987 begin
988 Default := TAny.Create(nil);
989 Default.Key := #0;
990 Default.Id := piZero;
991 FChain.Add(Default);
992 MainSelector[#0] := Default;
993 Default := TAny.Create(nil);
994 FChain.Add(Default);
995 for I := #1 to #255 do
996 MainSelector[I] := Default;
997 end;
998
999 procedure TmwGenLex.InitSelector;
1000 begin
1001 Selector[pkAny] := ApplyAny;
1002 Selector[pkChar] := ApplyChar;
1003 Selector[pkCharClass] := ApplyCharClass;
1004 Selector[pkInnerLineEnd] := ApplyInnerLineEnd;
1005 Selector[pkKey] := ApplyKey;
1006 Selector[pkLineEnd] := ApplyLineEnd;
1007 Selector[pkTillChars] := ApplyTillChars;
1008 Selector[pkTillKey] := ApplyTillKey;
1009 end;
1010
1011 procedure TmwGenLex.Next;
1012 var
1013 Succeed: Boolean;
1014 TempRun: PChar;
1015 begin
1016 Start := Run;
1017 if Range <> nil then Current := Range else
1018 Current := MainSelector[Run^];
1019 while Current <> nil do
1020 begin
1021 case Current.Regress of
1022 True:
1023 begin
1024 TempRun := Run;
1025 Succeed := SubNext;
1026 if Succeed then
1027 begin
1028 Current := Current.ToRegress;
1029 Succeed := SubNext
1030 end;
1031 if Succeed then
1032 begin
1033 FId := Current.Id;
1034 FExId := Current.ExId;
1035 Current := Current.Follow;
1036 end else
1037 begin
1038 Run := TempRun;
1039 Current:= nil;
1040 end;
1041 end;
1042 False:
1043 begin
1044 Succeed := SubNext;
1045 if Succeed then
1046 begin
1047 FId := Current.Id;
1048 FExId := Current.ExId;
1049 Current := Current.Follow;
1050 end;
1051 end;
1052 end;
1053 end;
1054 end;
1055
1056 procedure TmwGenLex.SetEndPos(const Value: Integer);
1057 begin
1058 TheEnd := FOrigin + Value;
1059 end;
1060
1061 procedure TmwGenLex.SetInitMethod(const Value: TmwLexInitMethod);
1062 begin
1063 if Assigned(Value) then
1064 begin
1065 Clear;
1066 FInitMethod := Value;
1067 InitMainSelector;
1068 Value(Self);
1069 end;
1070 end;
1071
1072 procedure TmwGenLex.SetInitProc(const Value: TmwLexInitProc);
1073 begin
1074 if Assigned(Value) then
1075 begin
1076 Clear;
1077 FInitProc := Value;
1078 InitMainSelector;
1079 Value(Self);
1080 end;
1081 end;
1082
1083 procedure TmwGenLex.SetInput(const Value: string);
1084 begin
1085 FOrigin := PChar(Value);
1086 Run := FOrigin;
1087 TheEnd := FOrigin + Length(Value);
1088 end;
1089
1090 procedure TmwGenLex.SetOrigin(const Value: PChar);
1091 begin
1092 FOrigin := Value;
1093 Run := FOrigin;
1094 Start := Value;
1095 TheEnd := FOrigin;
1096 fLineCount := 0;
1097 FId := piUnknown;
1098 FExId := piUnknown;
1099 end;
1100
1101 procedure TmwGenLex.SetRunPos(const Value: Integer);
1102 begin
1103 Run := FOrigin + Value;
1104 Start := Run;
1105 end;
1106
1107 procedure TmwGenLex.SetStartData(Ptr: Pointer; aLen: Integer);
1108 begin
1109 Origin := Ptr;
1110 TheEnd := PChar(Ptr) + aLen;
1111 end;
1112
SubNextnull1113 function TmwGenLex.SubNext: Boolean;
1114 var
1115 I: Integer;
1116 Temp: TAny;
1117 begin
1118 Result := Execute;
1119 if not Result then
1120 if Current.Count = 0 then Current := nil else
1121 for I := 0 to Current.Count - 1 do
1122 begin
1123 Temp := Current;
1124 Current := Current[Byte(I)];
1125 Result := Execute;
1126 if Result then break else
1127 begin
1128 Current := Temp;
1129 if I = Current.Count - 1 then
1130 begin
1131 Current := nil;
1132 break;
1133 end;
1134 end;
1135 end;
1136 end;
1137
1138 initialization
1139 InitTables;
1140
1141 end.
1142
1143