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