FLANG

common.h
1 //===-- include/flang/Evaluate/common.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_COMMON_H_
10 #define FORTRAN_EVALUATE_COMMON_H_
11
12 #include "intrinsics-library.h"
13 #include "flang/Common/Fortran.h"
14 #include "flang/Common/default-kinds.h"
15 #include "flang/Common/enum-set.h"
16 #include "flang/Common/idioms.h"
17 #include "flang/Common/indirection.h"
18 #include "flang/Common/restorer.h"
19 #include "flang/Parser/char-block.h"
20 #include "flang/Parser/message.h"
21 #include <cinttypes>
22 #include <map>
23
24 namespace Fortran::semantics {
25 class DerivedTypeSpec;
26 }
27
28 namespace Fortran::evaluate {
29 class IntrinsicProcTable;
30
31 using common::ConstantSubscript;
32 using common::RelationalOperator;
33
34 // Integers are always ordered; reals may not be.
35 ENUM_CLASS(Ordering, Less, Equal, Greater)
36 ENUM_CLASS(Relation, Less, Equal, Greater, Unordered)
37
38 template <typename A>
39 static constexpr Ordering Compare(const A &x, const A &y) {
40 if (x < y) {
41 return Ordering::Less;
42 } else if (x > y) {
43 return Ordering::Greater;
44 } else {
45 return Ordering::Equal;
46 }
47 }
48
49 static constexpr Ordering Reverse(Ordering ordering) {
50 if (ordering == Ordering::Less) {
51 return Ordering::Greater;
52 } else if (ordering == Ordering::Greater) {
53 return Ordering::Less;
54 } else {
55 return Ordering::Equal;
56 }
57 }
58
59 static constexpr Relation RelationFromOrdering(Ordering ordering) {
60 if (ordering == Ordering::Less) {
61 return Relation::Less;
62 } else if (ordering == Ordering::Greater) {
63 return Relation::Greater;
64 } else {
65 return Relation::Equal;
66 }
67 }
68
69 static constexpr Relation Reverse(Relation relation) {
70 if (relation == Relation::Less) {
71 return Relation::Greater;
72 } else if (relation == Relation::Greater) {
73 return Relation::Less;
74 } else {
75 return relation;
76 }
77 }
78
79 static constexpr bool Satisfies(RelationalOperator op, Ordering order) {
80 switch (order) {
81 case Ordering::Less:
82 return op == RelationalOperator::LT || op == RelationalOperator::LE ||
83 op == RelationalOperator::NE;
84 case Ordering::Equal:
85 return op == RelationalOperator::LE || op == RelationalOperator::EQ ||
86 op == RelationalOperator::GE;
87 case Ordering::Greater:
88 return op == RelationalOperator::NE || op == RelationalOperator::GE ||
89 op == RelationalOperator::GT;
90 }
91 return false; // silence g++ warning
92 }
93
94 static constexpr bool Satisfies(RelationalOperator op, Relation relation) {
95 switch (relation) {
96 case Relation::Less:
97 return Satisfies(op, Ordering::Less);
98 case Relation::Equal:
99 return Satisfies(op, Ordering::Equal);
100 case Relation::Greater:
101 return Satisfies(op, Ordering::Greater);
102 case Relation::Unordered:
103 return false;
104 }
105 return false; // silence g++ warning
106 }
107
108 ENUM_CLASS(
109 RealFlag, Overflow, DivideByZero, InvalidArgument, Underflow, Inexact)
110
111 using RealFlags = common::EnumSet<RealFlag, RealFlag_enumSize>;
112
113 template <typename A> struct ValueWithRealFlags {
114 A AccumulateFlags(RealFlags &f) {
115 f |= flags;
116 return value;
117 }
118 A value;
119 RealFlags flags{};
120 };
121
122 struct Rounding {
123 common::RoundingMode mode{common::RoundingMode::TiesToEven};
124 // When set, emulate status flag behavior peculiar to x86
125 // (viz., fail to set the Underflow flag when an inexact product of a
126 // multiplication is rounded up to a normal number from a subnormal
127 // in some rounding modes)
128 #if __x86_64__
129 bool x86CompatibleBehavior{true};
130 #else
131 bool x86CompatibleBehavior{false};
132 #endif
133 };
134
135 static constexpr Rounding defaultRounding;
136
137 #if __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
138 constexpr bool isHostLittleEndian{false};
139 #elif __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
140 constexpr bool isHostLittleEndian{true};
141 #else
142 #error host endianness is not known
143 #endif
144
145 // HostUnsignedInt<BITS> finds the smallest native unsigned integer type
146 // whose size is >= BITS.
147 template <bool LE8, bool LE16, bool LE32, bool LE64> struct SmallestUInt {};
148 template <> struct SmallestUInt<true, true, true, true> {
149 using type = std::uint8_t;
150 };
151 template <> struct SmallestUInt<false, true, true, true> {
152 using type = std::uint16_t;
153 };
154 template <> struct SmallestUInt<false, false, true, true> {
155 using type = std::uint32_t;
156 };
157 template <> struct SmallestUInt<false, false, false, true> {
158 using type = std::uint64_t;
159 };
160 template <int BITS>
161 using HostUnsignedInt =
162 typename SmallestUInt<BITS <= 8, BITS <= 16, BITS <= 32, BITS <= 64>::type;
163
164 // Many classes in this library follow a common paradigm.
165 // - There is no default constructor (Class() {}), usually to prevent the
166 // need for std::monostate as a default constituent in a std::variant<>.
167 // - There are full copy and move semantics for construction and assignment.
168 // - Discriminated unions have a std::variant<> member "u" and support
169 // explicit copy and move constructors as well as comparison for equality.
170 #define DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
171 t(const t &); \
172 t(t &&); \
173 t &operator=(const t &); \
174 t &operator=(t &&);
175 #define DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
176 t(const t &) = default; \
177 t(t &&) = default; \
178 t &operator=(const t &) = default; \
179 t &operator=(t &&) = default;
180 #define DEFINE_DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
181 t::t(const t &) = default; \
182 t::t(t &&) = default; \
183 t &t::operator=(const t &) = default; \
184 t &t::operator=(t &&) = default;
185 #define CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(t) \
186 constexpr t(const t &) = default; \
187 constexpr t(t &&) = default; \
188 constexpr t &operator=(const t &) = default; \
189 constexpr t &operator=(t &&) = default;
190
191 #define CLASS_BOILERPLATE(t) \
192 t() = delete; \
193 DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(t)
194
195 #define UNION_CONSTRUCTORS(t) \
196 template <typename _A> explicit t(const _A &x) : u{x} {} \
197 template <typename _A, typename = common::NoLvalue<_A>> \
198 explicit t(_A &&x) : u(std::move(x)) {}
199
200 #define EVALUATE_UNION_CLASS_BOILERPLATE(t) \
201 CLASS_BOILERPLATE(t) \
202 UNION_CONSTRUCTORS(t) \
203 bool operator==(const t &) const;
204
205 // Forward definition of Expr<> so that it can be indirectly used in its own
206 // definition
207 template <typename A> class Expr;
208
209 class FoldingContext {
210 public:
211 FoldingContext(
212 const common::IntrinsicTypeDefaultKinds &d, const IntrinsicProcTable &t)
213 : defaults_{d}, intrinsics_{t} {}
214 FoldingContext(const parser::ContextualMessages &m,
215 const common::IntrinsicTypeDefaultKinds &d, const IntrinsicProcTable &t,
216 Rounding round = defaultRounding, bool flush = false)
217 : messages_{m}, defaults_{d}, intrinsics_{t}, rounding_{round},
218 flushSubnormalsToZero_{flush} {}
219 FoldingContext(const FoldingContext &that)
220 : messages_{that.messages_}, defaults_{that.defaults_},
221 intrinsics_{that.intrinsics_}, rounding_{that.rounding_},
222 flushSubnormalsToZero_{that.flushSubnormalsToZero_},
223 pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_} {}
224 FoldingContext(
225 const FoldingContext &that, const parser::ContextualMessages &m)
226 : messages_{m}, defaults_{that.defaults_},
227 intrinsics_{that.intrinsics_}, rounding_{that.rounding_},
228 flushSubnormalsToZero_{that.flushSubnormalsToZero_},
229 pdtInstance_{that.pdtInstance_}, impliedDos_{that.impliedDos_} {}
230
231 parser::ContextualMessages &messages() { return messages_; }
232 const parser::ContextualMessages &messages() const { return messages_; }
233 const common::IntrinsicTypeDefaultKinds &defaults() const {
234 return defaults_;
235 }
236 Rounding rounding() const { return rounding_; }
237 bool flushSubnormalsToZero() const { return flushSubnormalsToZero_; }
238 bool bigEndian() const { return bigEndian_; }
239 const semantics::DerivedTypeSpec *pdtInstance() const { return pdtInstance_; }
240 const HostIntrinsicProceduresLibrary &hostIntrinsicsLibrary() const {
241 return hostIntrinsicsLibrary_;
242 }
243 const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }
244
245 ConstantSubscript &StartImpliedDo(parser::CharBlock, ConstantSubscript = 1);
246 std::optional<ConstantSubscript> GetImpliedDo(parser::CharBlock) const;
247 void EndImpliedDo(parser::CharBlock);
248
249 std::map<parser::CharBlock, ConstantSubscript> &impliedDos() {
250 return impliedDos_;
251 }
252
253 common::Restorer<const semantics::DerivedTypeSpec *> WithPDTInstance(
254 const semantics::DerivedTypeSpec &spec) {
255 return common::ScopedSet(pdtInstance_, &spec);
256 }
257
258 private:
259 parser::ContextualMessages messages_;
260 const common::IntrinsicTypeDefaultKinds &defaults_;
261 const IntrinsicProcTable &intrinsics_;
262 Rounding rounding_{defaultRounding};
263 bool flushSubnormalsToZero_{false};
264 bool bigEndian_{false};
265 const semantics::DerivedTypeSpec *pdtInstance_{nullptr};
266 std::map<parser::CharBlock, ConstantSubscript> impliedDos_;
267 HostIntrinsicProceduresLibrary hostIntrinsicsLibrary_;
268 };
269
270 void RealFlagWarnings(FoldingContext &, const RealFlags &, const char *op);
271 } // namespace Fortran::evaluate
272 #endif // FORTRAN_EVALUATE_COMMON_H_
Fortran::parser::ContextualMessages
Definition: message.h:271
Fortran::evaluate::Rounding
Definition: common.h:122
Fortran::common::Restorer
Definition: restorer.h:23
Fortran::evaluate::HostIntrinsicProceduresLibrary
Definition: intrinsics-library.h:89
Fortran::evaluate::SmallestUInt
Definition: common.h:147
Fortran::semantics::DerivedTypeSpec
Definition: type.h:237
Fortran::common::IntrinsicTypeDefaultKinds
Definition: default-kinds.h:26
Fortran::evaluate::FoldingContext
Definition: common.h:209
Fortran::parser::CharBlock
Definition: char-block.h:28
Fortran::evaluate::ValueWithRealFlags
Definition: common.h:113
Fortran::evaluate::Expr
Definition: common.h:207