![(please configure the [header_logo] section in trac.ini)](/Transpascal/chrome/site/your_project_logo.png){kind=logo}
Changeset 4 for trunk/Compiler/Analyze/UPascalParser.pas
- Timestamp:
- Nov 5, 2010, 7:24:45 AM (13 years ago)
- File:
-
- 1 edited
-
trunk/Compiler/Analyze/UPascalParser.pas (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/Compiler/Analyze/UPascalParser.pas
r3 r4 19 19 function ParseFile(Name: string): Boolean; 20 20 function ParseWhileDo(var WhileDo: TWhileDo; SourceCode: TCommonBlock): Boolean; 21 procedure ParseExpression(SourceCode: TExpression); 22 function ParseRightValue(SourceCode: TExpression): TObject; 23 function ParseFunctionCall(SourceCode: TExpression): TObject; 21 function ParseExpression(SourceCode: TExpression): Boolean; 22 function ParseExpressionParenthases(SourceCode: TExpression; 23 Expressions: TListExpression): Boolean; 24 function ParseExpressionOperator(SourceCode: TExpression; 25 Expressions: TListExpression): Boolean; 26 function ParseExpressionRightValue(SourceCode: TExpression; 27 Expressions: TListExpression): Boolean; 28 function ParseExpressionFunctionCall(SourceCode: TExpression; 29 Expressions: TListExpression; var Func: TFunction): Boolean; 24 30 function ParseUses(SourceCode: TUsedModuleList; AExported: Boolean): Boolean; 25 31 function ParseModule(ProgramCode: TProgram): TModule; … … 37 43 function ParseIfThenElse(var IfThenElse: TIfThenElse; SourceCode: TCommonBlock): Boolean; 38 44 function ParseForToDo(var ForToDo: TForToDo; SourceCode: TCommonBlock): Boolean; 45 function ParseAssigment(var Assignment: TAssignment; SourceCode: TCommonBlock): Boolean; 46 function ParseFunctionCall(var Call: TFunctionCall; SourceCode: TCommonBlock): Boolean; 39 47 function ParseVariableList(SourceCode: TVariableList; Exported: Boolean = False): Boolean; 40 48 procedure ParseVariable(SourceCode: TVariableList; Exported: Boolean = False); … … 43 51 function ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False; 44 52 AssignSymbol: string = '='): Boolean; 45 function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType; 46 function ParseTypeSubType(TypeList: TTypeList; Name: string; ExpectName: Boolean): TType; 53 function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; 54 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): TType; 55 function ParseTypeSubType(TypeList: TTypeList; Name: string; 56 ExpectName: Boolean; ForwardDeclaration: Boolean): TType; 47 57 function ParseTypeBase(TypeList: TTypeList; Name: string): TType; 48 58 function ParseTypePointer(TypeList: TTypeList; Name: string): TType; … … 125 135 { TExpression } 126 136 127 procedure TPascalParser.ParseExpression(SourceCode: TExpression); 128 var 129 Identifier: string; 130 IdentifierType: TTokenType; 137 function TPascalParser.ParseExpression(SourceCode: TExpression): Boolean; 138 var 131 139 NewVariable: TVariable; 132 140 NewExpression: TExpression; … … 135 143 UseType: TType; 136 144 // Brackets: Integer; 137 Expressions: T ExpressionList;145 Expressions: TListExpression; 138 146 I: integer; 139 147 II: integer; 140 RightValue: TObject; 141 begin 142 Expressions := TExpressionList.Create; 143 Expressions.Add(TExpression.Create); 144 with SourceCode do begin 145 while ((NextToken <> ';') and (NextToken <> ',') and (not IsKeyWord(NextToken))) and not 146 (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin 147 IdentifierType := NextTokenType; 148 if NextToken = '(' then begin 149 Expect('('); 150 // Subexpression 151 with TExpression(Expressions.Last) do begin 152 SubItems[1] := TExpression.Create; 153 TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock; 154 ParseExpression(TExpression(SubItems[1])); 155 end; 156 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do 157 begin 158 CommonBlock := SourceCode.CommonBlock; 159 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 160 end; 161 Expect(')'); 162 end else 163 if IsOperator(NextToken) then begin 164 // Operator 165 TExpression(Expressions.Last).OperatorName := ReadToken; 166 TExpression(Expressions.Last).NodeType := ntOperator; 167 end else begin 168 RightValue := ParseRightValue(SourceCode); 169 if Assigned(RightValue) then begin 170 with TExpression(Expressions.Last) do begin 171 SubItems[1] := TExpression.Create; 172 TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock; 173 if RightValue is TVariable then begin 174 TExpression(SubItems[1]).NodeType := ntVariable; 175 TExpression(SubItems[1]).Variable := TVariable(RightValue); 176 end; 177 if RightValue is TConstant then begin 178 TExpression(SubItems[1]).NodeType := ntConstant; 179 TExpression(SubItems[1]).Constant := TConstant(RightValue); 180 end; 181 if RightValue is TFunctionCall then begin 182 TExpression(SubItems[1]).NodeType := ntFunction; 183 TExpression(SubItems[1]).FunctionCall := TFunction(RightValue); 184 end; 185 end; 186 with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do 187 begin 188 CommonBlock := SourceCode.CommonBlock; 189 SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1]; 190 end; 191 end else begin 148 begin 149 try 150 Expressions := TListExpression.Create; 151 Expressions.Add(TExpression.Create); 152 with SourceCode do begin 153 while ((NextToken <> ';') and (NextToken <> ',') and (not IsKeyWord(NextToken))) and not 154 (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin 155 if not ParseExpressionParenthases(SourceCode, Expressions) then 156 if not ParseExpressionOperator(SourceCode, Expressions) then 157 if not ParseExpressionRightValue(SourceCode, Expressions) then begin 192 158 ErrorMessage(SInvalidAssignmentValue, [NextToken]); 193 159 ReadToken; 194 160 end; 195 161 end; 196 end; 197 198 // Build expression tree 199 for II := 0 to High(Operators) do begin 200 I := 1; 201 while (I < Expressions.Count - 1) do begin 202 if not TExpression(Expressions[I]).Associated and 203 (TExpression(Expressions[I]).OperatorName = Operators[II]) then 204 begin 205 TExpression(Expressions[I]).Associated := True; 206 TExpression(Expressions[I - 1]).SubItems[1] := Expressions[I]; 207 TExpression(Expressions[I + 1]).SubItems[0] := Expressions[I]; 208 //Expressions.Delete(I); 209 end else Inc(I); 210 end; 211 end; 212 if Assigned(TExpression(Expressions.First).SubItems[1]) then 213 Assign(TExpression(TExpression(Expressions.First).SubItems[1])); 214 TExpression(Expressions.First).SubItems[1] := nil; 215 //ShowMessage(IntToStr(Expressions.Count)); 216 if Expressions.Count > 1 then 217 TExpression(Expressions[1]).SubItems[0] := nil; 162 163 // Build expression tree using operator precedence 164 for II := 0 to High(Operators) do begin 165 I := 1; 166 while (I < Expressions.Count - 1) do begin 167 if not Expressions[I].Associated and 168 (Expressions[I].OperatorName = Operators[II]) then 169 begin 170 Expressions[I].Associated := True; 171 Expressions[I - 1].SubItems.Last := Expressions[I]; 172 Expressions[I + 1].SubItems.First := Expressions[I]; 173 //Expressions.Delete(I); 174 end else Inc(I); 175 end; 176 end; 177 if Assigned(Expressions.First.SubItems.Last) then 178 Assign(Expressions.First.SubItems.Last); 179 Expressions.First.SubItems.Last := nil; 180 //ShowMessage(IntToStr(Expressions.Count)); 181 if Expressions.Count > 1 then 182 Expressions[1].SubItems.First := nil; 183 end; 184 finally 218 185 Expressions.Free; 219 186 end; 220 187 end; 221 188 222 function TPascalParser.ParseRightValue(SourceCode: TExpression): TObject; 189 function TPascalParser.ParseExpressionParenthases(SourceCode: TExpression; 190 Expressions: TListExpression): Boolean; 191 var 192 NewExpression: TExpression; 193 begin 194 if NextToken = '(' then begin 195 Expect('('); 196 // Subexpression 197 NewExpression := TExpression.Create; 198 NewExpression.CommonBlock := SourceCode.CommonBlock; 199 ParseExpression(NewExpression); 200 201 Expressions.Last.SubItems.Last := NewExpression; 202 with Expressions.Items[Expressions.Add(TExpression.Create)] do 203 begin 204 CommonBlock := SourceCode.CommonBlock; 205 SubItems.First := NewExpression; 206 end; 207 Expect(')'); 208 Result := True; 209 end else Result := False; 210 end; 211 212 function TPascalParser.ParseExpressionOperator(SourceCode: TExpression; 213 Expressions: TListExpression): Boolean; 214 begin 215 if IsOperator(NextToken) then begin 216 // Operator 217 Expressions.Last.OperatorName := ReadToken; 218 Expressions.Last.NodeType := ntOperator; 219 Result := True; 220 end else Result := False; 221 end; 222 223 function TPascalParser.ParseExpressionRightValue(SourceCode: TExpression; 224 Expressions: TListExpression): Boolean; 223 225 var 224 226 UseType: TType; … … 226 228 UseConstant: TConstant; 227 229 UseFunction: TFunction; 230 NewExpression: TExpression; 228 231 Identifier: string; 229 begin 230 Result := nil; 232 O: TObject; 233 begin 234 O := nil; 231 235 with SourceCode do 232 236 if IsIdentificator(NextToken) then begin … … 240 244 UseVariable := TTypeRecord(UseType).CommonBlock.Variables.Search(Identifier); 241 245 if Assigned(UseVariable) then begin 242 Result:= UseVariable;243 end; 244 if not Assigned( Result) then begin246 O := UseVariable; 247 end; 248 if not Assigned(O) then begin 245 249 UseFunction := TTypeRecord(UseType).CommonBlock.Functions.Search(Identifier); 246 250 if Assigned(UseFunction) then begin 247 Result:= UseFunction;251 O := UseFunction; 248 252 end; 249 253 end; 250 if not Assigned( Result) then254 if not Assigned(O) then 251 255 ErrorMessage(SUndefinedVariable, [Identifier]); 252 256 end else ErrorMessage(SIllegalExpression, [Identifier]); 253 257 end; 254 if not Assigned( Result) then begin258 if not Assigned(O) then begin 255 259 UseVariable := CommonBlock.Variables.Search(Identifier); 256 260 if Assigned(UseVariable) then begin 257 261 // Referenced variable 258 262 ReadToken; 259 Result := UseVariable; 260 end; 261 end; 262 if not Assigned(Result) then begin 263 Result := ParseFunctionCall(SourceCode); 264 end; 265 if not Assigned(Result) then begin 263 NewExpression := TExpression.Create; 264 NewExpression.CommonBlock := SourceCode.CommonBlock; 265 NewExpression.NodeType := ntVariable; 266 NewExpression.Variable := TVariable(UseVariable); 267 SubItems.Last := NewExpression; 268 end; 269 end; 270 if not Assigned(O) then begin 271 ParseExpressionFunctionCall(SourceCode, Expressions, TFunction(O)); 272 NewExpression := TExpression.Create; 273 NewExpression.CommonBlock := SourceCode.CommonBlock; 274 NewExpression.NodeType := ntFunction; 275 NewExpression.FunctionCall := TFunction(O); 276 SubItems.Last := NewExpression; 277 end; 278 if not Assigned(O) then begin 266 279 UseConstant := CommonBlock.Constants.Search(NextToken); 267 280 if Assigned(UseConstant) then begin 268 281 ReadToken; 269 Result := UseConstant; 270 end; 271 end; 272 if not Assigned(Result) then begin 282 O := UseConstant; 283 NewExpression := TExpression.Create; 284 NewExpression.CommonBlock := SourceCode.CommonBlock; 285 NewExpression.NodeType := ntConstant; 286 NewExpression.Constant := TConstant(O); 287 SubItems.Last := NewExpression; 288 end; 289 end; 290 if not Assigned(O) then begin 273 291 // Constant value 274 Result := TConstant.Create; 275 TConstant(Result).Value := ReadToken; 276 end; 277 if not Assigned(Result) then begin 292 O := TConstant.Create; 293 TConstant(O).Value := ReadToken; 294 NewExpression := TExpression.Create; 295 NewExpression.CommonBlock := SourceCode.CommonBlock; 296 NewExpression.NodeType := ntConstant; 297 NewExpression.Constant := TConstant(O); 298 SubItems.Last := NewExpression; 299 end; 300 if not Assigned(O) then begin 278 301 ErrorMessage(SUnknownIdentifier, [ReadToken]); 279 302 end; 280 end else Result := nil; 281 end; 282 283 function TPascalParser.ParseFunctionCall(SourceCode: TExpression): TObject; 303 304 with Expressions.Items[Expressions.Add(TExpression.Create)] do 305 begin 306 CommonBlock := SourceCode.CommonBlock; 307 SubItems.First := NewExpression; 308 end; 309 Result := True; 310 end else Result := False; 311 end; 312 313 function TPascalParser.ParseExpressionFunctionCall(SourceCode: TExpression; 314 Expressions: TListExpression; var Func: TFunction): Boolean; 284 315 var 285 316 UseFunction: TFunction; 286 317 begin 287 Result:= nil;318 Func := nil; 288 319 with SourceCode do begin 289 320 UseFunction := CommonBlock.Functions.Search(NextToken); 290 321 if Assigned(UseFunction) then begin 291 322 ReadToken; 292 Result:= UseFunction;323 Func := UseFunction; 293 324 if NextToken = '(' then begin 294 325 Expect('('); … … 298 329 end; 299 330 end; 300 end; 331 Result := True; 332 end else Result := False; 301 333 end; 302 334 end; … … 319 351 if not ParseWhileDo(TWhileDo(Result), SourceCode) then 320 352 if not ParseForToDo(TForToDo(Result), SourceCode) then 321 if IsIdentificator(NextToken) then begin 322 if Assigned(SourceCode.Variables.Search(NextToken)) then begin 323 // Variable assignment 324 Result := TAssignment.Create; 325 TAssignment(Result).CommonBlock := SourceCode; 326 IdentName := ReadToken; 327 TAssignment(Result).Target := SourceCode.Variables.Search(IdentName); 328 Expect(':='); 329 TAssignment(Result).Source := TExpression.Create; 330 TAssignment(Result).Source.CommonBlock := SourceCode; 331 ParseExpression(TAssignment(Result).Source); 332 end else 333 if Assigned(SourceCode.Functions.Search(NextToken)) then begin 334 // Function call 335 FunctionName := ReadToken; 336 Result := TFunctionCall.Create; 337 TFunctionCall(Result).CommonBlock := SourceCode; 338 TFunctionCall(Result).FunctionRef := SourceCode.Functions.Search(FunctionName); 339 if NextToken = '(' then 340 begin 341 Expect('('); 342 with TFunctionCall(Result) do 343 begin 344 ParameterExpression.Add(TExpression.Create); 345 TExpression(ParameterExpression.Last).CommonBlock := SourceCode; 346 ParseExpression(TExpression(ParameterExpression.Last)); 347 end; 348 Expect(')'); 349 end; 350 end else begin 351 Result := nil; 352 ErrorMessage(SUnknownIdentifier, [ReadToken], -1); 353 end; 354 end else 353 if not ParseAssigment(TAssignment(Result), SourceCode) then 354 if not ParseFunctionCall(TFunctionCall(Result), SourceCode) then 355 355 if NextToken = ';' then 356 356 Result := nil … … 726 726 end; 727 727 728 function TPascalParser.ParseAssigment(var Assignment: TAssignment; 729 SourceCode: TCommonBlock): Boolean; 730 var 731 Variable: TVariable; 732 IdentName: string; 733 begin 734 if IsIdentificator(NextToken) then begin 735 Variable := SourceCode.Variables.Search(NextToken); 736 if Assigned(Variable) then begin 737 // Variable assignment 738 Assignment := TAssignment.Create; 739 Assignment.CommonBlock := SourceCode; 740 IdentName := ReadToken; 741 Assignment.Target := SourceCode.Variables.Search(IdentName); 742 Expect(':='); 743 Assignment.Source := TExpression.Create; 744 Assignment.Source.CommonBlock := SourceCode; 745 ParseExpression(Assignment.Source); 746 Result := True; 747 end else Result := False; 748 end else Result := False; 749 end; 750 751 function TPascalParser.ParseFunctionCall(var Call: TFunctionCall; 752 SourceCode: TCommonBlock): Boolean; 753 var 754 FunctionName: string; 755 begin 756 if IsIdentificator(NextToken) then begin 757 if Assigned(SourceCode.Functions.Search(NextToken)) then begin 758 // Function call 759 FunctionName := ReadToken; 760 Call := TFunctionCall.Create; 761 Call.CommonBlock := SourceCode; 762 Call.FunctionRef := SourceCode.Functions.Search(FunctionName); 763 if NextToken = '(' then begin 764 Expect('('); 765 with Call do begin 766 ParameterExpression.Add(TExpression.Create); 767 ParameterExpression.Last.CommonBlock := SourceCode; 768 ParseExpression(ParameterExpression.Last); 769 end; 770 Expect(')'); 771 end; 772 Result := True; 773 end else Result := False; 774 end else Result := False; 775 end; 776 728 777 { TParserVariableList } 729 778 … … 877 926 878 927 function TPascalParser.ParseType(TypeList: TTypeList; ExpectName: Boolean = True; 879 AssignSymbol: string = '=' ): TType;928 AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): TType; 880 929 var 881 930 Name: string; … … 894 943 if not Assigned(Result) then Result := ParseTypePointer(TypeList, Name); 895 944 if not Assigned(Result) then Result := ParseTypeBase(TypeList, Name); 896 if not Assigned(Result) then Result := ParseTypeSubType(TypeList, Name, ExpectName); 945 if not Assigned(Result) then Result := ParseTypeSubType(TypeList, Name, 946 ExpectName, ForwardDeclaration); 897 947 if not Assigned(Result) then Result := ParseTypeSubRange(TypeList, Name); 898 if not Assigned(Result) then 948 if not Assigned(Result) then begin 899 949 ErrorMessage(SInvalidConstruction, []); 950 end; 900 951 end; 901 952 end; 902 953 903 954 function TPascalParser.ParseTypeSubType(TypeList: TTypeList; Name: string; 904 ExpectName: Boolean ): TType;955 ExpectName: Boolean; ForwardDeclaration: Boolean): TType; 905 956 var 906 957 TypeName: string; … … 918 969 end else begin 919 970 TType(Result) := TypeList.Search(TypeName); 920 if not Assigned(TType(Result)) then 921 ErrorMessage(SUndefinedType, [TypeName], -1); 971 if not Assigned(TType(Result)) then begin 972 if ForwardDeclaration then begin 973 // ForwardDeclaration 974 Result := TType.Create; 975 TType(Result).Parent := TypeList; 976 TType(Result).Name := TypeName; 977 TType(Result).UsedType := nil; 978 end else 979 ErrorMessage(SUndefinedType, [TypeName], -1); 980 end; 922 981 end; 923 982 end else Result := nil; … … 948 1007 TTypePointer(Result).Parent := TypeList; 949 1008 TTypePointer(Result).Name := Name; 950 TTypePointer(Result).UsedType := ParseType(TypeList, False );1009 TTypePointer(Result).UsedType := ParseType(TypeList, False, '=', True); 951 1010 end else Result := nil; 952 1011 end;
Note:
See TracChangeset
for help on using the changeset viewer.
