1 | //===-- lib/Semantics/runtime-type-info.cpp ---------------------*- C++ -*-===// |
---|---|
2 | // |
3 | // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. |
4 | // See https://llvm.org/LICENSE.txt for license information. |
5 | // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception |
6 | // |
7 | //===----------------------------------------------------------------------===// |
8 | |
9 | #include "flang/Semantics/runtime-type-info.h" |
10 | #include "mod-file.h" |
11 | #include "flang/Evaluate/fold-designator.h" |
12 | #include "flang/Evaluate/fold.h" |
13 | #include "flang/Evaluate/tools.h" |
14 | #include "flang/Evaluate/type.h" |
15 | #include "flang/Optimizer/Support/InternalNames.h" |
16 | #include "flang/Semantics/scope.h" |
17 | #include "flang/Semantics/tools.h" |
18 | #include <functional> |
19 | #include <list> |
20 | #include <map> |
21 | #include <string> |
22 | |
23 | // The symbols added by this code to various scopes in the program include: |
24 | // .b.TYPE.NAME - Bounds values for an array component |
25 | // .c.TYPE - TYPE(Component) descriptions for TYPE |
26 | // .di.TYPE.NAME - Data initialization for a component |
27 | // .dp.TYPE.NAME - Data pointer initialization for a component |
28 | // .dt.TYPE - TYPE(DerivedType) description for TYPE |
29 | // .kp.TYPE - KIND type parameter values for TYPE |
30 | // .lpk.TYPE - Integer kinds of LEN type parameter values |
31 | // .lv.TYPE.NAME - LEN type parameter values for a component's type |
32 | // .n.NAME - Character representation of a name |
33 | // .p.TYPE - TYPE(ProcPtrComponent) descriptions for TYPE |
34 | // .s.TYPE - TYPE(SpecialBinding) bindings for TYPE |
35 | // .v.TYPE - TYPE(Binding) bindings for TYPE |
36 | |
37 | namespace Fortran::semantics { |
38 | |
39 | static int FindLenParameterIndex( |
40 | const SymbolVector ¶meters, const Symbol &symbol) { |
41 | int lenIndex{0}; |
42 | for (SymbolRef ref : parameters) { |
43 | if (&*ref == &symbol) { |
44 | return lenIndex; |
45 | } |
46 | if (auto attr{ref->get<TypeParamDetails>().attr()}; |
47 | attr && *attr == common::TypeParamAttr::Len) { |
48 | ++lenIndex; |
49 | } |
50 | } |
51 | DIE("Length type parameter not found in parameter order"); |
52 | return -1; |
53 | } |
54 | |
55 | class RuntimeTableBuilder { |
56 | public: |
57 | RuntimeTableBuilder(SemanticsContext &, RuntimeDerivedTypeTables &); |
58 | void DescribeTypes(Scope &scope, bool inSchemata); |
59 | |
60 | private: |
61 | const Symbol *DescribeType(Scope &, bool wantUninstantiatedPDT); |
62 | const Symbol &GetSchemaSymbol(const char *) const; |
63 | const DeclTypeSpec &GetSchema(const char *) const; |
64 | SomeExpr GetEnumValue(const char *) const; |
65 | Symbol &CreateObject(const std::string &, const DeclTypeSpec &, Scope &); |
66 | // The names of created symbols are saved in and owned by the |
67 | // RuntimeDerivedTypeTables instance returned by |
68 | // BuildRuntimeDerivedTypeTables() so that references to those names remain |
69 | // valid for lowering. |
70 | SourceName SaveObjectName(const std::string &); |
71 | SomeExpr SaveNameAsPointerTarget(Scope &, const std::string &); |
72 | const SymbolVector *GetTypeParameters(const Symbol &); |
73 | evaluate::StructureConstructor DescribeComponent(const Symbol &, |
74 | const ObjectEntityDetails &, Scope &, Scope &, |
75 | const std::string &distinctName, const SymbolVector *parameters); |
76 | evaluate::StructureConstructor DescribeComponent( |
77 | const Symbol &, const ProcEntityDetails &, Scope &); |
78 | bool InitializeDataPointer(evaluate::StructureConstructorValues &, |
79 | const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope, |
80 | Scope &dtScope, const std::string &distinctName); |
81 | evaluate::StructureConstructor PackageIntValue( |
82 | const SomeExpr &genre, std::int64_t = 0) const; |
83 | SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const; |
84 | std::vector<evaluate::StructureConstructor> DescribeBindings( |
85 | const Scope &dtScope, Scope &); |
86 | std::map<int, evaluate::StructureConstructor> DescribeSpecialGenerics( |
87 | const Scope &dtScope, const Scope &thisScope, |
88 | const DerivedTypeSpec *) const; |
89 | void DescribeSpecialGeneric(const GenericDetails &, |
90 | std::map<int, evaluate::StructureConstructor> &, const Scope &, |
91 | const DerivedTypeSpec *) const; |
92 | void DescribeSpecialProc(std::map<int, evaluate::StructureConstructor> &, |
93 | const Symbol &specificOrBinding, bool isAssignment, bool isFinal, |
94 | std::optional<common::DefinedIo>, const Scope *, const DerivedTypeSpec *, |
95 | bool isTypeBound) const; |
96 | void IncorporateDefinedIoGenericInterfaces( |
97 | std::map<int, evaluate::StructureConstructor> &, common::DefinedIo, |
98 | const Scope *, const DerivedTypeSpec *); |
99 | |
100 | // Instantiated for ParamValue and Bound |
101 | template <typename A> |
102 | evaluate::StructureConstructor GetValue( |
103 | const A &x, const SymbolVector *parameters) { |
104 | if (x.isExplicit()) { |
105 | return GetValue(x.GetExplicit(), parameters); |
106 | } else { |
107 | return PackageIntValue(deferredEnum_); |
108 | } |
109 | } |
110 | |
111 | // Specialization for optional<Expr<SomeInteger and SubscriptInteger>> |
112 | template <typename T> |
113 | evaluate::StructureConstructor GetValue( |
114 | const std::optional<evaluate::Expr<T>> &expr, |
115 | const SymbolVector *parameters) { |
116 | if (auto constValue{evaluate::ToInt64(expr)}) { |
117 | return PackageIntValue(explicitEnum_, *constValue); |
118 | } |
119 | if (expr) { |
120 | if (parameters) { |
121 | if (const Symbol * lenParam{evaluate::ExtractBareLenParameter(*expr)}) { |
122 | return PackageIntValue( |
123 | lenParameterEnum_, FindLenParameterIndex(*parameters, *lenParam)); |
124 | } |
125 | } |
126 | // TODO: Replace a specification expression requiring actual operations |
127 | // with a reference to a new anonymous LEN type parameter whose default |
128 | // value captures the expression. This replacement must take place when |
129 | // the type is declared so that the new LEN type parameters appear in |
130 | // all instantiations and structure constructors. |
131 | context_.Say(location_, |
132 | "derived type specification expression '%s' that is neither constant nor a length type parameter"_todo_en_US, |
133 | expr->AsFortran()); |
134 | } |
135 | return PackageIntValue(deferredEnum_); |
136 | } |
137 | |
138 | SemanticsContext &context_; |
139 | RuntimeDerivedTypeTables &tables_; |
140 | std::map<const Symbol *, SymbolVector> orderedTypeParameters_; |
141 | |
142 | const DeclTypeSpec &derivedTypeSchema_; // TYPE(DerivedType) |
143 | const DeclTypeSpec &componentSchema_; // TYPE(Component) |
144 | const DeclTypeSpec &procPtrSchema_; // TYPE(ProcPtrComponent) |
145 | const DeclTypeSpec &valueSchema_; // TYPE(Value) |
146 | const DeclTypeSpec &bindingSchema_; // TYPE(Binding) |
147 | const DeclTypeSpec &specialSchema_; // TYPE(SpecialBinding) |
148 | SomeExpr deferredEnum_; // Value::Genre::Deferred |
149 | SomeExpr explicitEnum_; // Value::Genre::Explicit |
150 | SomeExpr lenParameterEnum_; // Value::Genre::LenParameter |
151 | SomeExpr scalarAssignmentEnum_; // SpecialBinding::Which::ScalarAssignment |
152 | SomeExpr |
153 | elementalAssignmentEnum_; // SpecialBinding::Which::ElementalAssignment |
154 | SomeExpr readFormattedEnum_; // SpecialBinding::Which::ReadFormatted |
155 | SomeExpr readUnformattedEnum_; // SpecialBinding::Which::ReadUnformatted |
156 | SomeExpr writeFormattedEnum_; // SpecialBinding::Which::WriteFormatted |
157 | SomeExpr writeUnformattedEnum_; // SpecialBinding::Which::WriteUnformatted |
158 | SomeExpr elementalFinalEnum_; // SpecialBinding::Which::ElementalFinal |
159 | SomeExpr assumedRankFinalEnum_; // SpecialBinding::Which::AssumedRankFinal |
160 | SomeExpr scalarFinalEnum_; // SpecialBinding::Which::ScalarFinal |
161 | parser::CharBlock location_; |
162 | std::set<const Scope *> ignoreScopes_; |
163 | }; |
164 | |
165 | RuntimeTableBuilder::RuntimeTableBuilder( |
166 | SemanticsContext &c, RuntimeDerivedTypeTables &t) |
167 | : context_{c}, tables_{t}, derivedTypeSchema_{GetSchema("derivedtype")}, |
168 | componentSchema_{GetSchema("component")}, |
169 | procPtrSchema_{GetSchema("procptrcomponent")}, |
170 | valueSchema_{GetSchema("value")}, |
171 | bindingSchema_{GetSchema(bindingDescCompName)}, |
172 | specialSchema_{GetSchema("specialbinding")}, |
173 | deferredEnum_{GetEnumValue("deferred")}, |
174 | explicitEnum_{GetEnumValue("explicit")}, |
175 | lenParameterEnum_{GetEnumValue("lenparameter")}, |
176 | scalarAssignmentEnum_{GetEnumValue("scalarassignment")}, |
177 | elementalAssignmentEnum_{GetEnumValue("elementalassignment")}, |
178 | readFormattedEnum_{GetEnumValue("readformatted")}, |
179 | readUnformattedEnum_{GetEnumValue("readunformatted")}, |
180 | writeFormattedEnum_{GetEnumValue("writeformatted")}, |
181 | writeUnformattedEnum_{GetEnumValue("writeunformatted")}, |
182 | elementalFinalEnum_{GetEnumValue("elementalfinal")}, |
183 | assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")}, |
184 | scalarFinalEnum_{GetEnumValue("scalarfinal")} { |
185 | ignoreScopes_.insert(tables_.schemata); |
186 | } |
187 | |
188 | static void SetReadOnlyCompilerCreatedFlags(Symbol &symbol) { |
189 | symbol.set(Symbol::Flag::CompilerCreated); |
190 | // Runtime type info symbols may have types that are incompatible with the |
191 | // PARAMETER attribute (the main issue is that they may be TARGET, and normal |
192 | // Fortran parameters cannot be TARGETs). |
193 | if (symbol.has<semantics::ObjectEntityDetails>() || |
194 | symbol.has<semantics::ProcEntityDetails>()) { |
195 | symbol.set(Symbol::Flag::ReadOnly); |
196 | } |
197 | } |
198 | |
199 | // Save an arbitrarily shaped array constant of some derived type |
200 | // as an initialized data object in a scope. |
201 | static SomeExpr SaveDerivedPointerTarget(Scope &scope, SourceName name, |
202 | std::vector<evaluate::StructureConstructor> &&x, |
203 | evaluate::ConstantSubscripts &&shape) { |
204 | if (x.empty()) { |
205 | return SomeExpr{evaluate::NullPointer{}}; |
206 | } else { |
207 | auto dyType{x.front().GetType()}; |
208 | const auto &derivedType{dyType.GetDerivedTypeSpec()}; |
209 | ObjectEntityDetails object; |
210 | DeclTypeSpec typeSpec{DeclTypeSpec::TypeDerived, derivedType}; |
211 | if (const DeclTypeSpec * spec{scope.FindType(typeSpec)}) { |
212 | object.set_type(*spec); |
213 | } else { |
214 | object.set_type(scope.MakeDerivedType( |
215 | DeclTypeSpec::TypeDerived, common::Clone(derivedType))); |
216 | } |
217 | if (!shape.empty()) { |
218 | ArraySpec arraySpec; |
219 | for (auto n : shape) { |
220 | arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{n - 1})); |
221 | } |
222 | object.set_shape(arraySpec); |
223 | } |
224 | object.set_init( |
225 | evaluate::AsGenericExpr(evaluate::Constant<evaluate::SomeDerived>{ |
226 | derivedType, std::move(x), std::move(shape)})); |
227 | Symbol &symbol{*scope |
228 | .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE}, |
229 | std::move(object)) |
230 | .first->second}; |
231 | SetReadOnlyCompilerCreatedFlags(symbol); |
232 | return evaluate::AsGenericExpr( |
233 | evaluate::Designator<evaluate::SomeDerived>{symbol}); |
234 | } |
235 | } |
236 | |
237 | void RuntimeTableBuilder::DescribeTypes(Scope &scope, bool inSchemata) { |
238 | inSchemata |= ignoreScopes_.find(&scope) != ignoreScopes_.end(); |
239 | if (scope.IsDerivedType()) { |
240 | if (!inSchemata) { // don't loop trying to describe a schema |
241 | DescribeType(scope, /*wantUninstantiatedPDT=*/false); |
242 | } |
243 | } else { |
244 | scope.InstantiateDerivedTypes(); |
245 | } |
246 | for (Scope &child : scope.children()) { |
247 | DescribeTypes(child, inSchemata); |
248 | } |
249 | } |
250 | |
251 | // Returns derived type instantiation's parameters in declaration order |
252 | const SymbolVector *RuntimeTableBuilder::GetTypeParameters( |
253 | const Symbol &symbol) { |
254 | auto iter{orderedTypeParameters_.find(&symbol)}; |
255 | if (iter != orderedTypeParameters_.end()) { |
256 | return &iter->second; |
257 | } else { |
258 | return &orderedTypeParameters_ |
259 | .emplace(&symbol, OrderParameterDeclarations(symbol)) |
260 | .first->second; |
261 | } |
262 | } |
263 | |
264 | static Scope &GetContainingNonDerivedScope(Scope &scope) { |
265 | Scope *p{&scope}; |
266 | while (p->IsDerivedType()) { |
267 | p = &p->parent(); |
268 | } |
269 | return *p; |
270 | } |
271 | |
272 | static const Symbol &GetSchemaField( |
273 | const DerivedTypeSpec &derived, const std::string &name) { |
274 | const Scope &scope{ |
275 | DEREF(derived.scope() ? derived.scope() : derived.typeSymbol().scope())}; |
276 | auto iter{scope.find(SourceName(name))}; |
277 | CHECK(iter != scope.end()); |
278 | return *iter->second; |
279 | } |
280 | |
281 | static const Symbol &GetSchemaField( |
282 | const DeclTypeSpec &derived, const std::string &name) { |
283 | return GetSchemaField(DEREF(derived.AsDerived()), name); |
284 | } |
285 | |
286 | static evaluate::StructureConstructorValues &AddValue( |
287 | evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec, |
288 | const std::string &name, SomeExpr &&x) { |
289 | values.emplace(GetSchemaField(spec, name), std::move(x)); |
290 | return values; |
291 | } |
292 | |
293 | static evaluate::StructureConstructorValues &AddValue( |
294 | evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec, |
295 | const std::string &name, const SomeExpr &x) { |
296 | values.emplace(GetSchemaField(spec, name), x); |
297 | return values; |
298 | } |
299 | |
300 | static SomeExpr IntToExpr(std::int64_t n) { |
301 | return evaluate::AsGenericExpr(evaluate::ExtentExpr{n}); |
302 | } |
303 | |
304 | static evaluate::StructureConstructor Structure( |
305 | const DeclTypeSpec &spec, evaluate::StructureConstructorValues &&values) { |
306 | return {DEREF(spec.AsDerived()), std::move(values)}; |
307 | } |
308 | |
309 | static SomeExpr StructureExpr(evaluate::StructureConstructor &&x) { |
310 | return SomeExpr{evaluate::Expr<evaluate::SomeDerived>{std::move(x)}}; |
311 | } |
312 | |
313 | static int GetIntegerKind(const Symbol &symbol, bool canBeUninstantiated) { |
314 | auto dyType{evaluate::DynamicType::From(symbol)}; |
315 | CHECK((dyType && dyType->category() == TypeCategory::Integer) || |
316 | symbol.owner().context().HasError(symbol) || canBeUninstantiated); |
317 | return dyType && dyType->category() == TypeCategory::Integer |
318 | ? dyType->kind() |
319 | : symbol.owner().context().GetDefaultKind(TypeCategory::Integer); |
320 | } |
321 | |
322 | // Save a rank-1 array constant of some numeric type as an |
323 | // initialized data object in a scope. |
324 | template <typename T> |
325 | static SomeExpr SaveNumericPointerTarget( |
326 | Scope &scope, SourceName name, std::vector<typename T::Scalar> &&x) { |
327 | if (x.empty()) { |
328 | return SomeExpr{evaluate::NullPointer{}}; |
329 | } else { |
330 | ObjectEntityDetails object; |
331 | if (const auto *spec{scope.FindType( |
332 | DeclTypeSpec{NumericTypeSpec{T::category, KindExpr{T::kind}}})}) { |
333 | object.set_type(*spec); |
334 | } else { |
335 | object.set_type(scope.MakeNumericType(T::category, KindExpr{T::kind})); |
336 | } |
337 | auto elements{static_cast<evaluate::ConstantSubscript>(x.size())}; |
338 | ArraySpec arraySpec; |
339 | arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{elements - 1})); |
340 | object.set_shape(arraySpec); |
341 | object.set_init(evaluate::AsGenericExpr(evaluate::Constant<T>{ |
342 | std::move(x), evaluate::ConstantSubscripts{elements}})); |
343 | Symbol &symbol{*scope |
344 | .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE}, |
345 | std::move(object)) |
346 | .first->second}; |
347 | SetReadOnlyCompilerCreatedFlags(symbol); |
348 | return evaluate::AsGenericExpr( |
349 | evaluate::Expr<T>{evaluate::Designator<T>{symbol}}); |
350 | } |
351 | } |
352 | |
353 | static SomeExpr SaveObjectInit( |
354 | Scope &scope, SourceName name, const ObjectEntityDetails &object) { |
355 | Symbol &symbol{*scope |
356 | .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE}, |
357 | ObjectEntityDetails{object}) |
358 | .first->second}; |
359 | CHECK(symbol.get<ObjectEntityDetails>().init().has_value()); |
360 | SetReadOnlyCompilerCreatedFlags(symbol); |
361 | return evaluate::AsGenericExpr( |
362 | evaluate::Designator<evaluate::SomeDerived>{symbol}); |
363 | } |
364 | |
365 | template <int KIND> static SomeExpr IntExpr(std::int64_t n) { |
366 | return evaluate::AsGenericExpr( |
367 | evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n}); |
368 | } |
369 | |
370 | static std::optional<std::string> GetSuffixIfTypeKindParameters( |
371 | const DerivedTypeSpec &derivedTypeSpec, const SymbolVector *parameters) { |
372 | if (parameters) { |
373 | std::optional<std::string> suffix; |
374 | for (SymbolRef ref : *parameters) { |
375 | const auto &tpd{ref->get<TypeParamDetails>()}; |
376 | if (tpd.attr() && *tpd.attr() == common::TypeParamAttr::Kind) { |
377 | if (const auto *pv{derivedTypeSpec.FindParameter(ref->name())}) { |
378 | if (pv->GetExplicit()) { |
379 | if (auto instantiatedValue{evaluate::ToInt64(*pv->GetExplicit())}) { |
380 | if (suffix.has_value()) { |
381 | *suffix += |
382 | (fir::kNameSeparator + llvm::Twine(*instantiatedValue)) |
383 | .str(); |
384 | } else { |
385 | suffix = (fir::kNameSeparator + llvm::Twine(*instantiatedValue)) |
386 | .str(); |
387 | } |
388 | } |
389 | } |
390 | } |
391 | } |
392 | } |
393 | return suffix; |
394 | } |
395 | return std::nullopt; |
396 | } |
397 | |
398 | const Symbol *RuntimeTableBuilder::DescribeType( |
399 | Scope &dtScope, bool wantUninstantiatedPDT) { |
400 | if (const Symbol * info{dtScope.runtimeDerivedTypeDescription()}) { |
401 | return info; |
402 | } |
403 | const DerivedTypeSpec *derivedTypeSpec{dtScope.derivedTypeSpec()}; |
404 | if (!derivedTypeSpec && !dtScope.IsDerivedTypeWithKindParameter() && |
405 | dtScope.symbol()) { |
406 | // This derived type was declared (obviously, there's a Scope) but never |
407 | // used in this compilation (no instantiated DerivedTypeSpec points here). |
408 | // Create a DerivedTypeSpec now for it so that ComponentIterator |
409 | // will work. This covers the case of a derived type that's declared in |
410 | // a module but used only by clients and submodules, enabling the |
411 | // run-time "no initialization needed here" flag to work. |
412 | DerivedTypeSpec derived{dtScope.symbol()->name(), *dtScope.symbol()}; |
413 | if (const SymbolVector * |
414 | lenParameters{GetTypeParameters(*dtScope.symbol())}) { |
415 | // Create dummy deferred values for the length parameters so that the |
416 | // DerivedTypeSpec is complete and can be used in helpers. |
417 | for (SymbolRef lenParam : *lenParameters) { |
418 | (void)lenParam; |
419 | derived.AddRawParamValue( |
420 | nullptr, ParamValue::Deferred(common::TypeParamAttr::Len)); |
421 | } |
422 | derived.CookParameters(context_.foldingContext()); |
423 | } |
424 | DeclTypeSpec &decl{ |
425 | dtScope.MakeDerivedType(DeclTypeSpec::TypeDerived, std::move(derived))}; |
426 | derivedTypeSpec = &decl.derivedTypeSpec(); |
427 | } |
428 | const Symbol *dtSymbol{ |
429 | derivedTypeSpec ? &derivedTypeSpec->typeSymbol() : dtScope.symbol()}; |
430 | if (!dtSymbol) { |
431 | return nullptr; |
432 | } |
433 | auto locationRestorer{common::ScopedSet(location_, dtSymbol->name())}; |
434 | // Check for an existing description that can be imported from a USE'd module |
435 | std::string typeName{dtSymbol->name().ToString()}; |
436 | if (typeName.empty() || |
437 | (typeName.front() == '.' && !context_.IsTempName(typeName))) { |
438 | return nullptr; |
439 | } |
440 | bool isPDTDefinitionWithKindParameters{ |
441 | !derivedTypeSpec && dtScope.IsDerivedTypeWithKindParameter()}; |
442 | bool isPDTInstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()}; |
443 | const SymbolVector *parameters{GetTypeParameters(*dtSymbol)}; |
444 | std::string distinctName{typeName}; |
445 | if (isPDTInstantiation) { |
446 | // Only create new type descriptions for different kind parameter values. |
447 | // Type with different length parameters/same kind parameters can all |
448 | // share the same type description available in the current scope. |
449 | if (auto suffix{ |
450 | GetSuffixIfTypeKindParameters(*derivedTypeSpec, parameters)}) { |
451 | distinctName += *suffix; |
452 | } |
453 | } else if (isPDTDefinitionWithKindParameters && !wantUninstantiatedPDT) { |
454 | return nullptr; |
455 | } |
456 | std::string dtDescName{(fir::kTypeDescriptorSeparator + distinctName).str()}; |
457 | Scope *dtSymbolScope{const_cast<Scope *>(dtSymbol->scope())}; |
458 | Scope &scope{ |
459 | GetContainingNonDerivedScope(scope&: dtSymbolScope ? *dtSymbolScope : dtScope)}; |
460 | if (const auto it{scope.find(SourceName{dtDescName})}; it != scope.end()) { |
461 | dtScope.set_runtimeDerivedTypeDescription(*it->second); |
462 | return &*it->second; |
463 | } |
464 | |
465 | // Create a new description object before populating it so that mutual |
466 | // references will work as pointer targets. |
467 | Symbol &dtObject{CreateObject(dtDescName, derivedTypeSchema_, scope)}; |
468 | dtScope.set_runtimeDerivedTypeDescription(dtObject); |
469 | evaluate::StructureConstructorValues dtValues; |
470 | AddValue(dtValues, derivedTypeSchema_, "name"s, |
471 | SaveNameAsPointerTarget(scope, typeName)); |
472 | if (!isPDTDefinitionWithKindParameters) { |
473 | auto sizeInBytes{static_cast<common::ConstantSubscript>(dtScope.size())}; |
474 | if (auto alignment{dtScope.alignment().value_or(0)}) { |
475 | sizeInBytes += alignment - 1; |
476 | sizeInBytes /= alignment; |
477 | sizeInBytes *= alignment; |
478 | } |
479 | AddValue( |
480 | dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes)); |
481 | } |
482 | if (const Symbol * |
483 | uninstDescObject{isPDTInstantiation |
484 | ? DescribeType(dtScope&: DEREF(const_cast<Scope *>(dtSymbol->scope())), |
485 | /*wantUninstantiatedPDT=*/true) |
486 | : nullptr}) { |
487 | AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s, |
488 | evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{ |
489 | evaluate::Designator<evaluate::SomeDerived>{ |
490 | DEREF(uninstDescObject)}})); |
491 | } else { |
492 | AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s, |
493 | SomeExpr{evaluate::NullPointer{}}); |
494 | } |
495 | using Int8 = evaluate::Type<TypeCategory::Integer, 8>; |
496 | using Int1 = evaluate::Type<TypeCategory::Integer, 1>; |
497 | std::vector<Int8::Scalar> kinds; |
498 | std::vector<Int1::Scalar> lenKinds; |
499 | if (parameters) { |
500 | // Package the derived type's parameters in declaration order for |
501 | // each category of parameter. KIND= type parameters are described |
502 | // by their instantiated (or default) values, while LEN= type |
503 | // parameters are described by their INTEGER kinds. |
504 | for (SymbolRef ref : *parameters) { |
505 | if (const auto *inst{dtScope.FindComponent(ref->name())}) { |
506 | const auto &tpd{inst->get<TypeParamDetails>()}; |
507 | if (tpd.attr() && *tpd.attr() == common::TypeParamAttr::Kind) { |
508 | auto value{evaluate::ToInt64(tpd.init()).value_or(0)}; |
509 | if (derivedTypeSpec) { |
510 | if (const auto *pv{derivedTypeSpec->FindParameter(inst->name())}) { |
511 | if (pv->GetExplicit()) { |
512 | if (auto instantiatedValue{ |
513 | evaluate::ToInt64(*pv->GetExplicit())}) { |
514 | value = *instantiatedValue; |
515 | } |
516 | } |
517 | } |
518 | } |
519 | kinds.emplace_back(value); |
520 | } else { // LEN= parameter |
521 | lenKinds.emplace_back( |
522 | GetIntegerKind(*inst, isPDTDefinitionWithKindParameters)); |
523 | } |
524 | } |
525 | } |
526 | } |
527 | AddValue(dtValues, derivedTypeSchema_, "kindparameter"s, |
528 | SaveNumericPointerTarget<Int8>(scope, |
529 | SaveObjectName((fir::kKindParameterSeparator + distinctName).str()), |
530 | std::move(kinds))); |
531 | AddValue(dtValues, derivedTypeSchema_, "lenparameterkind"s, |
532 | SaveNumericPointerTarget<Int1>(scope, |
533 | SaveObjectName((fir::kLenKindSeparator + distinctName).str()), |
534 | std::move(lenKinds))); |
535 | // Traverse the components of the derived type |
536 | if (!isPDTDefinitionWithKindParameters) { |
537 | std::vector<const Symbol *> dataComponentSymbols; |
538 | std::vector<evaluate::StructureConstructor> procPtrComponents; |
539 | for (const auto &pair : dtScope) { |
540 | const Symbol &symbol{*pair.second}; |
541 | auto locationRestorer{common::ScopedSet(location_, symbol.name())}; |
542 | common::visit( |
543 | common::visitors{ |
544 | [&](const TypeParamDetails &) { |
545 | // already handled above in declaration order |
546 | }, |
547 | [&](const ObjectEntityDetails &) { |
548 | dataComponentSymbols.push_back(&symbol); |
549 | }, |
550 | [&](const ProcEntityDetails &proc) { |
551 | if (IsProcedurePointer(symbol)) { |
552 | procPtrComponents.emplace_back( |
553 | DescribeComponent(symbol, proc, scope)); |
554 | } |
555 | }, |
556 | [&](const ProcBindingDetails &) { // handled in a later pass |
557 | }, |
558 | [&](const GenericDetails &) { // ditto |
559 | }, |
560 | [&](const auto &) { |
561 | common::die( |
562 | "unexpected details on symbol '%s' in derived type scope", |
563 | symbol.name().ToString().c_str()); |
564 | }, |
565 | }, |
566 | symbol.details()); |
567 | } |
568 | // Sort the data component symbols by offset before emitting them, placing |
569 | // the parent component first if any. |
570 | std::sort(first: dataComponentSymbols.begin(), last: dataComponentSymbols.end(), |
571 | comp: [](const Symbol *x, const Symbol *y) { |
572 | return x->test(Symbol::Flag::ParentComp) || x->offset() < y->offset(); |
573 | }); |
574 | std::vector<evaluate::StructureConstructor> dataComponents; |
575 | for (const Symbol *symbol : dataComponentSymbols) { |
576 | auto locationRestorer{common::ScopedSet(location_, symbol->name())}; |
577 | dataComponents.emplace_back( |
578 | DescribeComponent(*symbol, symbol->get<ObjectEntityDetails>(), scope, |
579 | dtScope, distinctName, parameters)); |
580 | } |
581 | AddValue(dtValues, derivedTypeSchema_, "component"s, |
582 | SaveDerivedPointerTarget(scope, |
583 | SaveObjectName((fir::kComponentSeparator + distinctName).str()), |
584 | std::move(dataComponents), |
585 | evaluate::ConstantSubscripts{ |
586 | static_cast<evaluate::ConstantSubscript>( |
587 | dataComponents.size())})); |
588 | AddValue(dtValues, derivedTypeSchema_, "procptr"s, |
589 | SaveDerivedPointerTarget(scope, |
590 | SaveObjectName((fir::kProcPtrSeparator + distinctName).str()), |
591 | std::move(procPtrComponents), |
592 | evaluate::ConstantSubscripts{ |
593 | static_cast<evaluate::ConstantSubscript>( |
594 | procPtrComponents.size())})); |
595 | // Compile the "vtable" of type-bound procedure bindings |
596 | std::uint32_t specialBitSet{0}; |
597 | if (!dtSymbol->attrs().test(Attr::ABSTRACT)) { |
598 | std::vector<evaluate::StructureConstructor> bindings{ |
599 | DescribeBindings(dtScope, scope)}; |
600 | AddValue(dtValues, derivedTypeSchema_, bindingDescCompName, |
601 | SaveDerivedPointerTarget(scope, |
602 | SaveObjectName( |
603 | (fir::kBindingTableSeparator + distinctName).str()), |
604 | std::move(bindings), |
605 | evaluate::ConstantSubscripts{ |
606 | static_cast<evaluate::ConstantSubscript>(bindings.size())})); |
607 | // Describe "special" bindings to defined assignments, FINAL subroutines, |
608 | // and defined derived type I/O subroutines. Defined assignments and I/O |
609 | // subroutines override any parent bindings, but FINAL subroutines do not |
610 | // (the runtime will call all of them). |
611 | std::map<int, evaluate::StructureConstructor> specials{ |
612 | DescribeSpecialGenerics(dtScope, dtScope, derivedTypeSpec)}; |
613 | if (derivedTypeSpec) { |
614 | for (auto &ref : FinalsForDerivedTypeInstantiation(*derivedTypeSpec)) { |
615 | DescribeSpecialProc(specials, *ref, /*isAssignment-*/ false, |
616 | /*isFinal=*/true, std::nullopt, nullptr, derivedTypeSpec, |
617 | /*isTypeBound=*/true); |
618 | } |
619 | IncorporateDefinedIoGenericInterfaces(specials, |
620 | common::DefinedIo::ReadFormatted, &scope, derivedTypeSpec); |
621 | IncorporateDefinedIoGenericInterfaces(specials, |
622 | common::DefinedIo::ReadUnformatted, &scope, derivedTypeSpec); |
623 | IncorporateDefinedIoGenericInterfaces(specials, |
624 | common::DefinedIo::WriteFormatted, &scope, derivedTypeSpec); |
625 | IncorporateDefinedIoGenericInterfaces(specials, |
626 | common::DefinedIo::WriteUnformatted, &scope, derivedTypeSpec); |
627 | } |
628 | // Pack the special procedure bindings in ascending order of their "which" |
629 | // code values, and compile a little-endian bit-set of those codes for |
630 | // use in O(1) look-up at run time. |
631 | std::vector<evaluate::StructureConstructor> sortedSpecials; |
632 | for (auto &pair : specials) { |
633 | auto bit{std::uint32_t{1} << pair.first}; |
634 | CHECK(!(specialBitSet & bit)); |
635 | specialBitSet |= bit; |
636 | sortedSpecials.emplace_back(std::move(pair.second)); |
637 | } |
638 | AddValue(dtValues, derivedTypeSchema_, "special"s, |
639 | SaveDerivedPointerTarget(scope, |
640 | SaveObjectName( |
641 | (fir::kSpecialBindingSeparator + distinctName).str()), |
642 | std::move(sortedSpecials), |
643 | evaluate::ConstantSubscripts{ |
644 | static_cast<evaluate::ConstantSubscript>(specials.size())})); |
645 | } |
646 | AddValue(dtValues, derivedTypeSchema_, "specialbitset"s, |
647 | IntExpr<4>(specialBitSet)); |
648 | // Note the presence/absence of a parent component |
649 | AddValue(dtValues, derivedTypeSchema_, "hasparent"s, |
650 | IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr)); |
651 | // To avoid wasting run time attempting to initialize derived type |
652 | // instances without any initialized components, analyze the type |
653 | // and set a flag if there's nothing to do for it at run time. |
654 | AddValue(dtValues, derivedTypeSchema_, "noinitializationneeded"s, |
655 | IntExpr<1>(derivedTypeSpec && |
656 | !derivedTypeSpec->HasDefaultInitialization(false, false))); |
657 | // Similarly, a flag to short-circuit destruction when not needed. |
658 | AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s, |
659 | IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction())); |
660 | // Similarly, a flag to short-circuit finalization when not needed. |
661 | AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s, |
662 | IntExpr<1>( |
663 | derivedTypeSpec && !MayRequireFinalization(*derivedTypeSpec))); |
664 | } |
665 | dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{ |
666 | StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))}); |
667 | return &dtObject; |
668 | } |
669 | |
670 | static const Symbol &GetSymbol(const Scope &schemata, SourceName name) { |
671 | auto iter{schemata.find(name)}; |
672 | CHECK(iter != schemata.end()); |
673 | const Symbol &symbol{*iter->second}; |
674 | return symbol; |
675 | } |
676 | |
677 | const Symbol &RuntimeTableBuilder::GetSchemaSymbol(const char *name) const { |
678 | return GetSymbol( |
679 | DEREF(tables_.schemata), SourceName{name, std::strlen(name)}); |
680 | } |
681 | |
682 | const DeclTypeSpec &RuntimeTableBuilder::GetSchema( |
683 | const char *schemaName) const { |
684 | Scope &schemata{DEREF(tables_.schemata)}; |
685 | SourceName name{schemaName, std::strlen(schemaName)}; |
686 | const Symbol &symbol{GetSymbol(schemata, name)}; |
687 | CHECK(symbol.has<DerivedTypeDetails>()); |
688 | CHECK(symbol.scope()); |
689 | CHECK(symbol.scope()->IsDerivedType()); |
690 | const DeclTypeSpec *spec{nullptr}; |
691 | if (symbol.scope()->derivedTypeSpec()) { |
692 | DeclTypeSpec typeSpec{ |
693 | DeclTypeSpec::TypeDerived, *symbol.scope()->derivedTypeSpec()}; |
694 | spec = schemata.FindType(typeSpec); |
695 | } |
696 | if (!spec) { |
697 | DeclTypeSpec typeSpec{ |
698 | DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol}}; |
699 | spec = schemata.FindType(typeSpec); |
700 | } |
701 | if (!spec) { |
702 | spec = &schemata.MakeDerivedType( |
703 | DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol}); |
704 | } |
705 | CHECK(spec->AsDerived()); |
706 | return *spec; |
707 | } |
708 | |
709 | SomeExpr RuntimeTableBuilder::GetEnumValue(const char *name) const { |
710 | const Symbol &symbol{GetSchemaSymbol(name)}; |
711 | auto value{evaluate::ToInt64(symbol.get<ObjectEntityDetails>().init())}; |
712 | CHECK(value.has_value()); |
713 | return IntExpr<1>(*value); |
714 | } |
715 | |
716 | Symbol &RuntimeTableBuilder::CreateObject( |
717 | const std::string &name, const DeclTypeSpec &type, Scope &scope) { |
718 | ObjectEntityDetails object; |
719 | object.set_type(type); |
720 | auto pair{scope.try_emplace(SaveObjectName(name), |
721 | Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))}; |
722 | CHECK(pair.second); |
723 | Symbol &result{*pair.first->second}; |
724 | SetReadOnlyCompilerCreatedFlags(result); |
725 | return result; |
726 | } |
727 | |
728 | SourceName RuntimeTableBuilder::SaveObjectName(const std::string &name) { |
729 | return *tables_.names.insert(name).first; |
730 | } |
731 | |
732 | SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget( |
733 | Scope &scope, const std::string &name) { |
734 | CHECK(!name.empty()); |
735 | CHECK(name.front() != '.' || context_.IsTempName(name)); |
736 | ObjectEntityDetails object; |
737 | auto len{static_cast<common::ConstantSubscript>(name.size())}; |
738 | if (const auto *spec{scope.FindType(DeclTypeSpec{CharacterTypeSpec{ |
739 | ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}}})}) { |
740 | object.set_type(*spec); |
741 | } else { |
742 | object.set_type(scope.MakeCharacterType( |
743 | ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1})); |
744 | } |
745 | using evaluate::Ascii; |
746 | using AsciiExpr = evaluate::Expr<Ascii>; |
747 | object.set_init(evaluate::AsGenericExpr(AsciiExpr{name})); |
748 | Symbol &symbol{ |
749 | *scope |
750 | .try_emplace( |
751 | SaveObjectName((fir::kNameStringSeparator + name).str()), |
752 | Attrs{Attr::TARGET, Attr::SAVE}, std::move(object)) |
753 | .first->second}; |
754 | SetReadOnlyCompilerCreatedFlags(symbol); |
755 | return evaluate::AsGenericExpr( |
756 | AsciiExpr{evaluate::Designator<Ascii>{symbol}}); |
757 | } |
758 | |
759 | evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent( |
760 | const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope, |
761 | Scope &dtScope, const std::string &distinctName, |
762 | const SymbolVector *parameters) { |
763 | evaluate::StructureConstructorValues values; |
764 | auto &foldingContext{context_.foldingContext()}; |
765 | auto typeAndShape{evaluate::characteristics::TypeAndShape::Characterize( |
766 | symbol, foldingContext)}; |
767 | CHECK(typeAndShape.has_value()); |
768 | auto dyType{typeAndShape->type()}; |
769 | int rank{typeAndShape->Rank()}; |
770 | AddValue(values, componentSchema_, "name"s, |
771 | SaveNameAsPointerTarget(scope, symbol.name().ToString())); |
772 | AddValue(values, componentSchema_, "category"s, |
773 | IntExpr<1>(static_cast<int>(dyType.category()))); |
774 | if (dyType.IsUnlimitedPolymorphic() || |
775 | dyType.category() == TypeCategory::Derived) { |
776 | AddValue(values, componentSchema_, "kind"s, IntExpr<1>(0)); |
777 | } else { |
778 | AddValue(values, componentSchema_, "kind"s, IntExpr<1>(dyType.kind())); |
779 | } |
780 | AddValue(values, componentSchema_, "offset"s, IntExpr<8>(symbol.offset())); |
781 | // CHARACTER length |
782 | auto len{typeAndShape->LEN()}; |
783 | if (const semantics::DerivedTypeSpec * |
784 | pdtInstance{dtScope.derivedTypeSpec()}) { |
785 | auto restorer{foldingContext.WithPDTInstance(*pdtInstance)}; |
786 | len = Fold(foldingContext, std::move(len)); |
787 | } |
788 | if (dyType.category() == TypeCategory::Character && len) { |
789 | // Ignore IDIM(x) (represented as MAX(0, x)) |
790 | if (const auto *clamped{evaluate::UnwrapExpr< |
791 | evaluate::Extremum<evaluate::SubscriptInteger>>(*len)}) { |
792 | if (clamped->ordering == evaluate::Ordering::Greater && |
793 | clamped->left() == evaluate::Expr<evaluate::SubscriptInteger>{0}) { |
794 | len = common::Clone(clamped->right()); |
795 | } |
796 | } |
797 | AddValue(values, componentSchema_, "characterlen"s, |
798 | evaluate::AsGenericExpr(GetValue(len, parameters))); |
799 | } else { |
800 | AddValue(values, componentSchema_, "characterlen"s, |
801 | PackageIntValueExpr(deferredEnum_)); |
802 | } |
803 | // Describe component's derived type |
804 | std::vector<evaluate::StructureConstructor> lenParams; |
805 | if (dyType.category() == TypeCategory::Derived && |
806 | !dyType.IsUnlimitedPolymorphic()) { |
807 | const DerivedTypeSpec &spec{dyType.GetDerivedTypeSpec()}; |
808 | Scope *derivedScope{const_cast<Scope *>( |
809 | spec.scope() ? spec.scope() : spec.typeSymbol().scope())}; |
810 | if (const Symbol * |
811 | derivedDescription{DescribeType( |
812 | dtScope&: DEREF(derivedScope), /*wantUninstantiatedPDT=*/false)}) { |
813 | AddValue(values, componentSchema_, "derived"s, |
814 | evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{ |
815 | evaluate::Designator<evaluate::SomeDerived>{ |
816 | DEREF(derivedDescription)}})); |
817 | // Package values of LEN parameters, if any |
818 | if (const SymbolVector * |
819 | specParams{GetTypeParameters(spec.typeSymbol())}) { |
820 | for (SymbolRef ref : *specParams) { |
821 | const auto &tpd{ref->get<TypeParamDetails>()}; |
822 | if (tpd.attr() && *tpd.attr() == common::TypeParamAttr::Len) { |
823 | if (const ParamValue * |
824 | paramValue{spec.FindParameter(ref->name())}) { |
825 | lenParams.emplace_back(GetValue(*paramValue, parameters)); |
826 | } else { |
827 | lenParams.emplace_back(GetValue(tpd.init(), parameters)); |
828 | } |
829 | } |
830 | } |
831 | } |
832 | } |
833 | } else { |
834 | // Subtle: a category of Derived with a null derived type pointer |
835 | // signifies CLASS(*) |
836 | AddValue(values, componentSchema_, "derived"s, |
837 | SomeExpr{evaluate::NullPointer{}}); |
838 | } |
839 | // LEN type parameter values for the component's type |
840 | if (!lenParams.empty()) { |
841 | AddValue(values, componentSchema_, "lenvalue"s, |
842 | SaveDerivedPointerTarget(scope, |
843 | SaveObjectName((fir::kLenParameterSeparator + distinctName + |
844 | fir::kNameSeparator + symbol.name().ToString()) |
845 | .str()), |
846 | std::move(lenParams), |
847 | evaluate::ConstantSubscripts{ |
848 | static_cast<evaluate::ConstantSubscript>(lenParams.size())})); |
849 | } else { |
850 | AddValue(values, componentSchema_, "lenvalue"s, |
851 | SomeExpr{evaluate::NullPointer{}}); |
852 | } |
853 | // Shape information |
854 | AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank)); |
855 | if (rank > 0 && !IsAllocatable(symbol) && !IsPointer(symbol)) { |
856 | std::vector<evaluate::StructureConstructor> bounds; |
857 | evaluate::NamedEntity entity{symbol}; |
858 | for (int j{0}; j < rank; ++j) { |
859 | bounds.emplace_back( |
860 | GetValue(std::make_optional( |
861 | evaluate::GetRawLowerBound(foldingContext, entity, j)), |
862 | parameters)); |
863 | bounds.emplace_back(GetValue( |
864 | evaluate::GetRawUpperBound(foldingContext, entity, j), parameters)); |
865 | } |
866 | AddValue(values, componentSchema_, "bounds"s, |
867 | SaveDerivedPointerTarget(scope, |
868 | SaveObjectName((fir::kBoundsSeparator + distinctName + |
869 | fir::kNameSeparator + symbol.name().ToString()) |
870 | .str()), |
871 | std::move(bounds), evaluate::ConstantSubscripts{2, rank})); |
872 | } else { |
873 | AddValue( |
874 | values, componentSchema_, "bounds"s, SomeExpr{evaluate::NullPointer{}}); |
875 | } |
876 | // Default component initialization |
877 | bool hasDataInit{false}; |
878 | if (IsAllocatable(symbol)) { |
879 | AddValue(values, componentSchema_, "genre"s, GetEnumValue( "allocatable")); |
880 | } else if (IsPointer(symbol)) { |
881 | AddValue(values, componentSchema_, "genre"s, GetEnumValue( "pointer")); |
882 | hasDataInit = InitializeDataPointer( |
883 | values, symbol, object, scope, dtScope, distinctName); |
884 | } else if (IsAutomatic(symbol)) { |
885 | AddValue(values, componentSchema_, "genre"s, GetEnumValue( "automatic")); |
886 | } else { |
887 | AddValue(values, componentSchema_, "genre"s, GetEnumValue( "data")); |
888 | hasDataInit = object.init().has_value(); |
889 | if (hasDataInit) { |
890 | AddValue(values, componentSchema_, "initialization"s, |
891 | SaveObjectInit(scope, |
892 | SaveObjectName((fir::kComponentInitSeparator + distinctName + |
893 | fir::kNameSeparator + symbol.name().ToString()) |
894 | .str()), |
895 | object)); |
896 | } |
897 | } |
898 | if (!hasDataInit) { |
899 | AddValue(values, componentSchema_, "initialization"s, |
900 | SomeExpr{evaluate::NullPointer{}}); |
901 | } |
902 | return {DEREF(componentSchema_.AsDerived()), std::move(values)}; |
903 | } |
904 | |
905 | evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent( |
906 | const Symbol &symbol, const ProcEntityDetails &proc, Scope &scope) { |
907 | evaluate::StructureConstructorValues values; |
908 | AddValue(values, procPtrSchema_, "name"s, |
909 | SaveNameAsPointerTarget(scope, symbol.name().ToString())); |
910 | AddValue(values, procPtrSchema_, "offset"s, IntExpr<8>(symbol.offset())); |
911 | if (auto init{proc.init()}; init && *init) { |
912 | AddValue(values, procPtrSchema_, "initialization"s, |
913 | SomeExpr{evaluate::ProcedureDesignator{**init}}); |
914 | } else { |
915 | AddValue(values, procPtrSchema_, "initialization"s, |
916 | SomeExpr{evaluate::NullPointer{}}); |
917 | } |
918 | return {DEREF(procPtrSchema_.AsDerived()), std::move(values)}; |
919 | } |
920 | |
921 | // Create a static pointer object with the same initialization |
922 | // from whence the runtime can memcpy() the data pointer |
923 | // component initialization. |
924 | // Creates and interconnects the symbols, scopes, and types for |
925 | // TYPE :: ptrDt |
926 | // type, POINTER :: name |
927 | // END TYPE |
928 | // TYPE(ptrDt), TARGET, SAVE :: ptrInit = ptrDt(designator) |
929 | // and then initializes the original component by setting |
930 | // initialization = ptrInit |
931 | // which takes the address of ptrInit because the type is C_PTR. |
932 | // This technique of wrapping the data pointer component into |
933 | // a derived type instance disables any reason for lowering to |
934 | // attempt to dereference the RHS of an initializer, thereby |
935 | // allowing the runtime to actually perform the initialization |
936 | // by means of a simple memcpy() of the wrapped descriptor in |
937 | // ptrInit to the data pointer component being initialized. |
938 | bool RuntimeTableBuilder::InitializeDataPointer( |
939 | evaluate::StructureConstructorValues &values, const Symbol &symbol, |
940 | const ObjectEntityDetails &object, Scope &scope, Scope &dtScope, |
941 | const std::string &distinctName) { |
942 | if (object.init().has_value()) { |
943 | SourceName ptrDtName{SaveObjectName((fir::kDataPtrInitSeparator + |
944 | distinctName + fir::kNameSeparator + symbol.name().ToString()) |
945 | .str())}; |
946 | Symbol &ptrDtSym{ |
947 | *scope.try_emplace(ptrDtName, Attrs{}, UnknownDetails{}).first->second}; |
948 | SetReadOnlyCompilerCreatedFlags(ptrDtSym); |
949 | Scope &ptrDtScope{scope.MakeScope(Scope::Kind::DerivedType, &ptrDtSym)}; |
950 | ignoreScopes_.insert(&ptrDtScope); |
951 | ObjectEntityDetails ptrDtObj; |
952 | ptrDtObj.set_type(DEREF(object.type())); |
953 | ptrDtObj.set_shape(object.shape()); |
954 | Symbol &ptrDtComp{*ptrDtScope |
955 | .try_emplace(symbol.name(), Attrs{Attr::POINTER}, |
956 | std::move(ptrDtObj)) |
957 | .first->second}; |
958 | DerivedTypeDetails ptrDtDetails; |
959 | ptrDtDetails.add_component(ptrDtComp); |
960 | ptrDtSym.set_details(std::move(ptrDtDetails)); |
961 | ptrDtSym.set_scope(&ptrDtScope); |
962 | DeclTypeSpec &ptrDtDeclType{ |
963 | scope.MakeDerivedType(DeclTypeSpec::Category::TypeDerived, |
964 | DerivedTypeSpec{ptrDtName, ptrDtSym})}; |
965 | DerivedTypeSpec &ptrDtDerived{DEREF(ptrDtDeclType.AsDerived())}; |
966 | ptrDtDerived.set_scope(ptrDtScope); |
967 | ptrDtDerived.CookParameters(context_.foldingContext()); |
968 | ptrDtDerived.Instantiate(scope); |
969 | ObjectEntityDetails ptrInitObj; |
970 | ptrInitObj.set_type(ptrDtDeclType); |
971 | evaluate::StructureConstructorValues ptrInitValues; |
972 | AddValue( |
973 | ptrInitValues, ptrDtDeclType, symbol.name().ToString(), *object.init()); |
974 | ptrInitObj.set_init(evaluate::AsGenericExpr( |
975 | Structure(ptrDtDeclType, std::move(ptrInitValues)))); |
976 | AddValue(values, componentSchema_, "initialization"s, |
977 | SaveObjectInit(scope, |
978 | SaveObjectName((fir::kComponentInitSeparator + distinctName + |
979 | fir::kNameSeparator + symbol.name().ToString()) |
980 | .str()), |
981 | ptrInitObj)); |
982 | return true; |
983 | } else { |
984 | return false; |
985 | } |
986 | } |
987 | |
988 | evaluate::StructureConstructor RuntimeTableBuilder::PackageIntValue( |
989 | const SomeExpr &genre, std::int64_t n) const { |
990 | evaluate::StructureConstructorValues xs; |
991 | AddValue(xs, valueSchema_, "genre"s, genre); |
992 | AddValue(xs, valueSchema_, "value"s, IntToExpr(n)); |
993 | return Structure(valueSchema_, std::move(xs)); |
994 | } |
995 | |
996 | SomeExpr RuntimeTableBuilder::PackageIntValueExpr( |
997 | const SomeExpr &genre, std::int64_t n) const { |
998 | return StructureExpr(PackageIntValue(genre, n)); |
999 | } |
1000 | |
1001 | SymbolVector CollectBindings(const Scope &dtScope) { |
1002 | SymbolVector result; |
1003 | std::map<SourceName, Symbol *> localBindings; |
1004 | // Collect local bindings |
1005 | for (auto pair : dtScope) { |
1006 | Symbol &symbol{const_cast<Symbol &>(*pair.second)}; |
1007 | if (auto *binding{symbol.detailsIf<ProcBindingDetails>()}) { |
1008 | localBindings.emplace(symbol.name(), &symbol); |
1009 | binding->set_numPrivatesNotOverridden(0); |
1010 | } |
1011 | } |
1012 | if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) { |
1013 | result = CollectBindings(*parentScope); |
1014 | // Apply overrides from the local bindings of the extended type |
1015 | for (auto iter{result.begin()}; iter != result.end(); ++iter) { |
1016 | const Symbol &symbol{**iter}; |
1017 | auto overriderIter{localBindings.find(symbol.name())}; |
1018 | if (overriderIter != localBindings.end()) { |
1019 | Symbol &overrider{*overriderIter->second}; |
1020 | if (symbol.attrs().test(Attr::PRIVATE) && |
1021 | !symbol.attrs().test(Attr::DEFERRED) && |
1022 | FindModuleContaining(symbol.owner()) != |
1023 | FindModuleContaining(dtScope)) { |
1024 | // Don't override inaccessible PRIVATE bindings, unless |
1025 | // they are deferred |
1026 | auto &binding{overrider.get<ProcBindingDetails>()}; |
1027 | binding.set_numPrivatesNotOverridden( |
1028 | binding.numPrivatesNotOverridden() + 1); |
1029 | } else { |
1030 | *iter = overrider; |
1031 | localBindings.erase(overriderIter); |
1032 | } |
1033 | } |
1034 | } |
1035 | } |
1036 | // Add remaining (non-overriding) local bindings in name order to the result |
1037 | for (auto pair : localBindings) { |
1038 | result.push_back(*pair.second); |
1039 | } |
1040 | return result; |
1041 | } |
1042 | |
1043 | std::vector<evaluate::StructureConstructor> |
1044 | RuntimeTableBuilder::DescribeBindings(const Scope &dtScope, Scope &scope) { |
1045 | std::vector<evaluate::StructureConstructor> result; |
1046 | for (const SymbolRef &ref : CollectBindings(dtScope)) { |
1047 | evaluate::StructureConstructorValues values; |
1048 | AddValue(values, bindingSchema_, procCompName, |
1049 | SomeExpr{evaluate::ProcedureDesignator{ |
1050 | ref.get().get<ProcBindingDetails>().symbol()}}); |
1051 | AddValue(values, bindingSchema_, "name"s, |
1052 | SaveNameAsPointerTarget(scope, ref.get().name().ToString())); |
1053 | result.emplace_back(DEREF(bindingSchema_.AsDerived()), std::move(values)); |
1054 | } |
1055 | return result; |
1056 | } |
1057 | |
1058 | std::map<int, evaluate::StructureConstructor> |
1059 | RuntimeTableBuilder::DescribeSpecialGenerics(const Scope &dtScope, |
1060 | const Scope &thisScope, const DerivedTypeSpec *derivedTypeSpec) const { |
1061 | std::map<int, evaluate::StructureConstructor> specials; |
1062 | if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) { |
1063 | specials = |
1064 | DescribeSpecialGenerics(*parentScope, thisScope, derivedTypeSpec); |
1065 | } |
1066 | for (const auto &pair : dtScope) { |
1067 | const Symbol &symbol{*pair.second}; |
1068 | if (const auto *generic{symbol.detailsIf<GenericDetails>()}) { |
1069 | DescribeSpecialGeneric(*generic, specials, thisScope, derivedTypeSpec); |
1070 | } |
1071 | } |
1072 | return specials; |
1073 | } |
1074 | |
1075 | void RuntimeTableBuilder::DescribeSpecialGeneric(const GenericDetails &generic, |
1076 | std::map<int, evaluate::StructureConstructor> &specials, |
1077 | const Scope &dtScope, const DerivedTypeSpec *derivedTypeSpec) const { |
1078 | common::visit( |
1079 | common::visitors{ |
1080 | [&](const GenericKind::OtherKind &k) { |
1081 | if (k == GenericKind::OtherKind::Assignment) { |
1082 | for (auto ref : generic.specificProcs()) { |
1083 | DescribeSpecialProc(specials, *ref, /*isAssignment=*/true, |
1084 | /*isFinal=*/false, std::nullopt, &dtScope, derivedTypeSpec, |
1085 | /*isTypeBound=*/true); |
1086 | } |
1087 | } |
1088 | }, |
1089 | [&](const common::DefinedIo &io) { |
1090 | switch (io) { |
1091 | case common::DefinedIo::ReadFormatted: |
1092 | case common::DefinedIo::ReadUnformatted: |
1093 | case common::DefinedIo::WriteFormatted: |
1094 | case common::DefinedIo::WriteUnformatted: |
1095 | for (auto ref : generic.specificProcs()) { |
1096 | DescribeSpecialProc(specials, *ref, /*isAssignment=*/false, |
1097 | /*isFinal=*/false, io, &dtScope, derivedTypeSpec, |
1098 | /*isTypeBound=*/true); |
1099 | } |
1100 | break; |
1101 | } |
1102 | }, |
1103 | [](const auto &) {}, |
1104 | }, |
1105 | generic.kind().u); |
1106 | } |
1107 | |
1108 | void RuntimeTableBuilder::DescribeSpecialProc( |
1109 | std::map<int, evaluate::StructureConstructor> &specials, |
1110 | const Symbol &specificOrBinding, bool isAssignment, bool isFinal, |
1111 | std::optional<common::DefinedIo> io, const Scope *dtScope, |
1112 | const DerivedTypeSpec *derivedTypeSpec, bool isTypeBound) const { |
1113 | const auto *binding{specificOrBinding.detailsIf<ProcBindingDetails>()}; |
1114 | if (binding && dtScope) { // use most recent override |
1115 | binding = &DEREF(dtScope->FindComponent(specificOrBinding.name())) |
1116 | .get<ProcBindingDetails>(); |
1117 | } |
1118 | const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)}; |
1119 | if (auto proc{evaluate::characteristics::Procedure::Characterize( |
1120 | specific, context_.foldingContext())}) { |
1121 | std::uint8_t isArgDescriptorSet{0}; |
1122 | std::uint8_t isArgContiguousSet{0}; |
1123 | int argThatMightBeDescriptor{0}; |
1124 | MaybeExpr which; |
1125 | if (isAssignment) { |
1126 | // Only type-bound asst's with compatible types on both dummy arguments |
1127 | // are germane to the runtime, which needs only these to implement |
1128 | // component assignment as part of intrinsic assignment. |
1129 | // Non-type-bound generic INTERFACEs and assignments from incompatible |
1130 | // types must not be used for component intrinsic assignment. |
1131 | CHECK(proc->dummyArguments.size() == 2); |
1132 | const auto t1{ |
1133 | DEREF(std::get_if<evaluate::characteristics::DummyDataObject>( |
1134 | &proc->dummyArguments[0].u)) |
1135 | .type.type()}; |
1136 | const auto t2{ |
1137 | DEREF(std::get_if<evaluate::characteristics::DummyDataObject>( |
1138 | &proc->dummyArguments[1].u)) |
1139 | .type.type()}; |
1140 | if (!binding || t1.category() != TypeCategory::Derived || |
1141 | t2.category() != TypeCategory::Derived || |
1142 | t1.IsUnlimitedPolymorphic() || t2.IsUnlimitedPolymorphic()) { |
1143 | return; |
1144 | } |
1145 | if (!derivedTypeSpec || |
1146 | !derivedTypeSpec->MatchesOrExtends(t1.GetDerivedTypeSpec()) || |
1147 | !derivedTypeSpec->MatchesOrExtends(t2.GetDerivedTypeSpec())) { |
1148 | return; |
1149 | } |
1150 | which = proc->IsElemental() ? elementalAssignmentEnum_ |
1151 | : scalarAssignmentEnum_; |
1152 | if (binding && binding->passName() && |
1153 | *binding->passName() == proc->dummyArguments[1].name) { |
1154 | argThatMightBeDescriptor = 1; |
1155 | isArgDescriptorSet |= 2; |
1156 | } else { |
1157 | argThatMightBeDescriptor = 2; // the non-passed-object argument |
1158 | isArgDescriptorSet |= 1; |
1159 | } |
1160 | } else if (isFinal) { |
1161 | CHECK(binding == nullptr); // FINALs are not bindings |
1162 | CHECK(proc->dummyArguments.size() == 1); |
1163 | if (proc->IsElemental()) { |
1164 | which = elementalFinalEnum_; |
1165 | } else { |
1166 | const auto &dummyData{ |
1167 | std::get<evaluate::characteristics::DummyDataObject>( |
1168 | proc->dummyArguments.at(0).u)}; |
1169 | const auto &typeAndShape{dummyData.type}; |
1170 | if (typeAndShape.attrs().test( |
1171 | evaluate::characteristics::TypeAndShape::Attr::AssumedRank)) { |
1172 | which = assumedRankFinalEnum_; |
1173 | isArgDescriptorSet |= 1; |
1174 | } else { |
1175 | which = scalarFinalEnum_; |
1176 | if (int rank{typeAndShape.Rank()}; rank > 0) { |
1177 | which = IntExpr<1>(ToInt64(which).value() + rank); |
1178 | if (dummyData.IsPassedByDescriptor(proc->IsBindC())) { |
1179 | argThatMightBeDescriptor = 1; |
1180 | } |
1181 | if (!typeAndShape.attrs().test(evaluate::characteristics:: |
1182 | TypeAndShape::Attr::AssumedShape) || |
1183 | dummyData.attrs.test(evaluate::characteristics:: |
1184 | DummyDataObject::Attr::Contiguous)) { |
1185 | isArgContiguousSet |= 1; |
1186 | } |
1187 | } |
1188 | } |
1189 | } |
1190 | } else { // defined derived type I/O |
1191 | CHECK(proc->dummyArguments.size() >= 4); |
1192 | const auto *ddo{std::get_if<evaluate::characteristics::DummyDataObject>( |
1193 | &proc->dummyArguments[0].u)}; |
1194 | if (!ddo) { |
1195 | return; |
1196 | } |
1197 | if (derivedTypeSpec && |
1198 | !ddo->type.type().IsTkCompatibleWith( |
1199 | evaluate::DynamicType{*derivedTypeSpec})) { |
1200 | // Defined I/O specific procedure is not for this derived type. |
1201 | return; |
1202 | } |
1203 | if (ddo->type.type().IsPolymorphic()) { |
1204 | isArgDescriptorSet |= 1; |
1205 | } |
1206 | switch (io.value()) { |
1207 | case common::DefinedIo::ReadFormatted: |
1208 | which = readFormattedEnum_; |
1209 | break; |
1210 | case common::DefinedIo::ReadUnformatted: |
1211 | which = readUnformattedEnum_; |
1212 | break; |
1213 | case common::DefinedIo::WriteFormatted: |
1214 | which = writeFormattedEnum_; |
1215 | break; |
1216 | case common::DefinedIo::WriteUnformatted: |
1217 | which = writeUnformattedEnum_; |
1218 | break; |
1219 | } |
1220 | } |
1221 | if (argThatMightBeDescriptor != 0) { |
1222 | if (const auto *dummyData{ |
1223 | std::get_if<evaluate::characteristics::DummyDataObject>( |
1224 | &proc->dummyArguments.at(argThatMightBeDescriptor - 1).u)}) { |
1225 | if (dummyData->IsPassedByDescriptor(proc->IsBindC())) { |
1226 | isArgDescriptorSet |= 1 << (argThatMightBeDescriptor - 1); |
1227 | } |
1228 | } |
1229 | } |
1230 | evaluate::StructureConstructorValues values; |
1231 | auto index{evaluate::ToInt64(which)}; |
1232 | CHECK(index.has_value()); |
1233 | AddValue( |
1234 | values, specialSchema_, "which"s, SomeExpr{std::move(which.value())}); |
1235 | AddValue(values, specialSchema_, "isargdescriptorset"s, |
1236 | IntExpr<1>(isArgDescriptorSet)); |
1237 | AddValue(values, specialSchema_, "istypebound"s, |
1238 | IntExpr<1>(isTypeBound ? 1 : 0)); |
1239 | AddValue(values, specialSchema_, "isargcontiguousset"s, |
1240 | IntExpr<1>(isArgContiguousSet)); |
1241 | AddValue(values, specialSchema_, procCompName, |
1242 | SomeExpr{evaluate::ProcedureDesignator{specific}}); |
1243 | // index might already be present in the case of an override |
1244 | specials.insert_or_assign(*index, |
1245 | evaluate::StructureConstructor{ |
1246 | DEREF(specialSchema_.AsDerived()), std::move(values)}); |
1247 | } |
1248 | } |
1249 | |
1250 | void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces( |
1251 | std::map<int, evaluate::StructureConstructor> &specials, |
1252 | common::DefinedIo definedIo, const Scope *scope, |
1253 | const DerivedTypeSpec *derivedTypeSpec) { |
1254 | SourceName name{GenericKind::AsFortran(definedIo)}; |
1255 | for (; !scope->IsGlobal(); scope = &scope->parent()) { |
1256 | if (auto asst{scope->find(name)}; asst != scope->end()) { |
1257 | const Symbol &generic{asst->second->GetUltimate()}; |
1258 | const auto &genericDetails{generic.get<GenericDetails>()}; |
1259 | CHECK(std::holds_alternative<common::DefinedIo>(genericDetails.kind().u)); |
1260 | CHECK(std::get<common::DefinedIo>(genericDetails.kind().u) == definedIo); |
1261 | for (auto ref : genericDetails.specificProcs()) { |
1262 | DescribeSpecialProc(specials, *ref, false, false, definedIo, nullptr, |
1263 | derivedTypeSpec, false); |
1264 | } |
1265 | } |
1266 | } |
1267 | } |
1268 | |
1269 | RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables( |
1270 | SemanticsContext &context) { |
1271 | RuntimeDerivedTypeTables result; |
1272 | // Do not attempt to read __fortran_type_info.mod when compiling |
1273 | // the module on which it depends. |
1274 | const auto &allSources{context.allCookedSources().allSources()}; |
1275 | if (auto firstProv{allSources.GetFirstFileProvenance()}) { |
1276 | if (const auto *srcFile{allSources.GetSourceFile(firstProv->start())}) { |
1277 | if (srcFile->path().find("__fortran_builtins.f90") != std::string::npos) { |
1278 | return result; |
1279 | } |
1280 | } |
1281 | } |
1282 | result.schemata = context.GetBuiltinModule(typeInfoBuiltinModule); |
1283 | if (result.schemata) { |
1284 | RuntimeTableBuilder builder{context, result}; |
1285 | builder.DescribeTypes(scope&: context.globalScope(), inSchemata: false); |
1286 | } |
1287 | return result; |
1288 | } |
1289 | |
1290 | // Find the type of a defined I/O procedure's interface's initial "dtv" |
1291 | // dummy argument. Returns a non-null DeclTypeSpec pointer only if that |
1292 | // dtv argument exists and is a derived type. |
1293 | static const DeclTypeSpec *GetDefinedIoSpecificArgType(const Symbol &specific) { |
1294 | const Symbol *interface{&specific.GetUltimate()}; |
1295 | if (const auto *procEntity{specific.detailsIf<ProcEntityDetails>()}) { |
1296 | interface = procEntity->procInterface(); |
1297 | } |
1298 | if (interface) { |
1299 | if (const SubprogramDetails * |
1300 | subprogram{interface->detailsIf<SubprogramDetails>()}; |
1301 | subprogram && !subprogram->dummyArgs().empty()) { |
1302 | if (const Symbol * dtvArg{subprogram->dummyArgs().at(0)}) { |
1303 | if (const DeclTypeSpec * declType{dtvArg->GetType()}) { |
1304 | return declType->AsDerived() ? declType : nullptr; |
1305 | } |
1306 | } |
1307 | } |
1308 | } |
1309 | return nullptr; |
1310 | } |
1311 | |
1312 | // Locate a particular scope's generic interface for a specific kind of |
1313 | // defined I/O. |
1314 | static const Symbol *FindGenericDefinedIo( |
1315 | const Scope &scope, common::DefinedIo which) { |
1316 | if (const Symbol * symbol{scope.FindSymbol(GenericKind::AsFortran(which))}) { |
1317 | const Symbol &generic{symbol->GetUltimate()}; |
1318 | const auto &genericDetails{generic.get<GenericDetails>()}; |
1319 | CHECK(std::holds_alternative<common::DefinedIo>(genericDetails.kind().u)); |
1320 | CHECK(std::get<common::DefinedIo>(genericDetails.kind().u) == which); |
1321 | return &generic; |
1322 | } else { |
1323 | return nullptr; |
1324 | } |
1325 | } |
1326 | |
1327 | std::multimap<const Symbol *, NonTbpDefinedIo> |
1328 | CollectNonTbpDefinedIoGenericInterfaces( |
1329 | const Scope &scope, bool useRuntimeTypeInfoEntries) { |
1330 | std::multimap<const Symbol *, NonTbpDefinedIo> result; |
1331 | if (!scope.IsTopLevel() && |
1332 | (scope.GetImportKind() == Scope::ImportKind::All || |
1333 | scope.GetImportKind() == Scope::ImportKind::Default)) { |
1334 | result = CollectNonTbpDefinedIoGenericInterfaces( |
1335 | scope.parent(), useRuntimeTypeInfoEntries); |
1336 | } |
1337 | if (scope.kind() != Scope::Kind::DerivedType) { |
1338 | for (common::DefinedIo which : |
1339 | {common::DefinedIo::ReadFormatted, common::DefinedIo::ReadUnformatted, |
1340 | common::DefinedIo::WriteFormatted, |
1341 | common::DefinedIo::WriteUnformatted}) { |
1342 | if (const Symbol * generic{FindGenericDefinedIo(scope, which)}) { |
1343 | for (auto specific : generic->get<GenericDetails>().specificProcs()) { |
1344 | if (const DeclTypeSpec * |
1345 | declType{GetDefinedIoSpecificArgType(*specific)}) { |
1346 | const DerivedTypeSpec &derived{DEREF(declType->AsDerived())}; |
1347 | if (const Symbol * |
1348 | dtDesc{derived.scope() |
1349 | ? derived.scope()->runtimeDerivedTypeDescription() |
1350 | : nullptr}) { |
1351 | if (useRuntimeTypeInfoEntries && |
1352 | &derived.scope()->parent() == &generic->owner()) { |
1353 | // This non-TBP defined I/O generic was defined in the |
1354 | // same scope as the derived type, and it will be |
1355 | // included in the derived type's special bindings |
1356 | // by IncorporateDefinedIoGenericInterfaces(). |
1357 | } else { |
1358 | // Local scope's specific overrides host's for this type |
1359 | bool updated{false}; |
1360 | for (auto [iter, end]{result.equal_range(dtDesc)}; iter != end; |
1361 | ++iter) { |
1362 | NonTbpDefinedIo &nonTbp{iter->second}; |
1363 | if (nonTbp.definedIo == which) { |
1364 | nonTbp.subroutine = &*specific; |
1365 | nonTbp.isDtvArgPolymorphic = declType->IsPolymorphic(); |
1366 | updated = true; |
1367 | } |
1368 | } |
1369 | if (!updated) { |
1370 | result.emplace(dtDesc, |
1371 | NonTbpDefinedIo{ |
1372 | &*specific, which, declType->IsPolymorphic()}); |
1373 | } |
1374 | } |
1375 | } |
1376 | } |
1377 | } |
1378 | } |
1379 | } |
1380 | } |
1381 | return result; |
1382 | } |
1383 | |
1384 | // ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces() |
1385 | // |
1386 | // Returns a true result when a kind of defined I/O generic procedure |
1387 | // has a type (from a symbol or a NAMELIST) such that |
1388 | // (1) there is a specific procedure matching that type for a non-type-bound |
1389 | // generic defined in the scope of the type, and |
1390 | // (2) that specific procedure is unavailable or overridden in a particular |
1391 | // local scope. |
1392 | // Specific procedures of non-type-bound defined I/O generic interfaces |
1393 | // declared in the scope of a derived type are identified as special bindings |
1394 | // in the derived type's runtime type information, as if they had been |
1395 | // type-bound. This predicate is meant to determine local situations in |
1396 | // which those special bindings are not to be used. Its result is intended |
1397 | // to be put into the "ignoreNonTbpEntries" flag of |
1398 | // runtime::NonTbpDefinedIoTable and passed (negated) as the |
1399 | // "useRuntimeTypeInfoEntries" argument of |
1400 | // CollectNonTbpDefinedIoGenericInterfaces() above. |
1401 | |
1402 | static const Symbol *FindSpecificDefinedIo(const Scope &scope, |
1403 | const evaluate::DynamicType &derived, common::DefinedIo which) { |
1404 | if (const Symbol * generic{FindGenericDefinedIo(scope, which)}) { |
1405 | for (auto ref : generic->get<GenericDetails>().specificProcs()) { |
1406 | const Symbol &specific{*ref}; |
1407 | if (const DeclTypeSpec * |
1408 | thisType{GetDefinedIoSpecificArgType(specific)}) { |
1409 | if (evaluate::DynamicType{DEREF(thisType->AsDerived()), true} |
1410 | .IsTkCompatibleWith(derived)) { |
1411 | return &specific.GetUltimate(); |
1412 | } |
1413 | } |
1414 | } |
1415 | } |
1416 | return nullptr; |
1417 | } |
1418 | |
1419 | bool ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces( |
1420 | const Scope &scope, const DerivedTypeSpec *derived) { |
1421 | if (!derived) { |
1422 | return false; |
1423 | } |
1424 | const Symbol &typeSymbol{derived->typeSymbol()}; |
1425 | const Scope &typeScope{typeSymbol.GetUltimate().owner()}; |
1426 | evaluate::DynamicType dyType{*derived}; |
1427 | for (common::DefinedIo which : |
1428 | {common::DefinedIo::ReadFormatted, common::DefinedIo::ReadUnformatted, |
1429 | common::DefinedIo::WriteFormatted, |
1430 | common::DefinedIo::WriteUnformatted}) { |
1431 | if (const Symbol * |
1432 | specific{FindSpecificDefinedIo(typeScope, dyType, which)}) { |
1433 | // There's a non-TBP defined I/O procedure in the scope of the type's |
1434 | // definition that applies to this type. It will appear in the type's |
1435 | // runtime information. Determine whether it still applies in the |
1436 | // scope of interest. |
1437 | if (FindSpecificDefinedIo(scope, dyType, which) != specific) { |
1438 | return true; |
1439 | } |
1440 | } |
1441 | } |
1442 | return false; |
1443 | } |
1444 | |
1445 | bool ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces( |
1446 | const Scope &scope, const DeclTypeSpec *type) { |
1447 | return type && |
1448 | ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces( |
1449 | scope, type->AsDerived()); |
1450 | } |
1451 | |
1452 | bool ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces( |
1453 | const Scope &scope, const Symbol *symbol) { |
1454 | if (!symbol) { |
1455 | return false; |
1456 | } |
1457 | return common::visit( |
1458 | common::visitors{ |
1459 | [&](const NamelistDetails &x) { |
1460 | for (auto ref : x.objects()) { |
1461 | if (ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces( |
1462 | scope, &*ref)) { |
1463 | return true; |
1464 | } |
1465 | } |
1466 | return false; |
1467 | }, |
1468 | [&](const auto &) { |
1469 | return ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces( |
1470 | scope, symbol->GetType()); |
1471 | }, |
1472 | }, |
1473 | symbol->GetUltimate().details()); |
1474 | } |
1475 | |
1476 | } // namespace Fortran::semantics |
1477 |
Definitions
- FindLenParameterIndex
- RuntimeTableBuilder
- GetValue
- GetValue
- RuntimeTableBuilder
- SetReadOnlyCompilerCreatedFlags
- SaveDerivedPointerTarget
- DescribeTypes
- GetTypeParameters
- GetContainingNonDerivedScope
- GetSchemaField
- GetSchemaField
- AddValue
- AddValue
- IntToExpr
- Structure
- StructureExpr
- GetIntegerKind
- SaveNumericPointerTarget
- SaveObjectInit
- IntExpr
- GetSuffixIfTypeKindParameters
- DescribeType
- GetSymbol
- GetSchemaSymbol
- GetSchema
- GetEnumValue
- CreateObject
- SaveObjectName
- SaveNameAsPointerTarget
- DescribeComponent
- DescribeComponent
- InitializeDataPointer
- PackageIntValue
- PackageIntValueExpr
- CollectBindings
- DescribeBindings
- DescribeSpecialGenerics
- DescribeSpecialGeneric
- DescribeSpecialProc
- IncorporateDefinedIoGenericInterfaces
- BuildRuntimeDerivedTypeTables
- GetDefinedIoSpecificArgType
- FindGenericDefinedIo
- CollectNonTbpDefinedIoGenericInterfaces
- FindSpecificDefinedIo
- ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces
- ShouldIgnoreRuntimeTypeInfoNonTbpGenericInterfaces
Update your C++ knowledge – Modern C++11/14/17 Training
Find out more