1 //===-- include/flang/Evaluate/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_EVALUATE_TYPE_H_
10 #define FORTRAN_EVALUATE_TYPE_H_
11 
12 // These definitions map Fortran's intrinsic types, characterized by byte
13 // sizes encoded in KIND type parameter values, to their value representation
14 // types in the evaluation library, which are parameterized in terms of
15 // total bit width and real precision.  Instances of the Type class template
16 // are suitable for use as template parameters to instantiate other class
17 // templates, like expressions, over the supported types and kinds.
18 
19 #include "common.h"
20 #include "complex.h"
21 #include "formatting.h"
22 #include "integer.h"
23 #include "logical.h"
24 #include "real.h"
25 #include "flang/Common/Fortran.h"
26 #include "flang/Common/idioms.h"
27 #include "flang/Common/real.h"
28 #include "flang/Common/template.h"
29 #include <cinttypes>
30 #include <optional>
31 #include <string>
32 #include <type_traits>
33 #include <variant>
34 
35 namespace Fortran::semantics {
36 class DeclTypeSpec;
37 class DerivedTypeSpec;
38 class ParamValue;
39 class Symbol;
40 bool IsDescriptor(const Symbol &);
41 } // namespace Fortran::semantics
42 
43 namespace Fortran::evaluate {
44 
45 using common::TypeCategory;
46 
47 // Specific intrinsic types are represented by specializations of
48 // this class template Type<CATEGORY, KIND>.
49 template <TypeCategory CATEGORY, int KIND = 0> class Type;
50 
51 using SubscriptInteger = Type<TypeCategory::Integer, 8>;
52 using CInteger = Type<TypeCategory::Integer, 4>;
53 using LogicalResult = Type<TypeCategory::Logical, 4>;
54 using LargestReal = Type<TypeCategory::Real, 16>;
55 
56 // A predicate that is true when a kind value is a kind that could possibly
57 // be supported for an intrinsic type category on some target instruction
58 // set architecture.
59 // TODO: specialize for the actual target architecture
IsValidKindOfIntrinsicType(TypeCategory category,std::int64_t kind)60 static constexpr bool IsValidKindOfIntrinsicType(
61     TypeCategory category, std::int64_t kind) {
62   switch (category) {
63   case TypeCategory::Integer:
64     return kind == 1 || kind == 2 || kind == 4 || kind == 8 || kind == 16;
65   case TypeCategory::Real:
66   case TypeCategory::Complex:
67     return kind == 2 || kind == 3 || kind == 4 || kind == 8 || kind == 10 ||
68         kind == 16;
69   case TypeCategory::Character:
70     return kind == 1 || kind == 2 || kind == 4;
71   case TypeCategory::Logical:
72     return kind == 1 || kind == 2 || kind == 4 || kind == 8;
73   default:
74     return false;
75   }
76 }
77 
78 // DynamicType is meant to be suitable for use as the result type for
79 // GetType() functions and member functions; consequently, it must be
80 // capable of being used in a constexpr context.  So it does *not*
81 // directly hold anything requiring a destructor, such as an arbitrary
82 // CHARACTER length type parameter expression.  Those must be derived
83 // via LEN() member functions, packaged elsewhere (e.g. as in
84 // ArrayConstructor), or copied from a parameter spec in the symbol table
85 // if one is supplied.
86 class DynamicType {
87 public:
DynamicType(TypeCategory cat,int k)88   constexpr DynamicType(TypeCategory cat, int k) : category_{cat}, kind_{k} {
89     CHECK(IsValidKindOfIntrinsicType(category_, kind_));
90   }
DynamicType(int k,const semantics::ParamValue & pv)91   constexpr DynamicType(int k, const semantics::ParamValue &pv)
92       : category_{TypeCategory::Character}, kind_{k}, charLength_{&pv} {
93     CHECK(IsValidKindOfIntrinsicType(category_, kind_));
94   }
95   explicit constexpr DynamicType(
96       const semantics::DerivedTypeSpec &dt, bool poly = false)
97       : category_{TypeCategory::Derived}, derived_{&dt} {
98     if (poly) {
99       kind_ = ClassKind;
100     }
101   }
CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(DynamicType)102   CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(DynamicType)
103 
104   // A rare use case used for representing the characteristics of an
105   // intrinsic function like REAL() that accepts a typeless BOZ literal
106   // argument and for typeless pointers -- things that real user Fortran can't
107   // do.
108   static constexpr DynamicType TypelessIntrinsicArgument() {
109     DynamicType result;
110     result.category_ = TypeCategory::Integer;
111     result.kind_ = TypelessKind;
112     return result;
113   }
114 
UnlimitedPolymorphic()115   static constexpr DynamicType UnlimitedPolymorphic() {
116     DynamicType result;
117     result.category_ = TypeCategory::Derived;
118     result.kind_ = ClassKind;
119     result.derived_ = nullptr;
120     return result; // CLASS(*)
121   }
122 
AssumedType()123   static constexpr DynamicType AssumedType() {
124     DynamicType result;
125     result.category_ = TypeCategory::Derived;
126     result.kind_ = AssumedTypeKind;
127     result.derived_ = nullptr;
128     return result; // TYPE(*)
129   }
130 
131   // Comparison is deep -- type parameters are compared independently.
132   bool operator==(const DynamicType &) const;
133   bool operator!=(const DynamicType &that) const { return !(*this == that); }
134 
category()135   constexpr TypeCategory category() const { return category_; }
kind()136   constexpr int kind() const {
137     CHECK(kind_ > 0);
138     return kind_;
139   }
charLength()140   constexpr const semantics::ParamValue *charLength() const {
141     return charLength_;
142   }
143   std::optional<Expr<SubscriptInteger>> GetCharLength() const;
144   std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
145       FoldingContext * = nullptr) const;
146 
147   std::string AsFortran() const;
148   std::string AsFortran(std::string &&charLenExpr) const;
149   DynamicType ResultTypeForMultiply(const DynamicType &) const;
150 
151   bool IsAssumedLengthCharacter() const;
152   bool IsNonConstantLengthCharacter() const;
153   bool IsTypelessIntrinsicArgument() const;
IsAssumedType()154   constexpr bool IsAssumedType() const { // TYPE(*)
155     return kind_ == AssumedTypeKind;
156   }
IsPolymorphic()157   constexpr bool IsPolymorphic() const { // TYPE(*) or CLASS()
158     return kind_ == ClassKind || IsAssumedType();
159   }
IsUnlimitedPolymorphic()160   constexpr bool IsUnlimitedPolymorphic() const { // TYPE(*) or CLASS(*)
161     return IsPolymorphic() && !derived_;
162   }
GetDerivedTypeSpec()163   constexpr const semantics::DerivedTypeSpec &GetDerivedTypeSpec() const {
164     return DEREF(derived_);
165   }
166 
167   bool RequiresDescriptor() const;
168   bool HasDeferredTypeParameter() const;
169 
170   // 7.3.2.3 & 15.5.2.4 type compatibility.
171   // x.IsTkCompatibleWith(y) is true if "x => y" or passing actual y to
172   // dummy argument x would be valid.  Be advised, this is not a reflexive
173   // relation.  Kind type parameters must match.
174   bool IsTkCompatibleWith(const DynamicType &) const;
175 
176   // Result will be missing when a symbol is absent or
177   // has an erroneous type, e.g., REAL(KIND=666).
178   static std::optional<DynamicType> From(const semantics::DeclTypeSpec &);
179   static std::optional<DynamicType> From(const semantics::Symbol &);
180 
From(const A & x)181   template <typename A> static std::optional<DynamicType> From(const A &x) {
182     return x.GetType();
183   }
From(const A * p)184   template <typename A> static std::optional<DynamicType> From(const A *p) {
185     if (!p) {
186       return std::nullopt;
187     } else {
188       return From(*p);
189     }
190   }
191   template <typename A>
From(const std::optional<A> & x)192   static std::optional<DynamicType> From(const std::optional<A> &x) {
193     if (x) {
194       return From(*x);
195     } else {
196       return std::nullopt;
197     }
198   }
199 
200 private:
201   // Special kind codes are used to distinguish the following Fortran types.
202   enum SpecialKind {
203     TypelessKind = -1, // BOZ actual argument to intrinsic function or pointer
204                        // argument to ASSOCIATED
205     ClassKind = -2, // CLASS(T) or CLASS(*)
206     AssumedTypeKind = -3, // TYPE(*)
207   };
208 
DynamicType()209   constexpr DynamicType() {}
210 
211   TypeCategory category_{TypeCategory::Derived}; // overridable default
212   int kind_{0};
213   const semantics::ParamValue *charLength_{nullptr};
214   const semantics::DerivedTypeSpec *derived_{nullptr}; // TYPE(T), CLASS(T)
215 };
216 
217 // Return the DerivedTypeSpec of a DynamicType if it has one.
218 const semantics::DerivedTypeSpec *GetDerivedTypeSpec(const DynamicType &);
219 const semantics::DerivedTypeSpec *GetDerivedTypeSpec(
220     const std::optional<DynamicType> &);
221 const semantics::DerivedTypeSpec *GetParentTypeSpec(
222     const semantics::DerivedTypeSpec &);
223 
224 std::string DerivedTypeSpecAsFortran(const semantics::DerivedTypeSpec &);
225 
226 template <TypeCategory CATEGORY, int KIND = 0> struct TypeBase {
227   static constexpr TypeCategory category{CATEGORY};
228   static constexpr int kind{KIND};
229   constexpr bool operator==(const TypeBase &) const { return true; }
GetTypeTypeBase230   static constexpr DynamicType GetType() { return {category, kind}; }
AsFortranTypeBase231   static std::string AsFortran() { return GetType().AsFortran(); }
232 };
233 
234 template <int KIND>
235 class Type<TypeCategory::Integer, KIND>
236     : public TypeBase<TypeCategory::Integer, KIND> {
237 public:
238   using Scalar = value::Integer<8 * KIND>;
239 };
240 
241 template <int KIND>
242 class Type<TypeCategory::Real, KIND>
243     : public TypeBase<TypeCategory::Real, KIND> {
244 public:
245   static constexpr int precision{common::PrecisionOfRealKind(KIND)};
246   static constexpr int bits{common::BitsForBinaryPrecision(precision)};
247   using Scalar = value::Real<value::Integer<bits>, precision>;
248 };
249 
250 // The KIND type parameter on COMPLEX is the kind of each of its components.
251 template <int KIND>
252 class Type<TypeCategory::Complex, KIND>
253     : public TypeBase<TypeCategory::Complex, KIND> {
254 public:
255   using Part = Type<TypeCategory::Real, KIND>;
256   using Scalar = value::Complex<typename Part::Scalar>;
257 };
258 
259 template <>
260 class Type<TypeCategory::Character, 1>
261     : public TypeBase<TypeCategory::Character, 1> {
262 public:
263   using Scalar = std::string;
264 };
265 
266 template <>
267 class Type<TypeCategory::Character, 2>
268     : public TypeBase<TypeCategory::Character, 2> {
269 public:
270   using Scalar = std::u16string;
271 };
272 
273 template <>
274 class Type<TypeCategory::Character, 4>
275     : public TypeBase<TypeCategory::Character, 4> {
276 public:
277   using Scalar = std::u32string;
278 };
279 
280 template <int KIND>
281 class Type<TypeCategory::Logical, KIND>
282     : public TypeBase<TypeCategory::Logical, KIND> {
283 public:
284   using Scalar = value::Logical<8 * KIND>;
285 };
286 
287 // Type functions
288 
289 // Given a specific type, find the type of the same kind in another category.
290 template <TypeCategory CATEGORY, typename T>
291 using SameKind = Type<CATEGORY, std::decay_t<T>::kind>;
292 
293 // Many expressions, including subscripts, CHARACTER lengths, array bounds,
294 // and effective type parameter values, are of a maximal kind of INTEGER.
295 using IndirectSubscriptIntegerExpr =
296     common::CopyableIndirection<Expr<SubscriptInteger>>;
297 
298 // For each intrinsic type category CAT, CategoryTypes<CAT> is an instantiation
299 // of std::tuple<Type<CAT, K>> that comprises every kind value K in that
300 // category that could possibly be supported on any target.
301 template <TypeCategory CATEGORY, int KIND>
302 using CategoryKindTuple =
303     std::conditional_t<IsValidKindOfIntrinsicType(CATEGORY, KIND),
304         std::tuple<Type<CATEGORY, KIND>>, std::tuple<>>;
305 
306 template <TypeCategory CATEGORY, int... KINDS>
307 using CategoryTypesHelper =
308     common::CombineTuples<CategoryKindTuple<CATEGORY, KINDS>...>;
309 
310 template <TypeCategory CATEGORY>
311 using CategoryTypes = CategoryTypesHelper<CATEGORY, 1, 2, 3, 4, 8, 10, 16, 32>;
312 
313 using IntegerTypes = CategoryTypes<TypeCategory::Integer>;
314 using RealTypes = CategoryTypes<TypeCategory::Real>;
315 using ComplexTypes = CategoryTypes<TypeCategory::Complex>;
316 using CharacterTypes = CategoryTypes<TypeCategory::Character>;
317 using LogicalTypes = CategoryTypes<TypeCategory::Logical>;
318 
319 using FloatingTypes = common::CombineTuples<RealTypes, ComplexTypes>;
320 using NumericTypes = common::CombineTuples<IntegerTypes, FloatingTypes>;
321 using RelationalTypes = common::CombineTuples<NumericTypes, CharacterTypes>;
322 using AllIntrinsicTypes = common::CombineTuples<RelationalTypes, LogicalTypes>;
323 using LengthlessIntrinsicTypes =
324     common::CombineTuples<NumericTypes, LogicalTypes>;
325 
326 // Predicates: does a type represent a specific intrinsic type?
327 template <typename T>
328 constexpr bool IsSpecificIntrinsicType{common::HasMember<T, AllIntrinsicTypes>};
329 
330 // Predicate: is a type an intrinsic type that is completely characterized
331 // by its category and kind parameter value, or might it have a derived type
332 // &/or a length type parameter?
333 template <typename T>
334 constexpr bool IsLengthlessIntrinsicType{
335     common::HasMember<T, LengthlessIntrinsicTypes>};
336 
337 // Represents a type of any supported kind within a particular category.
338 template <TypeCategory CATEGORY> struct SomeKind {
339   static constexpr TypeCategory category{CATEGORY};
340   constexpr bool operator==(const SomeKind &) const { return true; }
341 };
342 
343 using NumericCategoryTypes = std::tuple<SomeKind<TypeCategory::Integer>,
344     SomeKind<TypeCategory::Real>, SomeKind<TypeCategory::Complex>>;
345 using AllIntrinsicCategoryTypes = std::tuple<SomeKind<TypeCategory::Integer>,
346     SomeKind<TypeCategory::Real>, SomeKind<TypeCategory::Complex>,
347     SomeKind<TypeCategory::Character>, SomeKind<TypeCategory::Logical>>;
348 
349 // Represents a completely generic type (or, for Expr<SomeType>, a typeless
350 // value like a BOZ literal or NULL() pointer).
351 struct SomeType {};
352 
353 class StructureConstructor;
354 
355 // Represents any derived type, polymorphic or not, as well as CLASS(*).
356 template <> class SomeKind<TypeCategory::Derived> {
357 public:
358   static constexpr TypeCategory category{TypeCategory::Derived};
359   using Scalar = StructureConstructor;
360 
SomeKind()361   constexpr SomeKind() {} // CLASS(*)
SomeKind(const semantics::DerivedTypeSpec & dts)362   constexpr explicit SomeKind(const semantics::DerivedTypeSpec &dts)
363       : derivedTypeSpec_{&dts} {}
SomeKind(const DynamicType & dt)364   constexpr explicit SomeKind(const DynamicType &dt)
365       : SomeKind(dt.GetDerivedTypeSpec()) {}
CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(SomeKind)366   CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(SomeKind)
367 
368   bool IsUnlimitedPolymorphic() const { return !derivedTypeSpec_; }
GetType()369   constexpr DynamicType GetType() const {
370     if (!derivedTypeSpec_) {
371       return DynamicType::UnlimitedPolymorphic();
372     } else {
373       return DynamicType{*derivedTypeSpec_};
374     }
375   }
derivedTypeSpec()376   const semantics::DerivedTypeSpec &derivedTypeSpec() const {
377     CHECK(derivedTypeSpec_);
378     return *derivedTypeSpec_;
379   }
380   bool operator==(const SomeKind &) const;
381   std::string AsFortran() const;
382 
383 private:
384   const semantics::DerivedTypeSpec *derivedTypeSpec_{nullptr};
385 };
386 
387 using SomeInteger = SomeKind<TypeCategory::Integer>;
388 using SomeReal = SomeKind<TypeCategory::Real>;
389 using SomeComplex = SomeKind<TypeCategory::Complex>;
390 using SomeCharacter = SomeKind<TypeCategory::Character>;
391 using SomeLogical = SomeKind<TypeCategory::Logical>;
392 using SomeDerived = SomeKind<TypeCategory::Derived>;
393 using SomeCategory = std::tuple<SomeInteger, SomeReal, SomeComplex,
394     SomeCharacter, SomeLogical, SomeDerived>;
395 
396 using AllTypes =
397     common::CombineTuples<AllIntrinsicTypes, std::tuple<SomeDerived>>;
398 
399 template <typename T> using Scalar = typename std::decay_t<T>::Scalar;
400 
401 // When Scalar<T> is S, then TypeOf<S> is T.
402 // TypeOf is implemented by scanning all supported types for a match
403 // with Type<T>::Scalar.
404 template <typename CONST> struct TypeOfHelper {
405   template <typename T> struct Predicate {
valueTypeOfHelper::Predicate406     static constexpr bool value() {
407       return std::is_same_v<std::decay_t<CONST>,
408           std::decay_t<typename T::Scalar>>;
409     }
410   };
411   static constexpr int index{
412       common::SearchMembers<Predicate, AllIntrinsicTypes>};
413   using type = std::conditional_t<index >= 0,
414       std::tuple_element_t<index, AllIntrinsicTypes>, void>;
415 };
416 
417 template <typename CONST> using TypeOf = typename TypeOfHelper<CONST>::type;
418 
419 int SelectedCharKind(const std::string &, int defaultKind);
420 int SelectedIntKind(std::int64_t precision = 0);
421 int SelectedRealKind(
422     std::int64_t precision = 0, std::int64_t range = 0, std::int64_t radix = 2);
423 
424 // For generating "[extern] template class", &c. boilerplate
425 #define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \
426   M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8) M(P, S, 16)
427 #define EXPAND_FOR_EACH_REAL_KIND(M, P, S) \
428   M(P, S, 2) M(P, S, 3) M(P, S, 4) M(P, S, 8) M(P, S, 10) M(P, S, 16)
429 #define EXPAND_FOR_EACH_COMPLEX_KIND(M, P, S) EXPAND_FOR_EACH_REAL_KIND(M, P, S)
430 #define EXPAND_FOR_EACH_CHARACTER_KIND(M, P, S) M(P, S, 1) M(P, S, 2) M(P, S, 4)
431 #define EXPAND_FOR_EACH_LOGICAL_KIND(M, P, S) \
432   M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8)
433 #define TEMPLATE_INSTANTIATION(P, S, ARG) P<ARG> S;
434 
435 #define FOR_EACH_INTEGER_KIND_HELP(PREFIX, SUFFIX, K) \
436   PREFIX<Type<TypeCategory::Integer, K>> SUFFIX;
437 #define FOR_EACH_REAL_KIND_HELP(PREFIX, SUFFIX, K) \
438   PREFIX<Type<TypeCategory::Real, K>> SUFFIX;
439 #define FOR_EACH_COMPLEX_KIND_HELP(PREFIX, SUFFIX, K) \
440   PREFIX<Type<TypeCategory::Complex, K>> SUFFIX;
441 #define FOR_EACH_CHARACTER_KIND_HELP(PREFIX, SUFFIX, K) \
442   PREFIX<Type<TypeCategory::Character, K>> SUFFIX;
443 #define FOR_EACH_LOGICAL_KIND_HELP(PREFIX, SUFFIX, K) \
444   PREFIX<Type<TypeCategory::Logical, K>> SUFFIX;
445 
446 #define FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
447   EXPAND_FOR_EACH_INTEGER_KIND(FOR_EACH_INTEGER_KIND_HELP, PREFIX, SUFFIX)
448 #define FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \
449   EXPAND_FOR_EACH_REAL_KIND(FOR_EACH_REAL_KIND_HELP, PREFIX, SUFFIX)
450 #define FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \
451   EXPAND_FOR_EACH_COMPLEX_KIND(FOR_EACH_COMPLEX_KIND_HELP, PREFIX, SUFFIX)
452 #define FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX) \
453   EXPAND_FOR_EACH_CHARACTER_KIND(FOR_EACH_CHARACTER_KIND_HELP, PREFIX, SUFFIX)
454 #define FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \
455   EXPAND_FOR_EACH_LOGICAL_KIND(FOR_EACH_LOGICAL_KIND_HELP, PREFIX, SUFFIX)
456 
457 #define FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
458   FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
459   FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \
460   FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \
461   FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX)
462 #define FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
463   FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
464   FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX)
465 #define FOR_EACH_SPECIFIC_TYPE(PREFIX, SUFFIX) \
466   FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
467   PREFIX<SomeDerived> SUFFIX;
468 
469 #define FOR_EACH_CATEGORY_TYPE(PREFIX, SUFFIX) \
470   PREFIX<SomeInteger> SUFFIX; \
471   PREFIX<SomeReal> SUFFIX; \
472   PREFIX<SomeComplex> SUFFIX; \
473   PREFIX<SomeCharacter> SUFFIX; \
474   PREFIX<SomeLogical> SUFFIX; \
475   PREFIX<SomeDerived> SUFFIX; \
476   PREFIX<SomeType> SUFFIX;
477 #define FOR_EACH_TYPE_AND_KIND(PREFIX, SUFFIX) \
478   FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
479   FOR_EACH_CATEGORY_TYPE(PREFIX, SUFFIX)
480 } // namespace Fortran::evaluate
481 #endif // FORTRAN_EVALUATE_TYPE_H_
482