source: branches/interpreter/interpreter3/Parser.pas

Last change on this file was 103, checked in by chronos, 8 years ago
  • Moved: All projects moved to subfolders for better maintenance of multiple projects.
File size: 21.1 KB
Line 
1unit Parser;
2
3{$mode delphi}
4
5interface
6
7uses
8 Source;
9
10procedure ParseProgram(ProgramCode: PProgramCode);
11
12
13var
14 InnerText: string;
15 InnerTextPos: Integer;
16
17implementation
18
19type
20 TTokenType = (ttNormal, ttSpecialSymbol, ttString, ttConstant, ttNumber, ttChar);
21
22var
23 InputText: string;
24 InputTextPos: Integer;
25 LastTokenType: TTokenType;
26
27 MainProgram: PProgramCode;
28 FunctionContext: PFunction;
29
30function ParseIfThen(IfThenElse: PIfThenElse): Boolean; forward;
31function ParseWhileDo(WhileDo: PWhileDo): Boolean; forward;
32function ParseExecution(Execution: PExecution): Boolean; forward;
33function ParseBeginEnd(BeginEnd: PBeginEnd): Boolean; forward;
34function ParseGetValue(GetValue: PGetValue; NoExpression: Boolean = False): Boolean; forward;
35
36
37function IsWhiteSpace(C: Char): Boolean;
38begin
39 Result := (C = ' ') or (C = #13) or (C = #10) or (C = #9);
40end;
41
42function IsDigit(C: Char): Boolean;
43begin
44 Result := (C >= '0') and (C <= '9');
45end;
46
47function IsSpecialSymbol(C: Char): Boolean;
48begin
49 Result := (C = ';') or (C = '(') or (C = ')') or (C = ':') or (C = '=') or
50 (C = '+') or (C = '-') or (C = ';') or (C = '.');
51end;
52
53function IsSpecialSymbolLong(Text: string): Boolean;
54begin
55 Result := (Text = ':=') or (Text = '<>') or (Text = '>=') or (Text = '<=');
56end;
57
58procedure ShowError(Text: string);
59begin
60 WriteLn(Text);
61 WriteLn(Copy(InputText, InputTextPos, 10));
62 Halt;
63end;
64
65procedure ReadInputAll;
66var
67 LastC: Char;
68 C: Char;
69 Inner: Boolean;
70begin
71 LastC := #0;
72 InputTextPos := 1;
73 InputText := '';
74 InnerTextPos := 1;
75 InnerText := '';
76 Inner := False;
77 while not Eof do begin
78 Read(C);
79 if ((LastC = #0) or (LastC = #13) or (LastC = #10)) and (C = '|') then begin
80 Inner := True;
81 LastC := C;
82 Continue;
83 end else
84 if ((LastC = #0) or (LastC = #13) or (LastC = #10)) and (C <> '|') then begin
85 Inner := False;
86 end;
87 if Inner then InnerText := InnerText + C
88 else InputText := InputText + C;
89 LastC := C;
90 end;
91end;
92
93function ReadChar: Char;
94begin
95 if InputTextPos >= Length(InputText) then ShowError('Premature end of source');
96 Result := InputText[InputTextPos];
97 InputTextPos := InputTextPos + 1;
98end;
99
100function StrToInt(S: string): Integer;
101var
102 I: Integer;
103 N: Integer;
104begin
105 Result := 0;
106 N := 1;
107 I := Length(S);
108 while I >= 1 do begin
109 Result := Result + (Ord(S[I]) - Ord('0')) * N;
110 N := N * 10;
111 I := I - 1;
112 end;
113end;
114
115function IntToStr(Value: Integer): string;
116begin
117 Result := '';
118 while Value > 0 do begin
119 Result := Chr(Ord('0') + Value mod 10) + Result;
120 Value := Value div 10;
121 end;
122end;
123
124function ReadNext: string;
125var
126 C: Char;
127begin
128 Result := '';
129 LastTokenType := ttNormal;
130 repeat
131 C := ReadChar;
132 if LastTokenType = ttString then begin
133 if C = '''' then begin
134 Break;
135 end else Result := Result + C;
136 end else
137 if LastTokenType = ttNumber then begin
138 if not IsDigit(C) then begin
139 if Result[1] = '#' then begin
140 Result := Chr(StrToInt(Copy(Result, 2, Length(Result))));
141 LastTokenType := ttChar;
142 end;
143 InputTextPos := InputTextPos - 1;
144 Break;
145 end else Result := Result + C;
146 end else begin
147 if IsWhiteSpace(C) then begin
148 if Result = '' then Continue
149 else begin
150 Break;
151 end;
152 end else
153 if IsSpecialSymbol(C) then begin
154 if Result = '' then begin
155 LastTokenType := ttSpecialSymbol;
156 Result := Result + C;
157 C := ReadChar;
158 if IsSpecialSymbolLong(Result + C) then begin
159 Result := Result + C;
160 Break;
161 end else InputTextPos := InputTextPos - 1;
162 Break;
163 end else begin
164 InputTextPos := InputTextPos - 1;
165 Break;
166 end;
167 end else
168 if C = '#' then begin
169 Result := Result + '#';
170 LastTokenType := ttNumber;
171 end else
172 if C = '''' then begin
173 LastTokenType := ttString;
174 end else begin
175 Result := Result + C;
176 end;
177 end;
178 until False;
179end;
180
181function CheckNext(Text: string): Boolean;
182var
183 Next: string;
184 OldPos: Integer;
185begin
186 OldPos := InputTextPos;
187 Next := ReadNext;
188 Result := Next = Text;
189 InputTextPos := OldPos;
190end;
191
192procedure Expect(Text: string);
193var
194 Next: string;
195begin
196 Next := ReadNext;
197 if Next <> Text then
198 ShowError('Expected ' + Text + ' but found ' + Next);
199end;
200
201function IsLogicOperator(Text: string): Boolean;
202begin
203 Result := (Text = 'or') or (Text = 'and');
204end;
205
206function IsOperator(Text: string): Boolean;
207begin
208 Result := (Text = '+') or (Text = '-') or
209 (Text = '=') or (Text = '<>') or (Text = '>') or (Text = '<') or
210 (Text = '<=') or (Text = '>=');
211end;
212
213function ParseVariable(out Variable: PVariable): Boolean;
214var
215 OldPos: Integer;
216 Next: string;
217begin
218 OldPos := InputTextPos;
219 Next := ReadNext;
220 if FunctionContext = nil then
221 Variable := MainProgram^.Variables.GetByName(Next)
222 else Variable := FunctionContext^.Variables.GetByName(Next);
223 if Variable <> nil then begin
224 Result := True;
225 end else begin
226 Result := False;
227 InputTextPos := OldPos;
228 end;
229end;
230
231function ParseConstant(out Constant: PConstant): Boolean;
232var
233 OldPos: Integer;
234 Next: string;
235begin
236 OldPos := InputTextPos;
237 Next := ReadNext;
238 Constant := MainProgram^.Constants.GetByName(Next);
239 if Constant <> nil then begin
240 Result := True;
241 end else begin
242 Result := False;
243 InputTextPos := OldPos;
244 end;
245end;
246
247function GetOperatorType(Name: string): TOperator;
248var
249 I: Integer;
250begin
251 I := 0;
252 while (I < Length(OperatorString)) and (OperatorString[TOperator(I)] <> Name) do Inc(I);
253 if I < Length(OperatorString) then Result := TOperator(I)
254 else Result := opNone;
255end;
256
257function ParseOperator(out ExpOperator: TOperator): Boolean;
258var
259 OldPos: Integer;
260 OperatorName: string;
261begin
262 OldPos := InputTextPos;
263 OperatorName := ReadNext;
264 ExpOperator := GetOperatorType(OperatorName);
265 if ExpOperator <> opNone then begin
266 Result := True;
267
268 end else begin
269 InputTextPos := OldPos;
270 Result := False;
271 end;
272end;
273
274function ParseValue(Value: PConstant): Boolean;
275var
276 OldPos: Integer;
277 Text: string;
278begin
279 Result := True;
280 OldPos := InputTextPos;
281 Text := ReadNext;
282 if LastTokenType = ttString then begin
283 Value.DataType := MainProgram.Types.GetByName('string');
284 Value.ValueString := Text;
285 end else
286 if LastTokenType = ttChar then begin
287 Value.DataType := MainProgram.Types.GetByName('Char');
288 Value.ValueChar := Text[1];
289 end else
290 if LastTokenType = ttNumber then begin
291 Value.DataType := MainProgram.Types.GetByName('Integer');
292 //Value.ValueInteger := StrToInt(Text);
293 end else begin
294 Result := False;
295 InputTextPos := OldPos;
296 end;
297end;
298
299procedure DeleteExpressionItem(Expression: PExpression; Index: Integer);
300var
301 I: Integer;
302begin
303 I := Index;
304 while (I + 1) < Length(Expression^.Items) do begin
305 Expression^.Items[I] := Expression^.Items[I + 1];
306 I := I + 1;
307 end;
308 SetLength(Expression^.Items, Length(Expression^.Items) - 1);
309end;
310
311function ParseExpression(Expression: PExpression): Boolean;
312var
313 GetValue: TGetValue;
314 ExpOperator: TOperator;
315 SubExpression: TExpression;
316 I: Integer;
317 II: Integer;
318 FoundOperator: Boolean;
319 OldPos: Integer;
320begin
321 OldPos := InputTextPos;
322 Result := True;
323 FoundOperator := False;
324 repeat
325 if CheckNext('(') then begin
326 Expect('(');
327 SetLength(SubExpression.Items, 0);
328 if ParseExpression(@SubExpression) then begin
329 SetLength(Expression^.Items, Length(Expression^.Items) + 1);
330 Expression^.Items[Length(Expression^.Items) - 1] := SubExpression;
331 end;
332 Expect(')');
333 end else
334 if ParseOperator(ExpOperator) then begin
335 SetLength(Expression^.Items, Length(Expression^.Items) + 1);
336 Expression^.Items[Length(Expression^.Items) - 1].NodeType := ntOperator;
337 Expression^.Items[Length(Expression^.Items) - 1].OperatorType := ExpOperator;
338 FoundOperator := True;
339 end else
340 if ParseGetValue(@GetValue, True) then begin
341 SetLength(Expression^.Items, Length(Expression^.Items) + 1);
342 Expression^.Items[Length(Expression^.Items) - 1].NodeType := ntValue;
343 Expression^.Items[Length(Expression^.Items) - 1].Value := GetValue;
344 end else begin
345 Result:= True;
346 Break;
347 end;
348 until False;
349 if not FoundOperator then begin
350 Result := False;
351 InputTextPos := OldPos;
352 Exit;
353 end;
354
355 if Length(Expression^.Items) > 0 then begin
356 // Build expression tree using operator precedence
357 for II := 0 to Length(OperatorPrecedence) - 1 do begin
358 I := 0;
359 while (I < Length(Expression^.Items) - 1) do begin
360 if (TExpression(Expression^.Items[I]).NodeType = ntOperator) and
361 not TExpression(Expression^.Items[I]).Associated and
362 (TExpression(Expression^.Items[I]).OperatorType = OperatorPrecedence[II]) then
363 begin
364 if Expression^.Items[I].OperatorType = opNot then begin
365 Expression^.Items[I].Associated := True;
366 SetLength(Expression^.Items[I].Items, 1);
367 Expression^.Items[I].Items[0] := Expression^.Items[I + 1];
368 DeleteExpressionItem(Expression, I + 1);
369 end else begin
370 Expression^.Items[I].Associated := True;
371 SetLength(Expression^.Items[I].Items, 2);
372 Expression^.Items[I].Items[0] := Expression^.Items[I - 1];
373 Expression^.Items[I].Items[1] := Expression^.Items[I + 1];
374 DeleteExpressionItem(Expression, I + 1);
375 DeleteExpressionItem(Expression, I - 1);
376 end;
377 end else Inc(I);
378 end;
379 end;
380
381 if Length(Expression^.Items) = 1 then begin
382 Expression^.NodeType := Expression^.Items[0].NodeType;
383 Expression^.OperatorType := Expression^.Items[0].OperatorType;
384 Expression^.Value := Expression^.Items[0].Value;
385 // Move subtitem one node up
386 SetLength(Expression^.Items, Length(Expression^.Items[0].Items));
387 I := Length(Expression^.Items) - 1;
388 while I >= 0 do begin
389 Expression^.Items[I] := Expression^.Items[0].Items[I];
390 I := I - 1;
391 end;
392 end else ShowError('Expression error ' + IntToStr(Length(Expression^.Items)));
393 end;
394end;
395
396procedure AssignExpression(ExpDst, ExpSrc: PExpression);
397var
398 I: Integer;
399begin
400 ExpDst^.OperatorType := ExpSrc^.OperatorType;
401 ExpDst^.NodeType := ExpSrc^.NodeType;
402 ExpDst^.Associated := ExpSrc^.Associated;
403 ExpDst^.Value := ExpSrc^.Value;
404 SetLength(ExpDst^.Items, 1); //Length(ExpSrc^.Items));
405 for I := 0 to Length(ExpDst^.Items) - 1 do
406 ExpDst^.Items[I] := ExpSrc^.Items[I];
407end;
408
409function ParseGetValue(GetValue: PGetValue; NoExpression: Boolean = False): Boolean;
410var
411 Variable: PVariable;
412 Constant: PConstant;
413 FunctionCall: TExecution;
414 Expression: TExpression;
415 Value: TConstant;
416begin
417 FillChar(Expression, SizeOf(TExpression), 0);
418 FillChar(FunctionCall, SizeOf(TFunctionCall), 0);
419 FillChar(Value, SizeOf(TConstant), 0);
420
421 Result := True;
422 if not NoExpression and ParseExpression(@Expression) then begin
423 GetValue^.ReadType := rtExpression;
424 GetValue^.Expression := GetMem(SizeOf(TExpression));
425 FillChar(GetValue^.Expression^, SizeOf(TExpression), 0);
426 GetValue^.Expression^ := Expression;
427 //AssignExpression(GetValue^.Expression, @Expression);
428 end else
429 if ParseVariable(Variable) then begin
430 GetValue^.ReadType := rtVariable;
431 GetValue^.Variable := Variable;
432 end else
433 if ParseConstant(Constant) then begin
434 GetValue^.ReadType := rtConstant;
435 GetValue^.Constant := Constant;
436 end else
437 if ParseValue(@Value) then begin
438 GetValue^.ReadType := rtValue;
439 GetValue^.Value := Value;
440 end else
441 if ParseExecution(@FunctionCall) then begin
442 GetValue^.ReadType := rtFunctionCall;
443 GetValue^.FunctionCall := GetMem(SizeOf(TFunctionCall));
444 FillChar(GetValue^.FunctionCall^, SizeOf(TFunctionCall), 0);
445 GetValue^.FunctionCall^ := FunctionCall;
446 end else
447 Result := False;
448end;
449
450function ParseAssignment(Assignment: PAssignment): Boolean;
451var
452 Variable: PVariable;
453begin
454 if ParseVariable(Variable) then begin
455 Result := True;
456 Assignment^.Destination := Variable;
457 Expect(':=');
458 ParseGetValue(@Assignment^.Source);
459 end else begin
460 Result := False;
461 end;
462end;
463
464function ParseExecution(Execution: PExecution): Boolean;
465var
466 OldPos: Integer;
467 Next: string;
468 Func: PFunction;
469 I: Integer;
470begin
471 Result := True;
472 OldPos := InputTextPos;
473 Next := ReadNext;
474 Func := MainProgram.Functions.GetByName(Next);
475 if Func <> nil then begin
476 Execution^.Func := Func;
477 SetLength(Execution^.Parameters.Items, Length(Func^.Parameters.Items));
478 if Length(Func^.Parameters.Items) > 0 then begin
479 Expect('(');
480 I := 0;
481 while I < Length(Func^.Parameters.Items) do begin
482 ParseGetValue(@Execution^.Parameters.Items[I]);
483 if I < (Length(Func^.Parameters.Items) - 1) then Expect(',');
484 I := I + 1;
485 end;
486 Expect(')');
487 end;
488 end else begin
489 InputTextPos := OldPos;
490 Result := False;
491 end;
492end;
493
494function ParseCommand(Command: PCommand): Boolean;
495var
496 IfThenElse: TIfThenElse;
497 WhileDo: TWhileDo;
498 BeginEnd: TBeginEnd;
499 Execution: TExecution;
500 Assignment: TAssignment;
501begin
502 FillChar(IfThenElse, SizeOf(TIfThenElse), 0);
503 FillChar(WhileDo, SizeOf(TWhileDo), 0);
504 FillChar(BeginEnd, SizeOf(TBeginEnd), 0);
505 FillChar(Execution, SizeOf(TExecution), 0);
506 FillChar(Assignment, SizeOf(TAssignment), 0);
507
508 Result := True;
509 if ParseBeginEnd(@BeginEnd) then begin
510 Command^.BeginEnd := GetMem(SizeOf(TBeginEnd));
511 FillChar(Command^.BeginEnd^, SizeOf(TBeginEnd), 0);
512 Command^.BeginEnd^ := BeginEnd;
513 Command^.CmdType := ctBeginEnd;
514 end else
515 if ParseAssignment(@Assignment) then begin
516 Command^.Assignment := GetMem(SizeOf(TAssignment));
517 FillChar(Command^.Assignment^, SizeOf(TAssignment), 0);
518 Command^.Assignment^ := Assignment;
519 Command^.CmdType := ctAssignment;
520 end else
521 if ParseExecution(@Execution) then begin
522 Command^.Execution := GetMem(SizeOf(TExecution));
523 FillChar(Command^.Execution^, SizeOf(TExecution), 0);
524 Command^.Execution^ := Execution;
525 Command^.CmdType := ctExecution;
526 end else
527 if ParseIfThen(@IfThenElse) then begin
528 Command^.IfThenElse := GetMem(SizeOf(TIfThenElse));
529 FillChar(Command^.IfThenElse^, SizeOf(TIfThenElse), 0);
530 Command^.IfThenElse^ := IfThenElse;
531 Command^.CmdType := ctIfThenElse;
532 end else
533 if ParseWhileDo(@WhileDo) then begin
534 Command^.WhileDo := GetMem(SizeOf(TWhileDo));
535 FillChar(Command^.WhileDo^, SizeOf(TWhileDo), 0);
536 Command^.WhileDo^ := WhileDo;
537 Command^.CmdType := ctWhileDo;
538 end else Result := False;
539end;
540
541function ParseIfThen(IfThenElse: PIfThenElse): Boolean;
542begin
543 if CheckNext('if') then begin
544 Result := True;
545 Expect('if');
546 ParseGetValue(@IfThenElse.Condition);
547 Expect('then');
548 ParseCommand(@IfThenElse^.DoThen);
549 if CheckNext('else') then begin
550 Expect('else');
551 ParseCommand(@IfThenElse^.DoElse);
552 end;
553 end else Result := False;
554end;
555
556function ParseWhileDo(WhileDo: PWhileDo): Boolean;
557begin
558 if CheckNext('while') then begin
559 Result := True;
560 Expect('while');
561 ParseGetValue(@WhileDo.Condition);
562 Expect('do');
563 ParseCommand(@WhileDo^.Command);
564 end else Result := False;
565end;
566
567function ParseBeginEnd(BeginEnd: PBeginEnd): Boolean;
568var
569 Command: TCommand;
570begin
571 if CheckNext('begin') then begin
572 Result := True;
573 Expect('begin');
574 SetLength(BeginEnd^.Commands, 0);
575 repeat
576 if ParseCommand(@Command) then begin
577 BeginEnd^.Add;
578 BeginEnd^.GetLast^ := Command;
579 Expect(';');
580 end else
581 if CheckNext('end') then begin
582 Expect('end');
583 Break;
584 end else ShowError('Expected command but found ' + ReadNext);
585 until False;
586 end else Result := False;
587end;
588
589function ParseParams(Params: PFunctionParameters): Boolean;
590var
591 ParamName: string;
592 ParamTypeName: string;
593 ParamType: PType;
594begin
595 if CheckNext('(') then begin
596 Result := True;
597 Expect('(');
598 ParamName := ReadNext;
599 Expect(':');
600 ParamTypeName := ReadNext;
601 ParamType := MainProgram^.Types.GetByName(ParamTypeName);
602 if ParamType <> nil then begin
603 Params^.Add(FunctionParameterCreate(ParamName, ParamType));
604 FunctionContext^.Variables.Add(VariableCreate(ParamName, ParamType));
605 end else ShowError('Unknown parameter type ' + ParamTypeName);
606 Expect(')');
607 end else Result := False;
608end;
609
610function ParseVariableSection: Boolean;
611var
612 VarName: string;
613 VarTypeName: string;
614 VarType: PType;
615 OldPos: Integer;
616begin
617 if CheckNext('var') then begin
618 Result := True;
619 Expect('var');
620 repeat
621 OldPos := InputTextPos;
622 VarName := ReadNext;
623 if VarName = 'begin' then begin
624 InputTextPos := OldPos;
625 Break;
626 end else begin
627 Expect(':');
628 VarTypeName := ReadNext;
629 VarType := MainProgram^.Types.GetByName(VarTypeName);
630 if VarType <> nil then begin
631 if FunctionContext = nil then
632 MainProgram^.Variables.Add(VariableCreate(VarName, VarType))
633 else FunctionContext^.Variables.Add(VariableCreate(VarName, VarType));
634 end else ShowError('Unknown variable type ' + VarTypeName);
635 Expect(';');
636 end;
637 until False;
638 end else Result := False;
639end;
640
641function ParseFunction(Func: PFunction): Boolean;
642var
643 ReturnType: string;
644 DataType: PType;
645begin
646 if CheckNext('function') then begin
647 Result := True;
648 Expect('function');
649 FunctionContext := Func;
650 Func^.Name := ReadNext;
651 ParseParams(@Func^.Parameters);
652 Expect(':');
653 ReturnType := ReadNext;
654 DataType := MainProgram.Types.GetByName(ReturnType);
655 if DataType <> nil then Func^.ReturnType := DataType
656 else ShowError('Unknown type ' + ReturnType);
657 Expect(';');
658 Func^.Variables.Add(VariableCreate('Result', Func^.ReturnType));
659 if ParseVariableSection then begin
660 end;
661 ParseBeginEnd(@Func^.BeginEnd);
662 FunctionContext := nil;
663 Expect(';');
664 end else Result := False;
665end;
666
667function ParseProcedure(Func: PFunction): Boolean;
668begin
669 if CheckNext('procedure') then begin
670 Result := True;
671 Expect('procedure');
672 FunctionContext := Func;
673 Func^.Name := ReadNext;
674 ParseParams(@Func^.Parameters);
675 Expect(';');
676 if ParseVariableSection then begin
677 end;
678 ParseBeginEnd(@Func^.BeginEnd);
679 FunctionContext := nil;
680 Expect(';');
681 end else Result := False;
682end;
683
684procedure ParserInit(ProgramCode: PProgramCode);
685var
686 TypeString: PType;
687 TypeBoolean: PType;
688 TypeInteger: PType;
689 TypeChar: PType;
690 TypeArray: PType;
691 FuncWriteLn: PFunction;
692 FuncLength: PFunction;
693 FuncSetLength: PFunction;
694 FuncRead: PFunction;
695begin
696 SetLength(ProgramCode^.Types.Items, 0);
697 ProgramCode^.Types.Add(TypeCreate('string', btShortString));
698 TypeString := ProgramCode^.Types.GetLast;
699 ProgramCode^.Types.Add(TypeCreate('Boolean', btBoolean));
700 TypeBoolean := ProgramCode^.Types.GetLast;
701 ProgramCode^.Types.Add(TypeCreate('Integer', btInteger));
702 TypeInteger := ProgramCode^.Types.GetLast;
703 ProgramCode^.Types.Add(TypeCreate('Char', btChar));
704 TypeChar := ProgramCode^.Types.GetLast;
705 ProgramCode^.Types.Add(TypeCreate('Array', btArray));
706 TypeArray := ProgramCode^.Types.GetLast;
707
708 SetLength(ProgramCode^.Variables.Items, 0);
709
710 SetLength(ProgramCode^.Functions.Items, 0);
711 ProgramCode^.Functions.Add(FunctionCreate('Halt', nil));
712 ProgramCode^.Functions.Add(FunctionCreate('WriteLn', nil));
713 FuncWriteLn := ProgramCode^.Functions.GetLast;
714 FuncWriteLn^.Parameters.Add(FunctionParameterCreate('Text', TypeString));
715 FuncWriteLn^.Variables.Add(VariableCreate('Text', TypeString));
716 ProgramCode^.Functions.Add(FunctionCreate('Read', nil));
717 FuncRead := ProgramCode^.Functions.GetLast;
718 FuncRead^.Parameters.Add(FunctionParameterCreate('Output', TypeChar, True));
719 FuncRead^.Variables.Add(VariableCreate('Output', TypeChar));
720 ProgramCode^.Functions.Add(FunctionCreate('Eof', TypeBoolean));
721 ProgramCode^.Functions.Add(FunctionCreate('Length', TypeInteger));
722 FuncLength := ProgramCode^.Functions.GetLast;
723 FuncLength^.Parameters.Add(FunctionParameterCreate('Array', TypeArray));
724 FuncLength^.Variables.Add(VariableCreate('Array', TypeArray));
725 ProgramCode^.Functions.Add(FunctionCreate('SetLength', nil));
726 FuncSetLength := ProgramCode^.Functions.GetLast;
727 FuncSetLength^.Parameters.Add(FunctionParameterCreate('Array', TypeArray));
728 FuncSetLength^.Variables.Add(VariableCreate('Array', TypeArray));
729 FuncSetLength^.Parameters.Add(FunctionParameterCreate('Count', TypeInteger));
730 FuncSetLength^.Variables.Add(VariableCreate('Count', TypeInteger));
731end;
732
733procedure ParseProgram(ProgramCode: PProgramCode);
734var
735 NewFunc: TFunction;
736begin
737 MainProgram := ProgramCode;
738 ParserInit(ProgramCode);
739 ReadInputAll;
740 if CheckNext('program') then begin
741 Expect('program');
742 ProgramCode.Name := ReadNext;
743 Expect(';');
744 end;
745 repeat
746 SetLength(NewFunc.Parameters.Items, 0);
747 SetLength(NewFunc.Variables.Items, 0);
748 if ParseFunction(@NewFunc) then begin
749 ProgramCode.Functions.Add(NewFunc);
750 end else
751 if ParseProcedure(@NewFunc) then begin
752 ProgramCode.Functions.Add(NewFunc);
753 end else Break;
754 until False;
755 FunctionContext := nil;
756 ParseBeginEnd(@ProgramCode.BeginEnd);
757 Expect('.');
758end;
759
760end.
761
Note: See TracBrowser for help on using the repository browser.