source: trunk/Compiler/Modules/Pascal/AnalyzerPascal.pas

Last change on this file was 75, checked in by chronos, 19 months ago
  • Modified: Removed U prefix from unit names.
  • Modified: Updated Common package.
File size: 46.9 KB
Line 
1unit AnalyzerPascal;
2
3interface
4
5uses
6 Classes, SysUtils, Analyzer, SourceCodePascal, Dialogs, SourceConvertor;
7
8type
9
10 { TAnalyzerPascal }
11
12 TAnalyzerPascal = class(TConvertor)
13 private
14 public
15 Parser: TAnalyzer;
16 function DebugExpressions(List: TExpressions): string;
17 function ParseFile(Name: string): Boolean;
18 function ParseWhileDo(var WhileDo: TWhileDo; SourceCode: TCommonBlock): Boolean;
19 function ParseExpression(SourceCode: TExpression): Boolean;
20 function ParseExpressionParenthases(SourceCode: TExpression;
21 Expressions: TExpressions): Boolean;
22 function ParseExpressionOperator(SourceCode: TExpression;
23 Expressions: TExpressions): Boolean;
24 function ParseExpressionRightValue(SourceCode: TExpression;
25 Expressions: TExpressions): Boolean;
26 function ParseExpressionFunctionCall(SourceCode: TExpression;
27 Expressions: TExpressions; var Func: TFunctionCall): Boolean;
28 function ParseUses(SourceCode: TUsedModules; AExported: Boolean): Boolean;
29 function ParseUsesItem(SourceCode: TUsedModules; AExported: Boolean): Boolean;
30 function ParseModule(ProgramCode: TProgram): TSourceModule;
31 function ParseUnit(var SourceCode: TModuleUnit; ProgramCode: TProgram): Boolean;
32 function ParseUnitInterface(SourceCode: TModuleUnit): Boolean;
33 function ParseUnitImplementation(SourceCode: TModuleUnit): Boolean;
34 function ParseProgram(var SourceCode: TModuleProgram; ProgramCode: TProgram): Boolean;
35 procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: char = ';';
36 WithBody: Boolean = True);
37 procedure ParseCommonBlockInterface(SourceCode: TCommonBlock);
38 function ParseCommand(SourceCode: TCommonBlock): TCommand;
39 function ParseBeginEnd(var BeginEnd: TBeginEnd; SourceCode: TCommonBlock): Boolean;
40 function ParseFunction(SourceCode: TFunctions; Exported: Boolean = False): Boolean;
41 procedure ParseFunctionParameters(SourceCode: TFunction; ValidateParams: Boolean = False);
42 function ParseIfThenElse(var IfThenElse: TIfThenElse; SourceCode: TCommonBlock): Boolean;
43 function ParseForToDo(var ForToDo: TForToDo; SourceCode: TCommonBlock): Boolean;
44 function ParseAssigment(var Assignment: TAssignment; SourceCode: TCommonBlock): Boolean;
45 function ParseFunctionCall(var Call: TFunctionCall; SourceCode: TCommonBlock): Boolean;
46 function ParseVariableList(SourceCode: TVariables; Exported: Boolean = False): Boolean;
47 procedure ParseVariable(SourceCode: TVariables; Exported: Boolean = False);
48 function ParseConstantList(SourceCode: TConstants; Exported: Boolean = False): Boolean;
49 function ParseConstant(SourceCode: TConstants; Exported: Boolean = False): Boolean;
50 function ParseType(TypeList: TTypes; var NewType: TType; ExpectName: Boolean = True;
51 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): Boolean;
52 function ParseTypeParameters(var NewType: TType): Boolean;
53 function ParseTypeSubType(var NewType: TType;
54 ExpectName: Boolean; ForwardDeclaration: Boolean): Boolean;
55 function ParseTypeBase(var NewType: TType): Boolean;
56 function ParseTypePointer(var NewType: TType): Boolean;
57 function ParseTypeEnumeration(var NewType: TType): Boolean;
58 function ParseTypeRecord(var NewType: TType): Boolean;
59 function ParseTypeClass(var NewType: TType): Boolean;
60 function ParseTypeArray(var NewType: TType): Boolean;
61 function ParseTypeSubRange(var NewType: TType): Boolean;
62 constructor Create;
63 destructor Destroy; override;
64 procedure Convert(Input, Output: TSourceList); override;
65 end;
66
67
68resourcestring
69 SUnknownIdentifier = 'Unknown identificator "%s".';
70 SIllegalExpression = 'Illegal expression "%s".';
71 SRedefineIdentifier = 'Identificator "%s" redefinition.';
72 SEndOfDataReached = 'Parser reached to end of input data.';
73 SUndefinedVariable = 'Undefined variable "%s".';
74 SUndefinedType = 'Undefined type "%s".';
75 SUndefinedConstant = 'Undefined constant "%s".';
76 SUnitNotFound = 'Unit "%s" not found.';
77 SFunctionNotDeclared = 'Function "%s" not declared.';
78 SFunctionRedefinition = 'Function "%s" redefined.';
79 SUnknownProcName = 'Unknown proc name "%s".';
80 SUnknownModuleType = 'Unknown module name "%s".';
81 SInvalidConstruction = 'Invalid construction "%s".';
82 SInvalidAssignmentValue = 'Invalid assignment "%s".';
83 SParamDiffers = 'Declaration of parametr "%s" differs.';
84 SNotRecordOrClass = '"%s" not record or class';
85
86
87implementation
88
89{ TAnalyzerPascal }
90
91function TAnalyzerPascal.DebugExpressions(List: TExpressions): string;
92var
93 I: Integer;
94begin
95 Result := Result + '(';
96 for I := 0 to List.Count - 1 do begin
97 Result := Result + IntToStr(I) + ': ';
98 if Assigned(List[I]) then
99 Result := Result + IntToStr(Integer(TExpression(List[I]).NodeType)) +
100 DebugExpressions(TExpression(List[I]).SubItems);
101 if I < List.Count - 1 then Result := Result + ', ';
102 end;
103 Result := Result + ')';
104end;
105
106function TAnalyzerPascal.ParseFile(Name: string): Boolean;
107var
108 Parser: TAnalyzerPascal;
109 NewModule: TSourceModule;
110begin
111(* try
112 Parser := TAnalyzerPascal.Create;
113 Parser.OnDebugLog := OnDebugLog;
114 Parser.ProgramCode := ProgramCode;
115 Parser.OnGetSource := OnGetSource;
116 if Assigned(OnGetSource) then begin
117 if OnGetSource(Name, Parser.SourceCode) then begin
118 Parser.Process;
119 Parser.FileName := Name;
120 Parser.OnErrorMessage := OnErrorMessage;
121 //NewModule :=
122 Parser.ParseModule(ProgramCode);
123 //ProgramCode.Modules.Add(NewModule);
124 Result := True;
125 end else Result := False;
126 end else Result := False;
127 finally
128 Parser.Free;
129 end; *)
130end;
131
132function TAnalyzerPascal.ParseWhileDo(var WhileDo: TWhileDo; SourceCode: TCommonBlock): Boolean;
133begin
134(* with Parser do
135 if NextToken = 'while' then begin
136 Expect('while');
137 WhileDo := TWhileDo.Create;
138 WhileDo.CommonBlock := SourceCode;
139 with WhileDo do begin
140 Condition.CommonBlock := CommonBlock;
141 ParseExpression(Condition);
142 Expect('do');
143 Command := ParseCommand(CommonBlock);
144 end;
145 Result := True;
146 end else Result := False;*)
147end;
148
149{ TExpression }
150
151function TAnalyzerPascal.ParseExpression(SourceCode: TExpression): Boolean;
152var
153 Expressions: TExpressions;
154 I: Integer;
155 II: Integer;
156begin
157(* with Parser do
158 try
159 Expressions := TExpressions.Create;
160 Expressions.Add(TExpression.Create);
161 with SourceCode do begin
162 while ((NextToken <> ';') and (NextToken <> ',') and (not IsKeyWord(NextToken))) and not
163 (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin
164 if not ParseExpressionParenthases(SourceCode, Expressions) then
165 if not ParseExpressionOperator(SourceCode, Expressions) then
166 if not ParseExpressionRightValue(SourceCode, Expressions) then
167 begin
168 ErrorMessage(SInvalidAssignmentValue, [NextToken]);
169 ReadToken;
170 end;
171 //ShowMessage(DebugExpressions(Expressions));
172 end;
173
174 // Build expression tree using operator precedence
175 for II := 0 to High(Operators) do begin
176 I := 1;
177 while (I < Expressions.Count - 1) do begin
178 if not TExpression(Expressions[I]).Associated and
179 (TExpression(Expressions[I]).OperatorName = Operators[II]) then
180 begin
181 TExpression(Expressions[I]).Associated := True;
182 TExpression(Expressions[I - 1]).SubItems.Last := Expressions[I];
183 TExpression(Expressions[I + 1]).SubItems.First := Expressions[I];
184 Expressions.OwnsObjects := False;
185 Expressions[I] := nil;
186 Expressions.OwnsObjects := True;
187 Expressions.Delete(I);
188 end else Inc(I);
189 end;
190 end;
191 if Assigned(TExpression(Expressions.First).SubItems.Last) then begin
192 Assign(TExpression(TExpression(Expressions.First).SubItems.Last));
193 SubItems.OwnsObjects := True;
194 TExpression(TExpression(Expressions.First).SubItems.Last).SubItems.OwnsObjects := False;
195 TExpression(Expressions.First).SubItems.Last.Free;
196 end;
197 TExpression(Expressions.First).SubItems.Last := nil;
198 if Expressions.Count > 1 then
199 TExpression(Expressions[1]).SubItems.First := nil;
200 end;
201 finally
202 Expressions.Free;
203 end; *)
204end;
205
206function TAnalyzerPascal.ParseExpressionParenthases(SourceCode: TExpression;
207 Expressions: TExpressions): Boolean;
208var
209 NewExpression: TExpression;
210begin
211 (* if NextToken = '(' then begin
212 Expect('(');
213 // Subexpression
214 NewExpression := TExpression.Create;
215 NewExpression.Braces := True;
216 NewExpression.CommonBlock := SourceCode.CommonBlock;
217 ParseExpression(NewExpression);
218
219 TExpression(Expressions.Last).SubItems.Last := NewExpression;
220 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
221 begin
222 CommonBlock := SourceCode.CommonBlock;
223 SubItems.First := NewExpression;
224 end;
225 Expect(')');
226 Result := True;
227 end else Result := False;*)
228end;
229
230function TAnalyzerPascal.ParseExpressionOperator(SourceCode: TExpression;
231 Expressions: TExpressions): Boolean;
232begin
233 (*if IsOperator(NextToken) then begin
234 // Operator
235 TExpression(Expressions.Last).OperatorName := ReadToken;
236 TExpression(Expressions.Last).NodeType := ntOperator;
237 Result := True;
238 end else Result := False; *)
239end;
240
241function TAnalyzerPascal.ParseExpressionRightValue(SourceCode: TExpression;
242 Expressions: TExpressions): Boolean;
243var
244 UseType: TType;
245 UseVariable: TVariable;
246 UseConstant: TConstant;
247 UseFunction: TFunction;
248 FunctionCall: TFunctionCall;
249 NewExpression: TExpression;
250 Identifier: string;
251 IntConst: Integer;
252begin
253 NewExpression := nil;
254 with Parser do
255 with SourceCode do begin
256// if IsIdentificator(NextToken) then begin
257 // Start with type
258 UseType := CommonBlock.Types.Search(NextToken);
259 if Assigned(UseType) then begin
260 ReadToken;
261 if NextToken = '(' then begin
262 Expect('(');
263 // Typecasting
264 NewExpression := TExpression.Create;
265 NewExpression.CommonBlock := SourceCode.CommonBlock;
266 NewExpression.NodeType := ntTypecast;
267 NewExpression.UseType := UseType;
268 ParseExpression(NewExpression);
269 Expect(')');
270 end else
271 if (UseType is TTypeRecord) or (UseType is TTypeClass) then begin
272 // Type context
273 if NextToken = '.' then begin
274 Expect('.');
275 Identifier := ReadToken;
276 UseVariable := TTypeRecord(UseType).CommonBlock.Variables.Search(Identifier);
277 if Assigned(UseVariable) then begin
278 // Record or class variable
279 NewExpression := TExpression.Create;
280 NewExpression.CommonBlock := SourceCode.CommonBlock;
281 NewExpression.NodeType := ntVariable;
282 NewExpression.Variable := UseVariable;
283 end;
284 if not Assigned(NewExpression) then begin
285 UseFunction := TTypeRecord(UseType).CommonBlock.Functions.Search(Identifier);
286 if Assigned(UseFunction) then begin
287 // Record or class functions
288 if ParseExpressionFunctionCall(SourceCode, Expressions, FunctionCall) then begin
289 NewExpression := TExpression.Create;
290 NewExpression.CommonBlock := SourceCode.CommonBlock;
291 NewExpression.NodeType := ntFunction;
292 NewExpression.FunctionCall := FunctionCall;
293 end;
294 end;
295 end;
296 if not Assigned(NewExpression) then
297 ErrorMessage(SUndefinedVariable, [Identifier]);
298 end else begin
299 NewExpression := TExpression.Create;
300 NewExpression.CommonBlock := SourceCode.CommonBlock;
301 NewExpression.NodeType := ntType;
302 NewExpression.UseType := UseType;
303 end;
304 end else ErrorMessage(SIllegalExpression, [Identifier]);
305 end;
306 if not Assigned(NewExpression) then begin
307 // Referenced variable
308 UseVariable := CommonBlock.Variables.Search(NextToken);
309 if Assigned(UseVariable) then begin
310 ReadToken;
311 NewExpression := TExpression.Create;
312 NewExpression.CommonBlock := SourceCode.CommonBlock;
313 NewExpression.NodeType := ntVariable;
314 NewExpression.Variable := UseVariable;
315 end;
316 end;
317 if not Assigned(NewExpression) then begin
318 // Function call
319 ParseExpressionFunctionCall(SourceCode, Expressions, FunctionCall);
320 if Assigned(FunctionCall) then begin
321 NewExpression := TExpression.Create;
322 NewExpression.CommonBlock := SourceCode.CommonBlock;
323 NewExpression.NodeType := ntFunction;
324 NewExpression.FunctionCall := FunctionCall;
325 end;
326 end;
327 if not Assigned(NewExpression) then begin
328 // Referenced constant
329 UseConstant := CommonBlock.Constants.Search(NextToken);
330 if Assigned(UseConstant) then begin
331 ReadToken;
332 NewExpression := TExpression.Create;
333 NewExpression.CommonBlock := SourceCode.CommonBlock;
334 NewExpression.NodeType := ntConstant;
335 NewExpression.Constant := UseConstant;
336 end;
337 end;
338 if not Assigned(NewExpression) then begin
339 // Constant value
340 NewExpression := TExpression.Create;
341 NewExpression.CommonBlock := SourceCode.CommonBlock;
342 NewExpression.NodeType := ntValue;
343 NewExpression.Constant := TConstant.Create;
344 NewExpression.Value := ReadToken;
345 if TryStrToInt(NewExpression.Value, IntConst) then
346 NewExpression.Value := IntConst;
347 end;
348 if Assigned(NewExpression) then begin
349 TExpression(Expressions.Last).SubItems[TExpression(Expressions.Last).SubItems.Count - 1] := NewExpression;
350 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
351 begin
352 CommonBlock := SourceCode.CommonBlock;
353 SubItems[0] := NewExpression;
354 end;
355 Result := True;
356 end else begin
357 Result := False;
358 ErrorMessage(SUnknownIdentifier, [ReadToken]);
359 end;
360// end else Result := False;
361 end;
362end;
363
364function TAnalyzerPascal.ParseExpressionFunctionCall(SourceCode: TExpression;
365 Expressions: TExpressions; var Func: TFunctionCall): Boolean;
366var
367 UseFunction: TFunction;
368 UseType: TType;
369 NewExpression: TExpression;
370 I: Integer;
371begin
372 Func := nil;
373 with Parser, SourceCode do begin
374 UseFunction := CommonBlock.Functions.Search(NextToken);
375 if Assigned(UseFunction) then begin
376 ReadToken;
377 Func := TFunctionCall.Create;
378 Func.CommonBlock := SourceCode.CommonBlock;
379 Func.FunctionRef := UseFunction;
380 if NextToken = '(' then begin
381 Expect('(');
382 for I := 0 to Func.FunctionRef.Parameters.Count - 1 do begin
383 if I > 0 then Expect(',');
384 NewExpression := TExpression.Create;
385 NewExpression.CommonBlock := SourceCode.CommonBlock;
386 ParseExpression(NewExpression);
387 Func.ParameterExpression.Add(NewExpression);
388 end;
389 Expect(')');
390 end;
391 Result := True;
392 end else Result := False;
393 end;
394end;
395
396function TAnalyzerPascal.ParseCommand(SourceCode: TCommonBlock): TCommand;
397var
398 Identifier: string;
399 Variable: TVariable;
400 Method: TFunction;
401 First: TOperation;
402 Second: TOperation;
403 StartIndex: integer;
404 LoopVariable: TVariable;
405 IdentName: string;
406 FunctionName: string;
407begin
408 with PArser do
409 begin
410 if not ParseBeginEnd(TBeginEnd(Result), SourceCode) then
411 if not ParseIfThenElse(TIfThenElse(Result), SourceCode) then
412 if not ParseWhileDo(TWhileDo(Result), SourceCode) then
413 if not ParseForToDo(TForToDo(Result), SourceCode) then
414 if not ParseAssigment(TAssignment(Result), SourceCode) then
415 if not ParseFunctionCall(TFunctionCall(Result), SourceCode) then
416 if NextToken = ';' then
417 Result := nil
418 else begin
419 Result := nil;
420 ErrorMessage(SIllegalExpression, [ReadToken], -1);
421 end;
422 end;
423end;
424
425{ TParserModule }
426
427function TAnalyzerPascal.ParseModule(ProgramCode: TProgram): TSourceModule;
428begin
429(* Output := TSource(ProgramCode);
430 if not ParseUnit(TModuleUnit(Result), ProgramCode) then
431 if not ParseProgram(TModuleProgram(Result), ProgramCode) then
432 ErrorMessage(SUnknownModuleType, [NextToken]);*)
433end;
434
435function TAnalyzerPascal.ParseProgram(var SourceCode: TModuleProgram; ProgramCode: TProgram): Boolean;
436var
437 Identifier: string;
438begin
439 with Parser, SourceCode do begin
440 SourceCode := TModuleProgram.Create;
441 SourceCode.ParentProgram := ProgramCode;
442 if NextToken = 'program' then begin
443 Expect('program');
444 Name := ReadToken;
445 Expect(';');
446 end else Name := '';
447
448 // Uses section
449 if NextToken = 'uses' then
450 ParseUses(UsedModules, False);
451
452 ParseCommonBlock(Body, '.');
453 SourceCode.ParentProgram.Modules.Add(SourceCode);
454 ProgramCode.MainModule := SourceCode;
455 Result := True;
456 end;
457end;
458
459function TAnalyzerPascal.ParseUnit(var SourceCode: TModuleUnit; ProgramCode: TProgram): Boolean;
460var
461 NewModule: TSourceModule;
462 NewCommand: TCommand;
463begin
464 with Parser do
465 if NextToken = 'unit' then begin
466 SourceCode := TModuleUnit.Create;
467 SourceCode.ParentProgram := ProgramCode;
468 Expect('unit');
469 with Sourcecode do begin
470 Name := ReadToken;
471 end;
472 Expect(';');
473
474 if not ParseUnitInterface(SourceCode) then
475 ErrorMessage(SExpectedButFound, ['interface', NextToken]);
476
477 if not ParseUnitImplementation(SourceCode) then
478 ErrorMessage(SExpectedButFound, ['implementation', NextToken]);
479
480 SourceCode.ParentProgram.Modules.Add(SourceCode);
481
482 if NextToken = 'initialization' then begin
483 Expect('initialization');
484 while (NextToken <> 'end') and (NextToken <> 'finalization')
485 and (NextTokenType <> ttEndOfFile) do
486 begin
487 NewCommand := ParseCommand(SourceCode.InititializeSection);
488 if Assigned(NewCommand) then
489 SourceCode.InititializeSection.Code.Commands.Add(NewCommand);
490 //ShowMessage(NextCode);
491 if NextToken = ';' then
492 ReadToken;
493 end;
494 end;
495 if NextToken = 'finalization' then begin
496 Expect('finalization');
497 while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
498 begin
499 NewCommand := ParseCommand(SourceCode.FinalalizeSection);
500 if Assigned(NewCommand) then
501 SourceCode.FinalalizeSection.Code.Commands.Add(NewCommand);
502 //ShowMessage(NextCode);
503 if NextToken = ';' then
504 ReadToken;
505 end;
506 end;
507 Expect('end');
508 Expect('.');
509 Result := True;
510 end else Result := False;
511end;
512
513function TAnalyzerPascal.ParseUnitInterface(SourceCode: TModuleUnit): Boolean;
514begin
515 with Parser do
516 if NextToken = 'interface' then begin
517 Expect('interface');
518 // Uses section
519 ParseUses(SourceCode.UsedModules, True);
520
521 ParseCommonBlockInterface(SourceCode.Body);
522 Result := True;
523 end else Result := False;
524end;
525
526function TAnalyzerPascal.ParseUnitImplementation(SourceCode: TModuleUnit): Boolean;
527begin
528 with Parser do
529 if NextToken = 'implementation' then begin
530 Expect('implementation');
531
532 // Uses section
533 if NextToken = 'uses' then
534 ParseUses(SourceCode.UsedModules, False);
535
536 ParseCommonBlock(SourceCode.Body, '.', False);
537 Result := True;
538 end else Result := False;
539end;
540
541{ TParserCommonBlock }
542
543procedure TAnalyzerPascal.ParseCommonBlock(SourceCode: TCommonBlock;
544 EndSymbol: char = ';'; WithBody: Boolean = True);
545var
546 Section: TCommonBlockSection;
547 NewType: TType;
548begin
549 with Parser, SourceCode do begin
550 while (NextToken <> EndSymbol) and (NextTokenType <> ttEndOfFile) do begin
551 if NextToken = 'var' then begin
552 Expect('var');
553 Section := cbsVariable;
554 end else
555 if NextToken = 'type' then begin
556 Expect('type');
557 Section := cbsType;
558 end;
559 if NextToken = 'const' then begin
560 Expect('const');
561 Section := cbsConstant;
562 end;
563
564 if not ParseFunction(Functions) then
565 if WithBody and ParseBeginEnd(Code, SourceCode) then begin
566 Break;
567 end else
568 if Section = cbsVariable then begin
569 ParseVariable(Variables);
570 end else
571 if Section = cbsType then begin
572 if ParseType(Types, NewType) then begin
573 Types.Add(NewType);
574 NewType.Parent := Types;
575 NewType.Exported := False;
576 Order.Add(NewType);
577 end;
578 Expect(';');
579 end else
580 if Section = cbsConstant then begin
581 ParseConstant(Constants);
582 end else
583 if NextToken = 'initialization' then Break
584 else if NextToken = 'finalization' then Break
585 else if NextToken = 'end' then Break
586 else begin
587 ErrorMessage(SInvalidConstruction, [NextToken]);
588 ReadToken;
589 end;
590 end;
591 if WithBody then Expect(EndSymbol);
592 end;
593end;
594
595procedure TAnalyzerPascal.ParseCommonBlockInterface(SourceCode: TCommonBlock);
596var
597 Section: TCommonBlockSection;
598 NewType: TType;
599begin
600 Log('ParseCommonBlockInterface');
601 with Parser, SourceCode do begin
602 while (NextToken <> 'implementation') and (NextTokenType <> ttEndOfFile) do begin
603 if NextToken = 'var' then begin
604 Expect('var');
605 Section := cbsVariable;
606 end else
607 if NextToken = 'type' then begin
608 Expect('type');
609 Section := cbsType;
610 end;
611 if NextToken = 'const' then begin
612 Expect('const');
613 Section := cbsConstant;
614 end;
615
616 if not ParseFunction(Functions, True) then
617 if Section = cbsVariable then begin
618 ParseVariable(Variables, True);
619 end else
620 if Section = cbsType then begin
621 if ParseType(Types, NewType) and Assigned(NewType) then begin
622 Types.Add(NewType);
623 NewType.Parent := Types;
624 NewType.Exported := True;
625 Order.Add(NewType);
626 end;
627 Expect(';');
628 end else
629 if Section = cbsConstant then begin
630 ParseConstant(Constants, True);
631 end;
632 end;
633 end;
634end;
635
636{ TParserBeginEnd }
637
638function TAnalyzerPascal.ParseBeginEnd(var BeginEnd: TBeginEnd; SourceCode: TCommonBlock): Boolean;
639var
640 NewCommand: TCommand;
641begin
642 with Parser do
643 if NextToken = 'begin' then begin
644 //ShowMessage(IntToStr(Integer(SourceCode)) + ' ' + IntToStr(Integer(SourceCode.CommonBlock)));
645 BeginEnd := TBeginEnd.Create;
646 TBeginEnd(BeginEnd).CommonBlock := SourceCode;
647 with BeginEnd do
648 begin
649 Expect('begin');
650 while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
651 begin
652 NewCommand := ParseCommand(CommonBlock);
653 if Assigned(NewCommand) then
654 Commands.Add(NewCommand);
655 //ShowMessage(NextCode);
656 if NextToken = ';' then
657 ReadToken;
658 end;
659 Expect('end');
660 end;
661 Result := True;
662 end else Result := False;
663end;
664
665{ TParserParseFunctionList }
666
667function TAnalyzerPascal.ParseFunction(SourceCode: TFunctions;
668 Exported: Boolean = False): Boolean;
669var
670 NewValueType: TType;
671 TypeName: string;
672 UseName: string;
673 I: Integer;
674 UseType: TType;
675 UseFunction: TFunction;
676 FunctionType: TFunctionType;
677 ValidParams: Boolean;
678begin
679 with Parser do
680 if (NextToken = 'procedure') or (NextToken = 'function') then begin
681 with SourceCode do begin
682 if NextToken = 'procedure' then begin
683 Expect('procedure');
684 FunctionType := ftProcedure;
685 end else
686 if NextToken = 'function' then begin
687 Expect('function');
688 FunctionType := ftFunction;
689 end else
690 if NextToken = 'constructor' then begin
691 Expect('constructor');
692 FunctionType := ftConstructor;
693 end else
694 if NextToken = 'destructor' then begin
695 Expect('destructor');
696 FunctionType := ftDestructor;
697 end else ErrorMessage(SUnknownProcName, [NextToken]);
698
699 // Read function name
700 UseName := ReadToken;
701 UseType := SourceCode.Parent.Types.Search(UseName);
702 if Assigned(UseType) and ((UseType is TTypeRecord) or
703 (UseType is TTypeClass)) then begin
704 Expect('.');
705 ValidParams := True;
706 UseName := ReadToken;
707 if UseType is TTypeRecord then begin
708 UseFunction := TTypeRecord(UseType).CommonBlock.Functions.Search(UseName);
709 if not Assigned(UseFunction) then begin
710 ErrorMessage(SFunctionNotDeclared, [UseName]);
711 Exit;
712 end;
713 end else
714 if UseType is TTypeClass then begin
715 UseFunction := TTypeClass(UseType).CommonBlock.Functions.Search(UseName);
716 if not Assigned(UseFunction) then begin
717 ErrorMessage(SFunctionNotDeclared, [UseName]);
718 Exit;
719 end;
720 end;
721 end else begin
722 UseFunction := SourceCode.Search(UseName, True);
723 if not Assigned(UseFunction) then begin
724 // Create new function
725 UseFunction := TFunction.Create;
726 UseFunction.Parent := SourceCode.Parent;
727 UseFunction.Name := UseName;
728 UseFunction.FunctionType := FunctionType;
729 UseFunction.Exported := Exported;
730 Add(UseFunction);
731 UseFunction.Parent.Order.Add(UseFunction);
732 ValidParams := False;
733 end else begin
734 if not UseFunction.BodyLoaded then UseFunction.BodyLoaded := True
735 else begin
736 ErrorMessage(SFunctionRedefinition, [UseName]);
737 Exit;
738 end;
739 end;
740 end;
741 with UseFunction do begin
742 // Parse parameters
743 if NextToken = '(' then
744 ParseFunctionParameters(UseFunction, ValidParams);
745
746 // Parse function result type
747 if FunctionType = ftFunction then begin
748 Expect(':');
749 TypeName := ReadToken;
750 NewValueType := Parent.Types.Search(TypeName);
751 if not Assigned(NewValueType) then
752 ErrorMessage(SUndefinedType, [TypeName], -1)
753 else
754 begin
755 ResultType := NewValueType;
756 with TVariable(Variables.Items[Variables.Add(
757 TVariable.Create)]) do
758 begin
759 Name := 'Result';
760 ValueType := NewValueType;
761 end;
762 end;
763 end;
764 Expect(';');
765
766 // Check directives
767 if NextToken = 'internal' then begin
768 Expect('internal');
769 Expect(';');
770 Internal := True;
771 end;
772 end;
773
774 if not Exported then ParseCommonBlock(UseFunction);
775// if UseFunction then UseFunction.Code ;
776 end;
777 Result := True;
778 end else Result := False;
779end;
780
781procedure TAnalyzerPascal.ParseFunctionParameters(SourceCode: TFunction;
782 ValidateParams: Boolean = False);
783var
784 Identifiers: TStringList;
785 VariableName: string;
786 UseVariable: TParameter;
787 TypeName: string;
788 UseType: TType;
789 I: Integer;
790begin
791 with Parser, SourceCode do
792 try
793 Identifiers := TStringList.Create;
794 Expect('(');
795 while (NextToken <> ')') and (NextTokenType <> ttEndOfFile) do begin
796 // while IsIdentificator(NextCode) do begin
797 with TParameters(Parameters) do begin
798 VariableName := ReadToken;
799 if VariableName = 'var' then begin
800 end else
801 if VariableName = 'const' then begin
802 end else begin
803 UseVariable := Search(VariableName);
804 if not Assigned(UseVariable) then begin
805 Identifiers.Add(VariableName);
806 while NextToken = ',' do begin
807 Expect(',');
808 Identifiers.Add(ReadToken);
809 end;
810 end else
811 if not ValidateParams then
812 ErrorMessage(SRedefineIdentifier, [VariableName], -1);
813 Expect(':');
814 TypeName := ReadToken;
815 UseType := Parent.Types.Search(TypeName);
816 if not Assigned(UseType) then
817 ErrorMessage(SUndefinedType, [TypeName], -1)
818 else
819 if ValidateParams then begin
820 for I := 0 to Identifiers.Count - 1 do begin
821 UseVariable := Parameters.Search(Identifiers[I]);
822 if Assigned(UseVariable) then
823 if UseVariable.ValueType <> UseType then ;
824 ErrorMessage(SParamDiffers, [Identifiers[I]]);
825 end;
826 end else begin
827 for I := 0 to Identifiers.Count - 1 do
828 with TParameter(Items[Add(TParameter.Create)]) do
829 begin
830 Name := Identifiers[I];
831 ValueType := UseType;
832 end;
833
834 end;
835 end;
836 end;
837 if NextToken = ';' then Expect(';');
838 end;
839 Expect(')');
840 finally
841 Identifiers.Free;
842 end;
843end;
844
845{ TParserIfThenElse }
846
847function TAnalyzerPascal.ParseIfThenElse(var IfThenElse: TIfThenElse; SourceCode: TCommonBlock): Boolean;
848begin
849 with Parser do
850 if NextToken = 'if' then begin
851 IfThenElse := TIfThenElse.Create;
852 IfThenElse.CommonBlock := SourceCode;
853 with IfThenElse do begin
854 Expect('if');
855 Condition.CommonBlock := CommonBlock;
856 ParseExpression(Condition);
857 Expect('then');
858 Command := ParseCommand(CommonBlock);
859 if NextToken = 'else' then
860 begin
861 Expect('else');
862 ElseCommand := ParseCommand(CommonBlock);
863 end;
864 end;
865 Result := True;
866 end else Result := False;
867end;
868
869function TAnalyzerPascal.ParseForToDo(var ForToDo: TForToDo; SourceCode: TCommonBlock): Boolean;
870var
871 VariableName: string;
872begin
873 with Parser do
874 if NextToken = 'for' then begin
875 ForToDo := TForToDo.Create;
876 ForToDo.CommonBlock := SourceCode;
877 with ForToDo do begin
878 Expect('for');
879 VariableName := ReadToken;
880 ControlVariable := ForToDo.CommonBlock.Variables.Search(VariableName);
881 if not Assigned(ControlVariable) then
882 ErrorMessage(SUndefinedVariable, [VariableName], -1);
883 Expect(':=');
884 Start.CommonBlock := CommonBlock;
885 ParseExpression(Start);
886 Expect('to');
887 Stop.CommonBlock := CommonBlock;
888 ParseExpression(Stop);
889 Expect('do');
890 Command := ParseCommand(CommonBlock);
891 end;
892 Result := True;
893 end else Result := False;
894end;
895
896function TAnalyzerPascal.ParseAssigment(var Assignment: TAssignment;
897 SourceCode: TCommonBlock): Boolean;
898var
899 Variable: TVariable;
900 IdentName: string;
901begin
902 with Parser do
903 if IsIdentificator(NextToken) then begin
904 Variable := SourceCode.Variables.Search(NextToken);
905 if Assigned(Variable) then begin
906 // Variable assignment
907 Assignment := TAssignment.Create;
908 Assignment.CommonBlock := SourceCode;
909 IdentName := ReadToken;
910 Assignment.Target := SourceCode.Variables.Search(IdentName);
911 Expect(':=');
912 Assignment.Source := TExpression.Create;
913 Assignment.Source.CommonBlock := SourceCode;
914 ParseExpression(Assignment.Source);
915 Result := True;
916 end else Result := False;
917 end else Result := False;
918end;
919
920function TAnalyzerPascal.ParseFunctionCall(var Call: TFunctionCall;
921 SourceCode: TCommonBlock): Boolean;
922var
923 FunctionName: string;
924begin
925 with Parser do
926 if IsIdentificator(NextToken) then begin
927 if Assigned(SourceCode.Functions.Search(NextToken)) then begin
928 // Function call
929 FunctionName := ReadToken;
930 Call := TFunctionCall.Create;
931 Call.CommonBlock := SourceCode;
932 Call.FunctionRef := SourceCode.Functions.Search(FunctionName);
933 if NextToken = '(' then begin
934 Expect('(');
935 with Call do begin
936 ParameterExpression.Add(TExpression.Create);
937 TExpression(ParameterExpression.Last).CommonBlock := SourceCode;
938 ParseExpression(TExpression(ParameterExpression.Last));
939 end;
940 Expect(')');
941 end;
942 Result := True;
943 end else Result := False;
944 end else Result := False;
945end;
946
947{ TParserVariableList }
948
949function TAnalyzerPascal.ParseVariableList(SourceCode: TVariables; Exported: Boolean = False): Boolean;
950var
951 NewValueType: TType;
952 TypeName: string;
953 I: integer;
954begin
955 with Parser do
956 if NextToken = 'var' then begin
957 Expect('var');
958 with SourceCode do begin
959 while IsIdentificator(NextToken) and (NextTokenType <> ttEndOfFile) do begin
960 ParseVariable(SourceCode, Exported);
961 end;
962 end;
963 Result := True;
964 end else Result := False;
965end;
966
967{ TParserVariable }
968
969procedure TAnalyzerPascal.ParseVariable(SourceCode: TVariables; Exported: Boolean = False);
970var
971 VariableName: string;
972 Variable: TVariable;
973 TypeName: string;
974 NewValueType: TType;
975 Identifiers: TStringList;
976 I: Integer;
977 NewVariable: TVariable;
978begin
979 with Parser do
980 try
981 Identifiers := TStringList.Create;
982 with SourceCode do begin
983 Identifiers.Clear;
984 VariableName := ReadToken;
985 Variable := Search(VariableName);
986 if not Assigned(Variable) then begin
987 Identifiers.Add(VariableName);
988 while NextToken = ',' do begin
989 Expect(',');
990 Identifiers.Add(ReadToken);
991 end;
992 end else
993 ErrorMessage(SRedefineIdentifier, [VariableName], -1);
994 Expect(':');
995 TypeName := ReadToken;
996 NewValueType := Parent.Types.Search(TypeName);
997 if NewValueType = nil then
998 ErrorMessage(SUndefinedType, [TypeName], -1)
999 else
1000 for I := 0 to Identifiers.Count - 1 do begin
1001 Variable := TVariable.Create;
1002 Variable.Name := Identifiers[I];
1003 Variable.ValueType := NewValueType;
1004 Variable.Exported := Exported;
1005 Add(Variable);
1006 Parent.Order.Add(Variable);
1007 end;
1008 Expect(';');
1009 end;
1010 finally
1011 Identifiers.Free;
1012 end;
1013end;
1014
1015{ TParserConstantList }
1016
1017function TAnalyzerPascal.ParseConstantList(SourceCode: TConstants; Exported: Boolean = False): Boolean;
1018begin
1019 with Parser do
1020 if NextToken = 'const' then begin
1021 Expect('const');
1022 with SourceCode do begin
1023 while IsIdentificator(NextToken) do begin
1024 ParseConstant(SourceCode, Exported);
1025 end;
1026 end;
1027 Result := True;
1028 end else Result := False;
1029end;
1030
1031function TAnalyzerPascal.ParseConstant(SourceCode: TConstants;
1032 Exported: Boolean): Boolean;
1033var
1034 Identifiers: TStringList;
1035 NewValueType: TType;
1036 TypeName: string;
1037 ConstantName: string;
1038 Constant: TConstant;
1039 I: integer;
1040 ConstantValue: string;
1041begin
1042 with Parser, SourceCode do
1043 try
1044 Identifiers := TStringList.Create;
1045 ConstantName := ReadToken;
1046 Constant := Search(ConstantName);
1047 if not Assigned(Constant) then begin
1048 Identifiers.Add(ConstantName);
1049 while NextToken = ',' do begin
1050 Expect(',');
1051 Identifiers.Add(ReadToken);
1052 end;
1053 end else
1054 ErrorMessage(SRedefineIdentifier, [ConstantName], -1);
1055 if NextToken = ':' then begin
1056 Expect(':');
1057 TypeName := ReadToken;
1058 NewValueType := Parent.Types.Search(TypeName);
1059 end;
1060 Expect('=');
1061 ConstantValue := ReadToken;
1062 Expect(';');
1063
1064 //if NewValueType = nil then
1065 // ErrorMessage(SUndefinedType, [TypeName], -1)
1066 //else
1067 for I := 0 to Identifiers.Count - 1 do begin
1068 Constant := TConstant.Create;
1069 Constant.Name := Identifiers[I];
1070 Constant.ValueType := NewValueType;
1071 Constant.Value := ConstantValue;
1072 Constant.Exported := Exported;
1073 Add(Constant);
1074 Parent.Order.Add(Constant);
1075 end;
1076 finally
1077 Identifiers.Free;
1078 end;
1079end;
1080
1081{ TParserType }
1082
1083function TAnalyzerPascal.ParseType(TypeList: TTypes; var NewType: TType; ExpectName: Boolean = True;
1084 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): Boolean;
1085begin
1086 NewType := TType.Create;
1087 NewType.Parent := TypeList;
1088 //with SourceCode do
1089 with Parser do
1090 begin
1091 if ExpectName then begin
1092 NewType.Name := ReadToken;
1093 if ParseTypeParameters(NewType) then ;
1094 Expect(AssignSymbol);
1095 end;
1096
1097 Result := True;
1098 if not ParseTypeEnumeration(NewType) then
1099 if not ParseTypeRecord(NewType) then
1100 if not ParseTypeClass(NewType) then
1101 if not ParseTypeArray(NewType) then
1102 if not ParseTypePointer(NewType) then
1103 if not ParseTypeBase(NewType) then
1104 if not ParseTypeSubType(NewType, ExpectName, ForwardDeclaration) then
1105 if not ParseTypeSubRange(NewType) then begin
1106 ErrorMessage(SInvalidConstruction, [NextToken]);
1107 NewType.Free;
1108 Result := False;
1109 end;
1110 end;
1111end;
1112
1113function TAnalyzerPascal.ParseTypeParameters(var NewType: TType): Boolean;
1114var
1115 NewType2: TType;
1116begin
1117 with Parser do
1118 if NextToken = '<' then begin
1119 Expect('<');
1120 while ((NextToken = ',') or (NewType.Parameters.Count = 0)) and (NextTokenType <> ttEndOfFile) do begin
1121 if NewType.Parameters.Count > 0 then Expect(',');
1122 NewType2 := TType.Create;
1123 NewType2.Name := ReadToken;
1124 NewType2.Parent := NewType.Parent;
1125 NewType.Parameters.Add(NewType2);
1126 end;
1127 Expect('>');
1128 Result := True;
1129 end else Result := False;
1130end;
1131
1132function TAnalyzerPascal.ParseTypeSubType(var NewType: TType;
1133 ExpectName: Boolean; ForwardDeclaration: Boolean): Boolean;
1134var
1135 TypeName: string;
1136 TempType: TType;
1137begin
1138 Result := False;
1139 // Use existed type
1140 with Parser do
1141 if NextTokenType = ttIdentifier then begin
1142 TypeName := ReadToken;
1143 if ExpectName then begin
1144 NewType.UsedType := NewType.Parent.Search(TypeName);
1145 Result := True;
1146 if not Assigned(NewType.UsedType) then
1147 ErrorMessage(SUndefinedType, [TypeName], -1);
1148 end else begin
1149 NewType := NewType.Parent.Search(TypeName);
1150 if not Assigned(TType(NewType)) then begin
1151 if ForwardDeclaration then begin
1152 // ForwardDeclaration
1153 NewType.Name := TypeName;
1154 NewType.UsedType := nil;
1155 end else
1156 ErrorMessage(SUndefinedType, [TypeName], -1);
1157 end;
1158 Result := Assigned(NewType);
1159 end;
1160 end else Result := False;
1161end;
1162
1163function TAnalyzerPascal.ParseTypeBase(var NewType: TType): Boolean;
1164var
1165 TempType: TType;
1166begin
1167 // Buildin base type construction
1168 with Parser do
1169 if NextToken = 'type' then begin
1170 Expect('type');
1171 TempType := NewType;
1172 NewType := TTypeInherited.Create;
1173 NewType.Assign(TempType);
1174 TempType.Free;
1175 if NextToken = '(' then begin
1176 Expect('(');
1177 if ParseType(NewType.Parent, NewType.UsedType, False) then ;
1178 Expect(')');
1179 end else NewType.UsedType := nil;
1180 Result := True;
1181 end else Result := False;
1182end;
1183
1184function TAnalyzerPascal.ParseTypePointer(var NewType: TType): Boolean;
1185var
1186 TempType: TType;
1187begin
1188 with Parser do
1189 if NextToken = '^' then begin
1190 Expect('^');
1191 TempType := NewType;
1192 NewType := TTypePointer.Create;
1193 NewType.Assign(TempType);
1194 TempType.Free;
1195 Result := ParseType(NewType.Parent, NewType.UsedType, False, '=', True);
1196 end else Result := False;
1197end;
1198
1199function TAnalyzerPascal.ParseTypeEnumeration(var NewType: TType
1200 ): Boolean;
1201var
1202 TempType: TType;
1203begin
1204 with Parser do
1205 if NextToken = '(' then begin
1206 Expect('(');
1207 TempType := NewType;
1208 NewType := TTypeEnumeration.Create;
1209 NewType.Assign(TempType);
1210 TempType.Free;
1211 with TTypeEnumeration(NewType) do
1212 with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
1213 Name := ReadToken;
1214 if (NextToken = '=') and (NextTokenType = ttConstantNumber) then begin
1215 Expect('=');
1216 Index := StrToInt(ReadToken);
1217 end;
1218 end;
1219 while (NextToken = ',') and (NextTokenType <> ttEndOfFile) do
1220 begin
1221 Expect(',');
1222 with TTypeEnumeration(NewType) do
1223 with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
1224 Name := ReadToken;
1225 if (NextToken = '=') and (NextTokenType = ttConstantNumber) then begin
1226 Expect('=');
1227 Index := StrToInt(ReadToken);
1228 end;
1229 end;
1230 end;
1231 Expect(')');
1232 Result := True;
1233 end else Result := False;
1234end;
1235
1236function TAnalyzerPascal.ParseTypeRecord(var NewType: TType): Boolean;
1237var
1238 Visibility: TTypeVisibility;
1239 SectionType: TCommonBlockSection;
1240 NewType2: TType;
1241 TempType: TType;
1242begin
1243 with Parser do
1244 if NextToken = 'record' then begin
1245 Expect('record');
1246 SectionType := cbsVariable;
1247 Visibility := tvPublic;
1248 TempType := NewType;
1249 NewType := TTypeRecord.Create;
1250 NewType.Assign(TempType);
1251 TempType.Free;
1252 TTypeRecord(NewType).CommonBlock.Parent := NewType.Parent.Parent;
1253 while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin
1254 // Visibility sections
1255 if NextToken = 'public' then begin
1256 Expect('public');
1257 Visibility := tvPublic;
1258 end else
1259 if NextToken = 'private' then begin
1260 Expect('private');
1261 Visibility := tvPrivate;
1262 end else
1263 if NextToken = 'published' then begin
1264 Expect('published');
1265 Visibility := tvPublished;
1266 end else
1267 if NextToken = 'protected' then begin
1268 Expect('protected');
1269 Visibility := tvProtected;
1270 end else
1271
1272 // Definition sections
1273 if NextToken = 'var' then begin
1274 Expect('var');
1275 SectionType := cbsVariable;
1276 end else
1277 if NextToken = 'const' then begin
1278 Expect('const');
1279 SectionType := cbsConstant;
1280 end else
1281 if NextToken = 'type' then begin
1282 Expect('type');
1283 SectionType := cbsType;
1284 end;
1285
1286 if NextToken = 'procedure' then
1287 ParseFunction(TTypeRecord(NewType).CommonBlock.Functions, True)
1288 else if NextToken = 'function' then
1289 ParseFunction(TTypeRecord(NewType).CommonBlock.Functions, True)
1290 else
1291 if SectionType = cbsConstant then begin
1292 ParseConstant(TTypeRecord(NewType).CommonBlock.Constants, True)
1293 end else
1294 if SectionType = cbsVariable then begin
1295 ParseVariable(TTypeRecord(NewType).CommonBlock.Variables, True);
1296 end else
1297 if SectionType = cbsType then
1298 with TTypeRecord(NewType).CommonBlock do begin
1299 if ParseType(Types, NewType2, True, '=') then begin
1300 Types.Add(NewType2);
1301 NewType2.Parent := Types;
1302 end;
1303 end;
1304 end;
1305 Expect('end');
1306 Result := True;
1307 end else Result := False;
1308end;
1309
1310function TAnalyzerPascal.ParseTypeClass(var NewType: TType
1311 ): Boolean;
1312var
1313 Visibility: TTypeVisibility;
1314 SectionType: TCommonBlockSection;
1315 NewType2: TType;
1316 TempType: TType;
1317begin
1318 with Parser do
1319 if NextToken = 'class' then begin
1320 Expect('class');
1321 SectionType := cbsVariable;
1322 Visibility := tvPublic;
1323 TempType := NewType;
1324 NewType := TTypeClass.Create;
1325 NewType.Assign(TempType);
1326 TempType.Free;
1327 TTypeClass(NewType).CommonBlock.Parent := NewType.Parent.Parent;
1328 while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin
1329 // Visibility sections
1330 if NextToken = 'public' then begin
1331 Expect('public');
1332 Visibility := tvPublic;
1333 end else
1334 if NextToken = 'private' then begin
1335 Expect('private');
1336 Visibility := tvPrivate;
1337 end else
1338 if NextToken = 'published' then begin
1339 Expect('published');
1340 Visibility := tvPublished;
1341 end else
1342 if NextToken = 'protected' then begin
1343 Expect('protected');
1344 Visibility := tvProtected;
1345 end else
1346
1347 // Definition sections
1348 if NextToken = 'var' then begin
1349 Expect('var');
1350 SectionType := cbsVariable;
1351 end else
1352 if NextToken = 'const' then begin
1353 Expect('const');
1354 SectionType := cbsConstant;
1355 end else
1356 if NextToken = 'type' then begin
1357 Expect('type');
1358 SectionType := cbsType;
1359 end;
1360
1361 if NextToken = 'procedure' then
1362 ParseFunction(TTypeClass(NewType).CommonBlock.Functions, True)
1363 else if NextToken = 'function' then
1364 ParseFunction(TTypeClass(NewType).CommonBlock.Functions, True)
1365 else
1366 if SectionType = cbsConstant then begin
1367 ParseConstant(TTypeClass(NewType).CommonBlock.Constants, True)
1368 end else
1369 if SectionType = cbsVariable then begin
1370 ParseVariable(TTypeClass(NewType).CommonBlock.Variables, True);
1371 end else
1372 if SectionType = cbsType then
1373 with TTypeClass(NewType).CommonBlock do begin
1374 if ParseType(Types, NewType2, True, '=') then begin
1375 Types.Add(NewType2);
1376 NewType2.Parent := Types;
1377 end;
1378 end;
1379 end;
1380 Expect('end');
1381 Result := True;
1382 end else Result := False;
1383end;
1384
1385function TAnalyzerPascal.ParseTypeArray(var NewType: TType): Boolean;
1386var
1387 UseName: string;
1388 UseType: TType;
1389 TempType: TType;
1390begin
1391 with Parser do
1392 if NextToken = 'array' then begin
1393 Expect('array');
1394 TempType := NewType;
1395 NewType := TTypeArray.Create;
1396 NewType.Assign(TempType);
1397 TempType.Free;
1398 if NextToken = '[' then begin
1399 Expect('[');
1400 UseName := NextToken;
1401 if NextTokenType = ttIdentifier then begin
1402 TTypeArray(NewType).IndexType := NewType.Parent.Parent.Types.Search(UseName);
1403 if not Assigned(TTypeArray(NewType).IndexType) then
1404 ErrorMessage(SUndefinedType, [UseName], -1);
1405 end else
1406 if NextTokenType = ttConstantNumber then begin
1407 ParseTypeSubRange(TTypeArray(NewType).IndexType);
1408 if not Assigned(TTypeArray(NewType).IndexType) then begin
1409 ErrorMessage(SInvalidConstruction, [NextToken], -1);
1410 end;
1411 end;
1412 Expect(']');
1413 end;
1414 Expect('of');
1415 UseName := NextToken;
1416 Result := ParseType(NewType.Parent, TTypeArray(NewType).ItemType, False);
1417 if not Assigned(TTypeArray(NewType).ItemType) then
1418 ErrorMessage(SUndefinedType, [UseName], -1);
1419 end else Result := False;
1420end;
1421
1422function TAnalyzerPascal.ParseTypeSubRange(var NewType: TType): Boolean;
1423var
1424 UseName: string;
1425 TempType: TType;
1426begin
1427 with Parser do
1428 if NextTokenType = ttConstantString then begin
1429 TempType := NewType;
1430 NewType := TTypeSubRange.Create;
1431 NewType.Assign(TempType);
1432 TempType.Free;
1433 TTypeSubRange(NewType).Bottom := ReadToken;
1434 Expect('..');
1435 TTypeSubRange(NewType).Top := ReadToken;
1436 Result := True;
1437 end else
1438 if NextTokenType = ttConstantNumber then begin
1439 TempType := NewType;
1440 NewType := TTypeSubRange.Create;
1441 NewType.Assign(TempType);
1442 TempType.Free;
1443 TTypeSubRange(NewType).Bottom := ReadToken;
1444 Expect('..');
1445 TTypeSubRange(NewType).Top := ReadToken;
1446 Result := True;
1447 end else Result := False;
1448end;
1449
1450constructor TAnalyzerPascal.Create;
1451begin
1452 inherited;
1453 Parser := TAnalyzer.Create;
1454 Name := 'Delphi';
1455 InputType := TSourceFileLink;
1456 OutputType := TProgram;
1457end;
1458
1459destructor TAnalyzerPascal.Destroy;
1460begin
1461 Parser.Free;
1462 inherited Destroy;
1463end;
1464
1465procedure TAnalyzerPascal.Convert(Input, Output: TSourceList);
1466begin
1467
1468end;
1469
1470{ TParserUsedModuleList }
1471
1472function TAnalyzerPascal.ParseUses(SourceCode: TUsedModules; AExported: Boolean): Boolean;
1473var
1474 NewUsedModule: TUsedModule;
1475begin
1476 with Parser do
1477 if NextToken = 'uses' then begin
1478 Expect('uses');
1479 ParseUsesItem(SourceCode, AExported);
1480 while NextToken = ',' do begin
1481 Expect(',');
1482 ParseUsesItem(SourceCode, AExported);
1483 end;
1484 Expect(';');
1485 Result := True;
1486 end else Result := False;
1487end;
1488
1489function TAnalyzerPascal.ParseUsesItem(SourceCode: TUsedModules;
1490 AExported: Boolean): Boolean;
1491begin
1492 with Parser do
1493 with TUsedModule(SourceCode.Items[SourceCode.Add(TUsedModule.Create)]) do begin
1494 Name := ReadToken;
1495 if NextToken = 'in' then begin
1496 Expect('in');
1497 Location := ReadToken;
1498 end else Location := Name + '.pas';
1499 Module := SourceCode.ParentModule.ParentProgram.Modules.Search(Name);
1500 if not Assigned(Module) then begin
1501 if ParseFile(Name + '.pas') then begin
1502 Module := SourceCode.ParentModule.ParentProgram.Modules.Search(Name);
1503 Exported := AExported;
1504 end else begin
1505 ErrorMessage(SUnitNotFound, [Name], -2);
1506 SourceCode.Delete(SourceCode.Count - 1);
1507 end;
1508 end;
1509 end;
1510end;
1511
1512end.
1513
Note: See TracBrowser for help on using the repository browser.