source: branches/xpascal/Parsers/ParserPascal.pas

Last change on this file was 236, checked in by chronos, 2 years ago
  • Fixed: Var function parameters processed correctly for both user defined and internal functions.
File size: 26.5 KB
Line 
1unit ParserPascal;
2
3interface
4
5uses
6 Classes, SysUtils, Parser, Tokenizer, Source;
7
8type
9
10 { TParserPascal }
11
12 TParserPascal = class(TParser)
13 protected
14 function ParseBeginEnd(Block: TBlock; out BeginEnd: TBeginEnd): Boolean;
15 function ParseFunctionCall(Block: TBlock; out FunctionCall: TFunctionCall): Boolean;
16 function ParseProcedureCall(Block: TBlock; out ProcedureCall: TProcedureCall): Boolean;
17 function ParseCommand(Block: TBlock; out Command: TCommand): Boolean;
18 function ParseProgram(SystemBlock: TBlock; out Prog: TProgram): Boolean; override;
19 function ParseBlock(ParentBlock: TBlock; out Block: TBlock; ExistingBlock: TBlock = nil): Boolean;
20 function ParseBlockVar(Block: TBlock): Boolean;
21 function ParseBlockConst(Block: TBlock): Boolean;
22 function ParseFunction(Block: TBlock; out Func: TFunction): Boolean;
23 function ParseFunctionParameters(Block: TBlock; out Params: TFunctionParameters): Boolean;
24 function ParseFunctionParameter(Block: TBlock; out Parameter: TFunctionParameter): Boolean;
25 function ParseProcedure(Block: TBlock; out Proc: TProcedure): Boolean;
26 function ParseAssignment(Block: TBlock; out Assignment: TAssignment): Boolean;
27 function ParseExpression(Block: TBlock; out Expression: TExpression;
28 WithOperation: Boolean = True): Boolean;
29 function ParseExpressionOperation(Block: TBlock; out ExpressionOperation: TExpressionOperation): Boolean;
30 function ParseExpressionOperand(Block: TBlock; out ExpressionOperand: TExpressionOperand): Boolean;
31 function ParseExpressionBrackets(Block: TBlock; out ExpressionBrackets: TExpressionBrackets): Boolean;
32 function ParseConstantRef(Block: TBlock; out ConstantRef: TConstant): Boolean;
33 function ParseConstant(Block: TBlock; out ConstantRef: TConstant): Boolean;
34 function ParseVariable(Block: TBlock; out VariableRef: TVariable): Boolean;
35 function ParseIfThenElse(Block: TBlock; out IfThenElse: TIfThenElse): Boolean;
36 function ParseWhileDo(Block: TBlock; out WhileDo: TWhileDo): Boolean;
37 function ParseRepeatUntil(Block: TBlock; out RepeatUntil: TRepeatUntil): Boolean;
38 function ParseForToDo(Block: TBlock; out ForToDo: TForToDo): Boolean;
39 function ParseBreak(Block: TBlock; out BreakCmd: TBreak): Boolean;
40 function ParseContinue(Block: TBlock; out ContinueCmd: TContinue): Boolean;
41 end;
42
43
44implementation
45
46resourcestring
47 SExpectedFunctionParameter = 'Expected function parameter.';
48 SExpectedProcedureParameter = 'Expected procedure parameter.';
49 SFunctionParameterMismatch = 'Function parameter mismatch.';
50 SUnexpectedToken = 'Unexpected token %s';
51
52function TParserPascal.ParseBeginEnd(Block: TBlock; out BeginEnd: TBeginEnd): Boolean;
53var
54 Command: TCommand;
55begin
56 if Tokenizer.CheckNextAndRead('begin', tkKeyword) then begin
57 BeginEnd := TBeginEnd.Create;
58 Result := True;
59 while not Tokenizer.CheckNext('end', tkKeyword) do begin
60 if ParseCommand(Block, Command) then begin
61 Command.Parent := BeginEnd;
62 BeginEnd.Commands.Add(Command);
63 Tokenizer.Expect(';', tkSpecialSymbol);
64 end else begin
65 Error(Format(SUnexpectedToken, [Tokenizer.GetNext.Text]));
66 Result := False;
67 Break;
68 end;
69 end;
70 Tokenizer.Expect('end', tkKeyword);
71 end else Result := False;
72end;
73
74function TParserPascal.ParseFunctionCall(Block: TBlock; out FunctionCall: TFunctionCall
75 ): Boolean;
76var
77 Token: TToken;
78 LastPos: TTokenizerPos;
79 FunctionDef: TFunction;
80 Expression: TExpression;
81 I: Integer;
82begin
83 LastPos := Tokenizer.Pos;
84 Token := Tokenizer.GetNext;
85 if Token.Kind = tkIdentifier then begin
86 FunctionDef := Block.GetFunction(Token.Text);
87 if Assigned(FunctionDef) then begin
88 FunctionCall := TFunctionCall.Create;
89 FunctionCall.FunctionDef := FunctionDef;
90 if Tokenizer.CheckNextAndRead('(', tkSpecialSymbol) then begin
91 for I := 0 to FunctionDef.Params.Count - 1 do begin
92 if I > 0 then Tokenizer.Expect(',', tkSpecialSymbol);
93 if ParseExpression(Block, Expression) then begin
94 if Expression.GetType = TFunctionParameter(FunctionDef.Params[I]).TypeRef then
95 FunctionCall.Params.Add(Expression)
96 else Error(SFunctionParameterMismatch);
97 end else Error(SExpectedFunctionParameter);
98 end;
99 Tokenizer.Expect(')', tkSpecialSymbol);
100 end;
101 Result := True;
102 end else begin
103 Result := False;
104 Tokenizer.Pos := LastPos;
105 end;
106 end else begin
107 Result := False;
108 Tokenizer.Pos := LastPos;
109 end;
110end;
111
112function TParserPascal.ParseProcedureCall(Block: TBlock; out
113 ProcedureCall: TProcedureCall): Boolean;
114var
115 Token: TToken;
116 LastPos: TTokenizerPos;
117 ProcedureDef: TProcedure;
118 Expression: TExpression;
119 I: Integer;
120begin
121 LastPos := Tokenizer.Pos;
122 Token := Tokenizer.GetNext;
123 if Token.Kind = tkIdentifier then begin
124 ProcedureDef := Block.GetProcedure(Token.Text);
125 if Assigned(ProcedureDef) then begin
126 ProcedureCall := TProcedureCall.Create;
127 ProcedureCall.ProcedureDef := ProcedureDef;
128 if Tokenizer.CheckNextAndRead('(', tkSpecialSymbol) then begin
129 for I := 0 to ProcedureDef.Params.Count - 1 do begin
130 if I > 0 then Tokenizer.Expect(',', tkSpecialSymbol);
131 if ParseExpression(Block, Expression) then begin
132 if Expression.GetType = TFunctionParameter(ProcedureDef.Params[I]).TypeRef then
133 ProcedureCall.Params.Add(Expression)
134 else Error(SFunctionParameterMismatch);
135 end else Error(SExpectedProcedureParameter);
136 end;
137 Tokenizer.Expect(')', tkSpecialSymbol);
138 end;
139 Result := True;
140 end else begin
141 Result := False;
142 Tokenizer.Pos := LastPos;
143 end;
144 end else begin
145 Result := False;
146 Tokenizer.Pos := LastPos;
147 end;
148end;
149
150function TParserPascal.ParseCommand(Block: TBlock; out Command: TCommand): Boolean;
151var
152 BeginEnd: TBeginEnd;
153 FunctionCall: TFunctionCall;
154 ProcedureCall: TProcedureCall;
155 Assignment: TAssignment;
156 IfThenElse: TIfThenElse;
157 WhileDo: TWhileDo;
158 ForToDo: TForToDo;
159 RepeatUntil: TRepeatUntil;
160 BreakCmd: TBreak;
161 ContinueCmd: TContinue;
162begin
163 if ParseIfThenElse(Block, IfThenElse) then begin
164 Result := True;
165 Command := IfThenElse;
166 end else
167 if ParseWhileDo(Block, WhileDo) then begin
168 Result := True;
169 Command := WhileDo;
170 end else
171 if ParseForToDo(Block, ForToDo) then begin
172 Result := True;
173 Command := ForToDo;
174 end else
175 if ParseBeginEnd(Block, BeginEnd) then begin
176 Result := True;
177 Command := BeginEnd;
178 end else
179 if ParseFunctionCall(Block, FunctionCall) then begin
180 Result := True;
181 Command := FunctionCall;
182 end else
183 if ParseProcedureCall(Block, ProcedureCall) then begin
184 Result := True;
185 Command := ProcedureCall;
186 end else
187 if ParseRepeatUntil(Block, RepeatUntil) then begin
188 Result := True;
189 Command := RepeatUntil;
190 end else
191 if ParseAssignment(Block, Assignment) then begin
192 Result := True;
193 Command := Assignment;
194 end else
195 if ParseBreak(Block, BreakCmd) then begin
196 Result := True;
197 Command := BreakCmd;
198 end else
199 if ParseContinue(Block, ContinueCmd) then begin
200 Result := True;
201 Command := ContinueCmd;
202 end else
203 Result := False;
204end;
205
206function TParserPascal.ParseProgram(SystemBlock: TBlock; out Prog: TProgram): Boolean;
207var
208 Block: TBlock;
209 Token: TToken;
210begin
211 Result := False;
212 Prog := TProgram.Create;
213 Prog.SystemBlock.Free;
214 Prog.SystemBlock := SystemBlock;
215 if Tokenizer.CheckNextAndRead('program', tkKeyword) then begin
216 Token := Tokenizer.GetNext;
217 if Token.Kind = tkIdentifier then
218 Prog.Name := Token.Text;
219 Tokenizer.Expect(';', tkSpecialSymbol);
220 end;
221 if ParseBlock(SystemBlock, Block) then begin
222 Result := True;
223 Prog.Block.Free;
224 Prog.Block := Block;
225 Block.Parent := Prog;
226 Tokenizer.Expect('.', tkSpecialSymbol);
227 end else begin
228 FreeAndNil(Prog);
229 Error('Expected begin-end block.');
230 end;
231end;
232
233function TParserPascal.ParseBlock(ParentBlock: TBlock; out Block: TBlock; ExistingBlock: TBlock = nil): Boolean;
234var
235 BeginEnd: TBeginEnd;
236 Func: TFunction;
237 Proc: TProcedure;
238begin
239 Result := False;
240 if Assigned(ExistingBlock) then Block := ExistingBlock
241 else Block := TBlock.Create;
242 Block.ParentBlock := ParentBlock;
243 while True do begin
244 if ParseBlockVar(Block) then begin
245 end else
246 if ParseBlockConst(Block) then begin
247 end else
248 if ParseFunction(Block, Func) then begin
249 Block.Functions.Add(Func);
250 end else
251 if ParseProcedure(Block, Proc) then begin
252 Block.Procedures.Add(Proc);
253 end else
254 begin
255 Break;
256 end;
257 end;
258 if ParseBeginEnd(Block, BeginEnd) then begin
259 Result := True;
260 Block.BeginEnd.Free;
261 Block.BeginEnd := BeginEnd;
262 BeginEnd.Parent := Block;
263 end else begin
264 if not Assigned(ExistingBlock) then Block.Free;
265 Block := nil;
266 end;
267end;
268
269function TParserPascal.ParseBlockVar(Block: TBlock): Boolean;
270var
271 Token: TToken;
272 Variable: TVariable;
273 TypeRef: TType;
274begin
275 if Tokenizer.CheckNextAndRead('var', tkKeyword) then begin
276 Result := True;
277 while Tokenizer.CheckNextKind(tkIdentifier) do begin
278 Token := Tokenizer.GetNext;
279 if Token.Kind = tkIdentifier then begin
280 Variable := Block.Variables.SearchByName(Token.Text);
281 if not Assigned(Variable) then begin
282 Variable := TVariable.Create;
283 Variable.Name := Token.Text;
284 Block.Variables.Add(Variable);
285 Tokenizer.Expect(':', tkSpecialSymbol);
286 Token := Tokenizer.GetNext;
287 if Token.Kind = tkIdentifier then begin
288 TypeRef := Block.GetType(Token.Text);
289 if Assigned(TypeRef) then begin
290 Variable.TypeRef := TypeRef;
291 end else Error('Type ' + Token.Text + ' not found.');
292 end;
293 end else Error('Variable ' + Token.Text + ' redefined.');
294 Tokenizer.Expect(';', tkSpecialSymbol);
295 end else begin
296 Error('Expected variable name but ' + Token.Text + ' found.');
297 Break;
298 end;
299 end;
300 end else Result := False;
301end;
302
303function TParserPascal.ParseBlockConst(Block: TBlock): Boolean;
304var
305 Token: TToken;
306 Constant: TConstant;
307 TypeRef: TType;
308begin
309 if Tokenizer.CheckNextAndRead('const', tkKeyword) then begin
310 Result := True;
311 while Tokenizer.CheckNextKind(tkIdentifier) do begin
312 Token := Tokenizer.GetNext;
313 if Token.Kind = tkIdentifier then begin
314 Constant := Block.Constants.SearchByName(Token.Text);
315 if not Assigned(Constant) then begin
316 Constant := TConstant.Create;
317 Constant.Name := Token.Text;
318 Block.Constants.Add(Constant);
319 Tokenizer.Expect(':', tkSpecialSymbol);
320 Token := Tokenizer.GetNext;
321 if Token.Kind = tkIdentifier then begin
322 TypeRef := Block.GetType(Token.Text);
323 if Assigned(TypeRef) then begin
324 Constant.TypeRef := TypeRef;
325 end else Error('Type ' + Token.Text + ' not found.');
326 end;
327 Tokenizer.Expect('=', tkSpecialSymbol);
328 Token := Tokenizer.GetNext;
329 if Token.Kind = tkNumber then begin
330 Constant.Value := TValueInteger.Create;
331 TValueInteger(Constant.Value).Value := StrToInt(Token.Text);
332 end else
333 if Token.Kind = tkString then begin
334 Constant.Value := TValueString.Create;
335 TValueString(Constant.Value).Value := Token.Text;
336 end else Error('Expected string or number.');
337 end else Error('Constant ' + Token.Text + ' redefined.');
338 Tokenizer.Expect(';', tkSpecialSymbol);
339 end else begin
340 Error('Expected constant name but ' + Token.Text + ' found.');
341 Break;
342 end;
343 end;
344 end else Result := False;
345end;
346
347function TParserPascal.ParseFunction(Block: TBlock; out Func: TFunction): Boolean;
348var
349 Token: TToken;
350 NewBlock: TBlock;
351 TypeRef: TType;
352 Variable: TVariable;
353 FunctionParameters: TFunctionParameters;
354begin
355 Result := False;
356 if Tokenizer.CheckNextAndRead('function', tkKeyword) then begin
357 Result := True;
358 Func := TFunction.Create;
359 Token := Tokenizer.GetNext;
360 if Token.Kind = tkIdentifier then begin
361 Func.Name := Token.Text;
362 Func.Block.ParentBlock := Block;
363 if ParseFunctionParameters(Func.Block, FunctionParameters) then begin
364 Func.Params.Free;
365 Func.Params := FunctionParameters;
366 end;
367
368 if Tokenizer.CheckNextAndRead(':', tkSpecialSymbol) then begin
369 Token := Tokenizer.GetNext;
370 if Token.Kind = tkIdentifier then begin
371 TypeRef := Block.GetType(Token.Text);
372 if Assigned(TypeRef) then begin
373 Func.ResultType := TypeRef;
374 end else Error('Type ' + Token.Text + ' not found');
375 end;
376 end;
377 Tokenizer.Expect(';', tkSpecialSymbol);
378 Func.InitVariables;
379 if ParseBlock(Block, NewBlock, Func.Block) then begin
380 Tokenizer.Expect(';', tkSpecialSymbol);
381 end else Error('Expected function block');
382 end else Error('Expected function name');
383 end;
384end;
385
386function TParserPascal.ParseFunctionParameters(Block: TBlock;
387 out Params: TFunctionParameters): Boolean;
388var
389 FunctionParameter: TFunctionParameter;
390 I: Integer;
391 Variable: TVariable;
392begin
393 Result := False;
394 Params := TFunctionParameters.Create;
395 if Tokenizer.CheckNextAndRead('(', tkSpecialSymbol) then begin
396 while not Tokenizer.CheckNext(')', tkSpecialSymbol) do begin
397 if Params.Count > 0 then Tokenizer.Expect(',', tkSpecialSymbol);
398 if ParseFunctionParameter(Block, FunctionParameter) then begin
399 Params.Add(FunctionParameter);
400 end else Error(SExpectedFunctionParameter);
401 end;
402 Tokenizer.Expect(')', tkSpecialSymbol);
403 Result := True;
404 end;
405end;
406
407function TParserPascal.ParseFunctionParameter(Block: TBlock; out Parameter: TFunctionParameter
408 ): Boolean;
409var
410 Token: TToken;
411 TypeRef: TType;
412 ParamKind: TFunctionParamKind;
413begin
414 Result := True;
415 if Tokenizer.CheckNext('var', tkKeyword) then begin
416 Tokenizer.GetNext;
417 ParamKind := pkVar;
418 end;
419 Token := Tokenizer.GetNext;
420 if Token.Kind = tkIdentifier then begin
421 Parameter := TFunctionParameter.Create;
422 Parameter.Kind := ParamKind;
423 Parameter.Name := Token.Text;
424 Tokenizer.Expect(':', tkSpecialSymbol);
425 Token := Tokenizer.GetNext;
426 if Token.Kind = tkIdentifier then begin
427 TypeRef := Block.GetType(Token.Text);
428 if Assigned(TypeRef) then begin
429 Parameter.TypeRef := TypeRef;
430 end else Error('Type ' + Token.Text + ' not found');
431 end else Error('Expected parameter type');
432 end else Error('Expected parameter name');
433end;
434
435function TParserPascal.ParseProcedure(Block: TBlock; out Proc: TProcedure
436 ): Boolean;
437var
438 Token: TToken;
439 NewBlock: TBlock;
440 FunctionParameters: TFunctionParameters;
441begin
442 Result := False;
443 if Tokenizer.CheckNextAndRead('procedure', tkKeyword) then begin
444 Result := True;
445 Proc := TProcedure.Create;
446 Token := Tokenizer.GetNext;
447 if Token.Kind = tkIdentifier then begin
448 Proc.Name := Token.Text;
449 Proc.Block.ParentBlock := Block;
450 if ParseFunctionParameters(Proc.Block, FunctionParameters) then begin
451 Proc.Params.Free;
452 Proc.Params := FunctionParameters;
453 end;
454 Tokenizer.Expect(';', tkSpecialSymbol);
455 Proc.InitVariables;
456 if ParseBlock(Block, NewBlock, Proc.Block) then begin
457 Tokenizer.Expect(';', tkSpecialSymbol);
458 end else Error('Expected procedure block');
459 end else Error('Expected procedure name');
460 end;
461end;
462
463function TParserPascal.ParseAssignment(Block: TBlock; out Assignment: TAssignment): Boolean;
464var
465 Token: TToken;
466 Variable: TVariable;
467 Expression: TExpression;
468 LastPos: TTokenizerPos;
469begin
470 LastPos := Tokenizer.Pos;
471 Result := False;
472 Token := Tokenizer.GetNext;
473 if Token.Kind = tkIdentifier then begin
474 Variable := Block.GetVariable(Token.Text);
475 if Assigned(Variable) then begin
476 Result := True;
477 Assignment := TAssignment.Create;
478 Assignment.Variable := Variable;
479 Tokenizer.Expect(':=', tkSpecialSymbol);
480 if ParseExpression(Block, Expression) then begin
481 if Expression.GetType = Variable.TypeRef then begin
482 Assignment.Expression.Free;
483 Assignment.Expression := Expression;
484 Expression.Parent := Assignment;
485 end else begin
486 Result := False;
487 Error('Assignment type mismatch. Expected ' + Variable.TypeRef.Name + ' but got ' + Expression.GetType.Name);
488 end;
489 end;
490 if not Result then Assignment.Free;
491 end else Error('Variable ' + Token.Text + ' not defined.');
492 end;
493 if not Result then Tokenizer.Pos := LastPos;
494end;
495
496function TParserPascal.ParseExpression(Block: TBlock; out Expression: TExpression;
497 WithOperation: Boolean = True): Boolean;
498var
499 ExpressionOperation: TExpressionOperation;
500 ExpressionOperand: TExpressionOperand;
501 ExpressionBrackets: TExpressionBrackets;
502begin
503 Result := False;
504 if WithOperation and ParseExpressionOperation(Block, ExpressionOperation) then begin
505 Result := True;
506 Expression := ExpressionOperation;
507 end else
508 if ParseExpressionBrackets(Block, ExpressionBrackets) then begin
509 Result := True;
510 Expression := ExpressionBrackets;
511 end else
512 if ParseExpressionOperand(Block, ExpressionOperand) then begin
513 Result := True;
514 Expression := ExpressionOperand;
515 end;
516end;
517
518function TParserPascal.ParseExpressionOperation(Block: TBlock; out
519 ExpressionOperation: TExpressionOperation): Boolean;
520var
521 Expression: TExpression;
522 Token: TToken;
523 LastPos: TTokenizerPos;
524 I: Integer;
525 ExpectedType: TType;
526begin
527 Result := False;
528 LastPos := Tokenizer.Pos;
529 if ParseExpression(Block, Expression, False) then begin
530 Token := Tokenizer.GetNext;
531 if Tokenizer.IsOperator(Token.Text) then begin
532 Result := True;
533 ExpressionOperation := TExpressionOperation.Create;
534 ExpressionOperation.Items.Add(Expression);
535 ExpressionOperation.TypeRef := Expression.GetType;
536 ExpressionOperation.Operation := GetOperatorByName(Token.Text);
537 if ExpressionOperation.Operation = eoNone then
538 Error('Unsupported operator ' + Token.Text);
539 ExpressionOperation.FunctionRef := ExpressionOperation.TypeRef.Functions.SearchByName(ExpressionOperation.GetFunctionName);
540 if Assigned(ExpressionOperation.FunctionRef) then begin
541 if not Assigned(ExpressionOperation.FunctionRef.ResultType) then
542 raise Exception.Create('Missing result type for function');
543 ExpressionOperation.TypeRef := ExpressionOperation.FunctionRef.ResultType;
544 I := 1;
545 if ParseExpression(Block, Expression) then begin
546 ExpectedType := TFunctionParameter(ExpressionOperation.FunctionRef.Params[I]).TypeRef;
547 if Expression.GetType = ExpectedType then
548 ExpressionOperation.Items.Add(Expression)
549 else Error('Expression operands needs to be same type. Expected ' + ExpectedType.Name + ' but found ' + Expression.GetType.Name);
550 end else Error('Missing operand.');
551 end else Error('Operator ' + Token.Text + ' not defind for type ' + ExpressionOperation.TypeRef.Name + '.');
552 end else Expression.Free;
553 end;
554 if not Result then Tokenizer.Pos := LastPos;
555end;
556
557function TParserPascal.ParseExpressionOperand(Block: TBlock; out
558 ExpressionOperand: TExpressionOperand): Boolean;
559var
560 Variable: TVariable;
561 Constant: TConstant;
562 FunctionCall: TFunctionCall;
563begin
564 Result := False;
565 if ParseFunctionCall(Block, FunctionCall) then begin
566 Result := True;
567 ExpressionOperand := TExpressionOperand.Create;
568 ExpressionOperand.FunctionCall := FunctionCall;
569 ExpressionOperand.OperandType := otFunctionCall;
570 end else
571 if ParseConstant(Block, Constant) then begin
572 Result := True;
573 ExpressionOperand := TExpressionOperand.Create;
574 ExpressionOperand.ConstantDirect := Constant;
575 ExpressionOperand.OperandType := otConstantDirect;
576 end else
577 if ParseConstantRef(Block, Constant) then begin
578 Result := True;
579 ExpressionOperand := TExpressionOperand.Create;
580 ExpressionOperand.ConstantRef := Constant;
581 ExpressionOperand.OperandType := otConstantRef;
582 end else
583 if ParseVariable(Block, Variable) then begin
584 Result := True;
585 ExpressionOperand := TExpressionOperand.Create;
586 ExpressionOperand.VariableRef := Variable;
587 ExpressionOperand.OperandType := otVariableRef;
588 end else
589 Error('Expected expression operand.');
590end;
591
592function TParserPascal.ParseExpressionBrackets(Block: TBlock; out
593 ExpressionBrackets: TExpressionBrackets): Boolean;
594var
595 Expression: TExpression;
596begin
597 Result := False;
598 if Tokenizer.CheckNextAndRead('(', tkSpecialSymbol) then begin
599 Result := True;
600 if ParseExpression(Block, Expression) then begin
601 ExpressionBrackets := TExpressionBrackets.Create;
602 ExpressionBrackets.Expression := Expression;
603 end;
604 Tokenizer.Expect(')', tkSpecialSymbol);
605 end;
606end;
607
608function TParserPascal.ParseConstantRef(Block: TBlock; out ConstantRef: TConstant
609 ): Boolean;
610var
611 LastPos: TTokenizerPos;
612 Token: TToken;
613begin
614 Result := False;
615 LastPos := Tokenizer.Pos;
616 Token := Tokenizer.GetNext;
617 if Token.Kind = tkIdentifier then begin;
618 ConstantRef := Block.GetConstant(Token.Text);
619 if Assigned(ConstantRef) then begin
620 Result := True;
621 end;
622 end;
623 if not Result then Tokenizer.Pos := LastPos;
624end;
625
626function TParserPascal.ParseConstant(Block: TBlock; out ConstantRef: TConstant
627 ): Boolean;
628var
629 LastPos: TTokenizerPos;
630 Token: TToken;
631begin
632 Result := False;
633 LastPos := Tokenizer.Pos;
634 Token := Tokenizer.GetNext;
635 if Token.Kind = tkNumber then begin
636 Result := True;
637 ConstantRef := TConstant.Create;
638 ConstantRef.TypeRef := Block.GetType('Integer');
639 ConstantRef.Value := TValueInteger.Create;
640 TValueInteger(ConstantRef.Value).Value := StrToInt(Token.Text);
641 end else
642 if Token.Kind = tkString then begin
643 Result := True;
644 ConstantRef := TConstant.Create;
645 ConstantRef.TypeRef := Block.GetType('string');
646 ConstantRef.Value := TValueString.Create;
647 TValueString(ConstantRef.Value).Value := Token.Text;
648 end;
649 if not Result then Tokenizer.Pos := LastPos;
650end;
651
652function TParserPascal.ParseVariable(Block: TBlock; out VariableRef: TVariable
653 ): Boolean;
654var
655 LastPos: TTokenizerPos;
656 Token: TToken;
657begin
658 Result := False;
659 LastPos := Tokenizer.Pos;
660 Token := Tokenizer.GetNext;
661 if Token.Kind = tkIdentifier then begin;
662 VariableRef := Block.GetVariable(Token.Text);
663 if Assigned(VariableRef) then begin
664 Result := True;
665 end;
666 end;
667 if not Result then Tokenizer.Pos := LastPos;
668end;
669
670function TParserPascal.ParseIfThenElse(Block: TBlock; out IfThenElse: TIfThenElse
671 ): Boolean;
672var
673 Expression: TExpression;
674 Command: TCommand;
675begin
676 Result := False;
677 if Tokenizer.CheckNextAndRead('if', tkKeyword) then begin
678 Result := True;
679 IfThenElse := TIfThenElse.Create;
680 if ParseExpression(Block, Expression) then begin
681 IfThenElse.Expression.Free;
682 IfThenElse.Expression := Expression;
683 Tokenizer.Expect('then', tkKeyword);
684 if ParseCommand(Block, Command) then begin
685 IfThenElse.CommandThen.Free;
686 IfThenElse.CommandThen := Command;
687 Command.Parent := IfThenElse;
688 if Tokenizer.CheckNextAndRead('else', tkKeyword) then begin
689 if ParseCommand(Block, Command) then begin
690 IfThenElse.CommandElse.Free;
691 IfThenElse.CommandElse := Command;
692 Command.Parent := IfThenElse;
693 end else Error('Expected command');
694 end;
695 end else Error('Expected command');
696 end else Error('Expected expression');
697 end;
698end;
699
700function TParserPascal.ParseWhileDo(Block: TBlock; out WhileDo: TWhileDo): Boolean;
701var
702 Expression: TExpression;
703 Command: TCommand;
704begin
705 Result := False;
706 if Tokenizer.CheckNextAndRead('while', tkKeyword) then begin
707 Result := True;
708 WhileDo := TWhileDo.Create;
709 if ParseExpression(Block, Expression) then begin
710 WhileDo.Expression.Free;
711 WhileDo.Expression := Expression;
712 Tokenizer.Expect('do', tkKeyword);
713 if ParseCommand(Block, Command) then begin
714 WhileDo.Command.Free;
715 WhileDo.Command := Command;
716 Command.Parent := WhileDo;
717 end else Error('Expected command');
718 end else Error('Expected expression');
719 end;
720end;
721
722function TParserPascal.ParseRepeatUntil(Block: TBlock; out RepeatUntil: TRepeatUntil
723 ): Boolean;
724var
725 Expression: TExpression;
726 Command: TCommand;
727begin
728 Result := False;
729 if Tokenizer.CheckNextAndRead('repeat', tkKeyword) then begin
730 RepeatUntil := TRepeatUntil.Create;
731 Result := True;
732 while not Tokenizer.CheckNext('until', tkKeyword) do begin
733 if ParseCommand(Block, Command) then begin
734 RepeatUntil.Commands.Add(Command);
735 Command.Parent := RepeatUntil;
736 Tokenizer.Expect(';', tkSpecialSymbol);
737 end else begin
738 Error('Unexpected token ' + Tokenizer.GetNext.Text);
739 Result := False;
740 Break;
741 end;
742 end;
743 Tokenizer.Expect('until', tkKeyword);
744 if ParseExpression(Block, Expression) then begin
745 RepeatUntil.Expression.Free;
746 RepeatUntil.Expression := Expression;
747 end else Error('Expected expression');
748 end else Result := False;
749end;
750
751function TParserPascal.ParseForToDo(Block: TBlock; out ForToDo: TForToDo): Boolean;
752var
753 Expression: TExpression;
754 VariableRef: TVariable;
755 Command: TCommand;
756begin
757 Result := False;
758 if Tokenizer.CheckNextAndRead('for', tkKeyword) then begin
759 Result := True;
760 ForToDo := TForToDo.Create;
761 if ParseVariable(Block, VariableRef) then begin
762 ForToDo.VariableRef := VariableRef;
763 Tokenizer.Expect(':=', tkSpecialSymbol);
764 if ParseExpression(Block, Expression) then begin
765 ForToDo.ExpressionFrom.Free;
766 ForToDo.ExpressionFrom := Expression;
767 Tokenizer.Expect('to', tkKeyword);
768 if ParseExpression(Block, Expression) then begin
769 ForToDo.ExpressionTo.Free;
770 ForToDo.ExpressionTo := Expression;
771 Tokenizer.Expect('do', tkKeyword);
772 if ParseCommand(Block, Command) then begin
773 ForToDo.Command.Free;
774 ForToDo.Command := Command;
775 Command.Parent := ForToDo;
776 end else Error('Expected command.');
777 end else Error('Expected expression.');
778 end else Error('Expected expression.');
779 end else Error('Expected control variable.');
780 end;
781end;
782
783function TParserPascal.ParseBreak(Block: TBlock; out BreakCmd: TBreak): Boolean;
784begin
785 Result := False;
786 if Tokenizer.CheckNextAndRead('break', tkKeyword) then begin
787 Result := True;
788 BreakCmd := TBreak.Create;
789 end;
790end;
791
792function TParserPascal.ParseContinue(Block: TBlock; out ContinueCmd: TContinue
793 ): Boolean;
794begin
795 Result := False;
796 if Tokenizer.CheckNextAndRead('continue', tkKeyword) then begin
797 Result := True;
798 ContinueCmd := TContinue.Create;
799 end;
800end;
801
802end.
803
Note: See TracBrowser for help on using the repository browser.