1 //===-- include/flang/Semantics/type.h --------------------------*- 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 #ifndef FORTRAN_SEMANTICS_TYPE_H_
10 #define FORTRAN_SEMANTICS_TYPE_H_
11
12 #include "flang/Common/Fortran.h"
13 #include "flang/Common/idioms.h"
14 #include "flang/Evaluate/expression.h"
15 #include "flang/Parser/char-block.h"
16 #include <algorithm>
17 #include <iosfwd>
18 #include <map>
19 #include <optional>
20 #include <string>
21 #include <variant>
22 #include <vector>
23
24 namespace llvm {
25 class raw_ostream;
26 }
27
28 namespace Fortran::parser {
29 struct Keyword;
30 }
31
32 namespace Fortran::semantics {
33
34 class Scope;
35 class SemanticsContext;
36 class Symbol;
37
38 /// A SourceName is a name in the cooked character stream,
39 /// i.e. a range of lower-case characters with provenance.
40 using SourceName = parser::CharBlock;
41 using TypeCategory = common::TypeCategory;
42 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
43 using MaybeExpr = std::optional<SomeExpr>;
44 using SomeIntExpr = evaluate::Expr<evaluate::SomeInteger>;
45 using MaybeIntExpr = std::optional<SomeIntExpr>;
46 using SubscriptIntExpr = evaluate::Expr<evaluate::SubscriptInteger>;
47 using MaybeSubscriptIntExpr = std::optional<SubscriptIntExpr>;
48 using KindExpr = SubscriptIntExpr;
49
50 // An array spec bound: an explicit integer expression or ASSUMED or DEFERRED
51 class Bound {
52 public:
Assumed()53 static Bound Assumed() { return Bound(Category::Assumed); }
Deferred()54 static Bound Deferred() { return Bound(Category::Deferred); }
Bound(MaybeSubscriptIntExpr && expr)55 explicit Bound(MaybeSubscriptIntExpr &&expr) : expr_{std::move(expr)} {}
56 explicit Bound(common::ConstantSubscript bound);
57 Bound(const Bound &) = default;
58 Bound(Bound &&) = default;
59 Bound &operator=(const Bound &) = default;
60 Bound &operator=(Bound &&) = default;
isExplicit()61 bool isExplicit() const { return category_ == Category::Explicit; }
isAssumed()62 bool isAssumed() const { return category_ == Category::Assumed; }
isDeferred()63 bool isDeferred() const { return category_ == Category::Deferred; }
GetExplicit()64 MaybeSubscriptIntExpr &GetExplicit() { return expr_; }
GetExplicit()65 const MaybeSubscriptIntExpr &GetExplicit() const { return expr_; }
SetExplicit(MaybeSubscriptIntExpr && expr)66 void SetExplicit(MaybeSubscriptIntExpr &&expr) {
67 CHECK(isExplicit());
68 expr_ = std::move(expr);
69 }
70
71 private:
72 enum class Category { Explicit, Deferred, Assumed };
Bound(Category category)73 Bound(Category category) : category_{category} {}
Bound(Category category,MaybeSubscriptIntExpr && expr)74 Bound(Category category, MaybeSubscriptIntExpr &&expr)
75 : category_{category}, expr_{std::move(expr)} {}
76 Category category_{Category::Explicit};
77 MaybeSubscriptIntExpr expr_;
78 friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Bound &);
79 };
80
81 // A type parameter value: integer expression or assumed or deferred.
82 class ParamValue {
83 public:
Assumed(common::TypeParamAttr attr)84 static ParamValue Assumed(common::TypeParamAttr attr) {
85 return ParamValue{Category::Assumed, attr};
86 }
Deferred(common::TypeParamAttr attr)87 static ParamValue Deferred(common::TypeParamAttr attr) {
88 return ParamValue{Category::Deferred, attr};
89 }
90 ParamValue(const ParamValue &) = default;
91 explicit ParamValue(MaybeIntExpr &&, common::TypeParamAttr);
92 explicit ParamValue(SomeIntExpr &&, common::TypeParamAttr attr);
93 explicit ParamValue(common::ConstantSubscript, common::TypeParamAttr attr);
isExplicit()94 bool isExplicit() const { return category_ == Category::Explicit; }
isAssumed()95 bool isAssumed() const { return category_ == Category::Assumed; }
isDeferred()96 bool isDeferred() const { return category_ == Category::Deferred; }
GetExplicit()97 const MaybeIntExpr &GetExplicit() const { return expr_; }
98 void SetExplicit(SomeIntExpr &&);
isKind()99 bool isKind() const { return attr_ == common::TypeParamAttr::Kind; }
isLen()100 bool isLen() const { return attr_ == common::TypeParamAttr::Len; }
set_attr(common::TypeParamAttr attr)101 void set_attr(common::TypeParamAttr attr) { attr_ = attr; }
102 bool operator==(const ParamValue &that) const {
103 return category_ == that.category_ && expr_ == that.expr_;
104 }
105 std::string AsFortran() const;
106
107 private:
108 enum class Category { Explicit, Deferred, Assumed };
ParamValue(Category category,common::TypeParamAttr attr)109 ParamValue(Category category, common::TypeParamAttr attr)
110 : category_{category}, attr_{attr} {}
111 Category category_{Category::Explicit};
112 common::TypeParamAttr attr_{common::TypeParamAttr::Kind};
113 MaybeIntExpr expr_;
114 friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ParamValue &);
115 };
116
117 class IntrinsicTypeSpec {
118 public:
category()119 TypeCategory category() const { return category_; }
kind()120 const KindExpr &kind() const { return kind_; }
121 bool operator==(const IntrinsicTypeSpec &x) const {
122 return category_ == x.category_ && kind_ == x.kind_;
123 }
124 bool operator!=(const IntrinsicTypeSpec &x) const { return !operator==(x); }
125 std::string AsFortran() const;
126
127 protected:
128 IntrinsicTypeSpec(TypeCategory, KindExpr &&);
129
130 private:
131 TypeCategory category_;
132 KindExpr kind_;
133 friend llvm::raw_ostream &operator<<(
134 llvm::raw_ostream &os, const IntrinsicTypeSpec &x);
135 };
136
137 class NumericTypeSpec : public IntrinsicTypeSpec {
138 public:
NumericTypeSpec(TypeCategory category,KindExpr && kind)139 NumericTypeSpec(TypeCategory category, KindExpr &&kind)
140 : IntrinsicTypeSpec(category, std::move(kind)) {
141 CHECK(common::IsNumericTypeCategory(category));
142 }
143 };
144
145 class LogicalTypeSpec : public IntrinsicTypeSpec {
146 public:
LogicalTypeSpec(KindExpr && kind)147 explicit LogicalTypeSpec(KindExpr &&kind)
148 : IntrinsicTypeSpec(TypeCategory::Logical, std::move(kind)) {}
149 };
150
151 class CharacterTypeSpec : public IntrinsicTypeSpec {
152 public:
CharacterTypeSpec(ParamValue && length,KindExpr && kind)153 CharacterTypeSpec(ParamValue &&length, KindExpr &&kind)
154 : IntrinsicTypeSpec(TypeCategory::Character, std::move(kind)),
155 length_{std::move(length)} {}
length()156 const ParamValue &length() const { return length_; }
157 bool operator==(const CharacterTypeSpec &that) const {
158 return kind() == that.kind() && length_ == that.length_;
159 }
160 std::string AsFortran() const;
161
162 private:
163 ParamValue length_;
164 friend llvm::raw_ostream &operator<<(
165 llvm::raw_ostream &os, const CharacterTypeSpec &x);
166 };
167
168 class ShapeSpec {
169 public:
170 // lb:ub
MakeExplicit(Bound && lb,Bound && ub)171 static ShapeSpec MakeExplicit(Bound &&lb, Bound &&ub) {
172 return ShapeSpec(std::move(lb), std::move(ub));
173 }
174 // 1:ub
MakeExplicit(Bound && ub)175 static const ShapeSpec MakeExplicit(Bound &&ub) {
176 return MakeExplicit(Bound{1}, std::move(ub));
177 }
178 // 1:
MakeAssumed()179 static ShapeSpec MakeAssumed() {
180 return ShapeSpec(Bound{1}, Bound::Deferred());
181 }
182 // lb:
MakeAssumed(Bound && lb)183 static ShapeSpec MakeAssumed(Bound &&lb) {
184 return ShapeSpec(std::move(lb), Bound::Deferred());
185 }
186 // :
MakeDeferred()187 static ShapeSpec MakeDeferred() {
188 return ShapeSpec(Bound::Deferred(), Bound::Deferred());
189 }
190 // 1:*
MakeImplied()191 static ShapeSpec MakeImplied() {
192 return ShapeSpec(Bound{1}, Bound::Assumed());
193 }
194 // lb:*
MakeImplied(Bound && lb)195 static ShapeSpec MakeImplied(Bound &&lb) {
196 return ShapeSpec(std::move(lb), Bound::Assumed());
197 }
198 // ..
MakeAssumedRank()199 static ShapeSpec MakeAssumedRank() {
200 return ShapeSpec(Bound::Assumed(), Bound::Assumed());
201 }
202
203 ShapeSpec(const ShapeSpec &) = default;
204 ShapeSpec(ShapeSpec &&) = default;
205 ShapeSpec &operator=(const ShapeSpec &) = default;
206 ShapeSpec &operator=(ShapeSpec &&) = default;
207
lbound()208 Bound &lbound() { return lb_; }
lbound()209 const Bound &lbound() const { return lb_; }
ubound()210 Bound &ubound() { return ub_; }
ubound()211 const Bound &ubound() const { return ub_; }
212
213 private:
ShapeSpec(Bound && lb,Bound && ub)214 ShapeSpec(Bound &&lb, Bound &&ub) : lb_{std::move(lb)}, ub_{std::move(ub)} {}
215 Bound lb_;
216 Bound ub_;
217 friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ShapeSpec &);
218 };
219
220 struct ArraySpec : public std::vector<ShapeSpec> {
ArraySpecArraySpec221 ArraySpec() {}
RankArraySpec222 int Rank() const { return size(); }
223 inline bool IsExplicitShape() const;
224 inline bool IsAssumedShape() const;
225 inline bool IsDeferredShape() const;
226 inline bool IsImpliedShape() const;
227 inline bool IsAssumedSize() const;
228 inline bool IsAssumedRank() const;
229
230 private:
231 // Check non-empty and predicate is true for each element.
CheckAllArraySpec232 template <typename P> bool CheckAll(P predicate) const {
233 return !empty() && std::all_of(begin(), end(), predicate);
234 }
235 };
236 llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ArraySpec &);
237
238 // Each DerivedTypeSpec has a typeSymbol that has DerivedTypeDetails.
239 // The name may not match the symbol's name in case of a USE rename.
240 class DerivedTypeSpec {
241 public:
242 using RawParameter = std::pair<const parser::Keyword *, ParamValue>;
243 using RawParameters = std::vector<RawParameter>;
244 using ParameterMapType = std::map<SourceName, ParamValue>;
245 DerivedTypeSpec(SourceName, const Symbol &);
246 DerivedTypeSpec(const DerivedTypeSpec &);
247 DerivedTypeSpec(DerivedTypeSpec &&);
248
name()249 const SourceName &name() const { return name_; }
typeSymbol()250 const Symbol &typeSymbol() const { return typeSymbol_; }
scope()251 const Scope *scope() const { return scope_; }
252 void set_scope(const Scope &);
253 void ReplaceScope(const Scope &);
rawParameters()254 RawParameters &rawParameters() { return rawParameters_; }
parameters()255 const ParameterMapType ¶meters() const { return parameters_; }
256
257 bool MightBeParameterized() const;
258 bool IsForwardReferenced() const;
259 bool HasDefaultInitialization() const;
260 bool HasDestruction() const;
261
262 // The "raw" type parameter list is a simple transcription from the
263 // parameter list in the parse tree, built by calling AddRawParamValue().
264 // It can be used with forward-referenced derived types.
265 void AddRawParamValue(const std::optional<parser::Keyword> &, ParamValue &&);
266 // Checks the raw parameter list against the definition of a derived type.
267 // Converts the raw parameter list to a map, naming each actual parameter.
268 void CookParameters(evaluate::FoldingContext &);
269 // Evaluates type parameter expressions.
270 void EvaluateParameters(SemanticsContext &);
271 void AddParamValue(SourceName, ParamValue &&);
272 // Creates a Scope for the type and populates it with component
273 // instantiations that have been specialized with actual type parameter
274 // values, which are cooked &/or evaluated if necessary.
275 void Instantiate(Scope &containingScope);
276
277 ParamValue *FindParameter(SourceName);
FindParameter(SourceName target)278 const ParamValue *FindParameter(SourceName target) const {
279 auto iter{parameters_.find(target)};
280 if (iter != parameters_.end()) {
281 return &iter->second;
282 } else {
283 return nullptr;
284 }
285 }
286 bool MightBeAssignmentCompatibleWith(const DerivedTypeSpec &) const;
287 bool operator==(const DerivedTypeSpec &that) const {
288 return RawEquals(that) && parameters_ == that.parameters_;
289 }
290 std::string AsFortran() const;
291
292 private:
293 SourceName name_;
294 const Symbol &typeSymbol_;
295 const Scope *scope_{nullptr}; // same as typeSymbol_.scope() unless PDT
296 bool cooked_{false};
297 bool evaluated_{false};
298 bool instantiated_{false};
299 RawParameters rawParameters_;
300 ParameterMapType parameters_;
RawEquals(const DerivedTypeSpec & that)301 bool RawEquals(const DerivedTypeSpec &that) const {
302 return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ &&
303 rawParameters_ == that.rawParameters_;
304 }
305 friend llvm::raw_ostream &operator<<(
306 llvm::raw_ostream &, const DerivedTypeSpec &);
307 };
308
309 class DeclTypeSpec {
310 public:
311 enum Category {
312 Numeric,
313 Logical,
314 Character,
315 TypeDerived,
316 ClassDerived,
317 TypeStar,
318 ClassStar
319 };
320
321 // intrinsic-type-spec or TYPE(intrinsic-type-spec), not character
322 DeclTypeSpec(NumericTypeSpec &&);
323 DeclTypeSpec(LogicalTypeSpec &&);
324 // character
325 DeclTypeSpec(const CharacterTypeSpec &);
326 DeclTypeSpec(CharacterTypeSpec &&);
327 // TYPE(derived-type-spec) or CLASS(derived-type-spec)
328 DeclTypeSpec(Category, const DerivedTypeSpec &);
329 DeclTypeSpec(Category, DerivedTypeSpec &&);
330 // TYPE(*) or CLASS(*)
331 DeclTypeSpec(Category);
332
333 bool operator==(const DeclTypeSpec &) const;
334 bool operator!=(const DeclTypeSpec &that) const { return !operator==(that); }
335
category()336 Category category() const { return category_; }
set_category(Category category)337 void set_category(Category category) { category_ = category; }
IsPolymorphic()338 bool IsPolymorphic() const {
339 return category_ == ClassDerived || IsUnlimitedPolymorphic();
340 }
IsUnlimitedPolymorphic()341 bool IsUnlimitedPolymorphic() const {
342 return category_ == TypeStar || category_ == ClassStar;
343 }
IsAssumedType()344 bool IsAssumedType() const { return category_ == TypeStar; }
345 bool IsNumeric(TypeCategory) const;
346 bool IsSequenceType() const;
347 const NumericTypeSpec &numericTypeSpec() const;
348 const LogicalTypeSpec &logicalTypeSpec() const;
characterTypeSpec()349 const CharacterTypeSpec &characterTypeSpec() const {
350 CHECK(category_ == Character);
351 return std::get<CharacterTypeSpec>(typeSpec_);
352 }
derivedTypeSpec()353 const DerivedTypeSpec &derivedTypeSpec() const {
354 CHECK(category_ == TypeDerived || category_ == ClassDerived);
355 return std::get<DerivedTypeSpec>(typeSpec_);
356 }
derivedTypeSpec()357 DerivedTypeSpec &derivedTypeSpec() {
358 CHECK(category_ == TypeDerived || category_ == ClassDerived);
359 return std::get<DerivedTypeSpec>(typeSpec_);
360 }
361
362 inline IntrinsicTypeSpec *AsIntrinsic();
363 inline const IntrinsicTypeSpec *AsIntrinsic() const;
364 inline DerivedTypeSpec *AsDerived();
365 inline const DerivedTypeSpec *AsDerived() const;
366
367 std::string AsFortran() const;
368
369 private:
370 Category category_;
371 std::variant<std::monostate, NumericTypeSpec, LogicalTypeSpec,
372 CharacterTypeSpec, DerivedTypeSpec>
373 typeSpec_;
374 };
375 llvm::raw_ostream &operator<<(llvm::raw_ostream &, const DeclTypeSpec &);
376
377 // This represents a proc-interface in the declaration of a procedure or
378 // procedure component. It comprises a symbol that represents the specific
379 // interface or a decl-type-spec that represents the function return type.
380 class ProcInterface {
381 public:
symbol()382 const Symbol *symbol() const { return symbol_; }
type()383 const DeclTypeSpec *type() const { return type_; }
384 void set_symbol(const Symbol &symbol);
385 void set_type(const DeclTypeSpec &type);
386
387 private:
388 const Symbol *symbol_{nullptr};
389 const DeclTypeSpec *type_{nullptr};
390 };
391
392 // Define some member functions here in the header so that they can be used by
393 // lib/Evaluate without link-time dependency on Semantics.
394
IsExplicitShape()395 inline bool ArraySpec::IsExplicitShape() const {
396 return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); });
397 }
IsAssumedShape()398 inline bool ArraySpec::IsAssumedShape() const {
399 return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); });
400 }
IsDeferredShape()401 inline bool ArraySpec::IsDeferredShape() const {
402 return CheckAll([](const ShapeSpec &x) {
403 return x.lbound().isDeferred() && x.ubound().isDeferred();
404 });
405 }
IsImpliedShape()406 inline bool ArraySpec::IsImpliedShape() const {
407 return !IsAssumedRank() &&
408 CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); });
409 }
IsAssumedSize()410 inline bool ArraySpec::IsAssumedSize() const {
411 return !empty() && !IsAssumedRank() && back().ubound().isAssumed() &&
412 std::all_of(begin(), end() - 1,
413 [](const ShapeSpec &x) { return x.ubound().isExplicit(); });
414 }
IsAssumedRank()415 inline bool ArraySpec::IsAssumedRank() const {
416 return Rank() == 1 && front().lbound().isAssumed();
417 }
418
AsIntrinsic()419 inline IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() {
420 switch (category_) {
421 case Numeric:
422 return &std::get<NumericTypeSpec>(typeSpec_);
423 case Logical:
424 return &std::get<LogicalTypeSpec>(typeSpec_);
425 case Character:
426 return &std::get<CharacterTypeSpec>(typeSpec_);
427 default:
428 return nullptr;
429 }
430 }
AsIntrinsic()431 inline const IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() const {
432 return const_cast<DeclTypeSpec *>(this)->AsIntrinsic();
433 }
434
AsDerived()435 inline DerivedTypeSpec *DeclTypeSpec::AsDerived() {
436 switch (category_) {
437 case TypeDerived:
438 case ClassDerived:
439 return &std::get<DerivedTypeSpec>(typeSpec_);
440 default:
441 return nullptr;
442 }
443 }
AsDerived()444 inline const DerivedTypeSpec *DeclTypeSpec::AsDerived() const {
445 return const_cast<DeclTypeSpec *>(this)->AsDerived();
446 }
447
448 } // namespace Fortran::semantics
449 #endif // FORTRAN_SEMANTICS_TYPE_H_
450