# limitations under the License.
add_library(FortranEvaluate
- constant.cc
- integer.cc
- real.cc
+ instances.cc
)
\ No newline at end of file
+++ /dev/null
-// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-
-#include "constant.h"
-#include <cinttypes>
-#include <limits>
-
-namespace Fortran::evaluate {
-
-template<IntrinsicType::KindLenCType KIND>
-ScalarIntegerConstant<KIND> ScalarIntegerConstant<KIND>::Negate() const {
- ScalarIntegerConstant<KIND> result{*this};
- return result.Assign(-static_cast<BigIntType>(value_));
-}
-
-template<IntrinsicType::KindLenCType KIND>
-ScalarIntegerConstant<KIND> ScalarIntegerConstant<KIND>::Add(
- const ScalarIntegerConstant<KIND> &that) const {
- ScalarIntegerConstant<KIND> result{*this};
- return result.Assign(
- static_cast<BigIntType>(value_) + static_cast<BigIntType>(that.value_));
-}
-
-template<IntrinsicType::KindLenCType KIND>
-ScalarIntegerConstant<KIND> ScalarIntegerConstant<KIND>::Subtract(
- const ScalarIntegerConstant<KIND> &that) const {
- ScalarIntegerConstant<KIND> result{*this};
- return result.Assign(
- static_cast<BigIntType>(value_) - static_cast<BigIntType>(that.value_));
-}
-
-template<IntrinsicType::KindLenCType KIND>
-ScalarIntegerConstant<KIND> ScalarIntegerConstant<KIND>::Multiply(
- const ScalarIntegerConstant<KIND> &that) const {
- ScalarIntegerConstant<KIND> result{*this};
- return result.Assign(
- static_cast<BigIntType>(value_) - static_cast<BigIntType>(that.value_));
-}
-
-template<IntrinsicType::KindLenCType KIND>
-ScalarIntegerConstant<KIND> ScalarIntegerConstant<KIND>::Divide(
- const ScalarIntegerConstant<KIND> &that) const {
- ScalarIntegerConstant<KIND> result{*this};
- if (that.value_ == 0) {
- result.SetError(Error::DivisionByZero);
- return result;
- } else {
- return result.Assign(
- static_cast<BigIntType>(value_) / static_cast<BigIntType>(that.value_));
- }
-}
-
-template class ScalarConstant<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, 1>;
-
-} // namespace Fortran::evaluate
+++ /dev/null
-// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-
-#ifndef FORTRAN_EVALUATE_CONSTANT_H_
-#define FORTRAN_EVALUATE_CONSTANT_H_
-
-#include "type.h"
-#include "../parser/idioms.h"
-#include <cinttypes>
-#include <cstddef>
-#include <limits>
-#include <type_traits>
-#include <vector>
-
-namespace Fortran::evaluate {
-
-enum class Error { None, Overflow, DivisionByZero, InvalidOperation };
-enum class Relation { LessThan, Equal, GreaterThan, Unordered };
-
-template<typename IntrinsicTypeClassification,
- IntrinsicTypeClassification CLASSIFICATION,
- IntrinsicType::KindLenCType KIND>
-class ScalarConstant;
-
-template<typename IntrinsicTypeClassification,
- IntrinsicTypeClassification CLASSIFICATION,
- IntrinsicType::KindLenCType KIND>
-class ScalarConstantBase {
-public:
- constexpr ScalarConstantBase() {}
- constexpr IntrinsicType Type() const { return {CLASSIFICATION, KIND}; }
- constexpr Error error() const { return error_; }
- constexpr bool AnyError() const { return error_ != Error::None; }
-
-protected:
- constexpr void SetError(Error error) {
- if (error_ == Error::None) {
- error_ = error;
- }
- }
-
-private:
- Error error_{Error::None};
-};
-
-// Integer scalar constants
-template<IntrinsicType::KindLenCType KIND>
-class ScalarConstant<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, KIND>
- : public ScalarConstantBase<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, KIND> {
-private:
- static_assert(KIND == 1 || KIND == 2 || KIND == 4 || KIND == 8);
- using BaseType = ScalarConstantBase<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, KIND>;
-
-public:
- using ValueCType = std::int64_t;
-
- constexpr ScalarConstant() {}
- constexpr ScalarConstant(ValueCType x) { Assign(x); }
- constexpr ScalarConstant(std::uint64_t x) {
- value_ = x;
- if (value_ < 0) {
- BaseType::SetError(Error::Overflow);
- } else {
- CheckForOverflow();
- }
- }
- constexpr ScalarConstant(const ScalarConstant &that) = default;
- constexpr ScalarConstant &operator=(const ScalarConstant &) = default;
-
- constexpr ValueCType value() const { return value_; }
-
- constexpr void Assign(ValueCType x) {
- value_ = x;
- CheckForOverflow();
- }
- ScalarConstant Negate() const;
- ScalarConstant Add(const ScalarConstant &) const;
- ScalarConstant Subtract(const ScalarConstant &) const;
- ScalarConstant Multiply(const ScalarConstant &) const;
- ScalarConstant Divide(const ScalarConstant &) const;
-
-private:
- using BigIntType = __int128_t;
- constexpr ScalarConstant &Assign(BigIntType x) {
- value_ = x;
- if (value_ != x) {
- BaseType::SetError(Error::Overflow);
- } else {
- CheckForOverflow();
- }
- return *this;
- }
-
- constexpr void CheckForOverflow() {
- if (KIND < 8 && !BaseType::AnyError()) {
- ValueCType limit{static_cast<ValueCType>(1) << (8 * KIND)};
- if (value_ >= limit) {
- BaseType::SetError(Error::Overflow);
- value_ &= limit - 1;
- } else if (value_ < -limit) {
- BaseType::SetError(Error::Overflow);
- value_ &= limit + limit - 1;
- if (value_ >= limit) {
- value_ |= -limit;
- }
- }
- }
- }
-
- ValueCType value_{0};
-};
-
-template<IntrinsicType::KindLenCType KIND>
-using ScalarIntegerConstant = ScalarConstant<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, KIND>;
-
-extern template class ScalarConstant<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, 1>;
-extern template class ScalarConstant<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, 2>;
-extern template class ScalarConstant<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, 4>;
-extern template class ScalarConstant<IntrinsicType::Classification,
- IntrinsicType::Classification::Integer, 8>;
-
-} // namespace Fortran::evaluate
-#endif // FORTRAN_EVALUATE_CONSTANT_H_
// limitations under the License.
#include "integer.h"
+#include "logical.h"
+#include "real.h"
-namespace Fortran::evaluate {
+namespace Fortran::evaluate::value {
template class Integer<8>;
template class Integer<16>;
template class Integer<64>;
template class Integer<128>;
-// Sanity checks intended to catch misconfiguration bugs
+template class Real<Integer<16>, 11>;
+template class Real<Integer<32>, 24>;
+template class Real<Integer<64>, 53>;
+template class Real<Integer<80>, 64, false>;
+template class Real<Integer<128>, 112>;
+
+template class Logical<8>;
+template class Logical<16>;
+template class Logical<32>;
+template class Logical<64>;
+template class Logical<128>;
+
+// Sanity checks against misconfiguration bugs
static_assert(Integer<8>::partBits == 8);
static_assert(std::is_same_v<typename Integer<8>::Part, std::uint8_t>);
static_assert(Integer<16>::partBits == 16);
static_assert(Integer<128>::partBits == 32);
static_assert(std::is_same_v<typename Integer<128>::Part, std::uint32_t>);
-} // namespace Fortran::evaluate
+} // namespace Fortran::evaluate::value
#include "bit-population-count.h"
#include "common.h"
#include "leading-zero-bit-count.h"
-#include "type.h"
#include <cinttypes>
#include <climits>
#include <cstddef>
#include <type_traits>
-namespace Fortran::evaluate {
+namespace Fortran::evaluate::value {
// Implements an integer as an assembly of smaller host integer parts
// that constitute the digits of a large-radix fixed-point number.
SetLEPart(parts - 1, n);
}
+ constexpr Integer &operator=(const Integer &) = default;
+
+ // Left-justified mask (e.g., MASKL(1) has only its sign bit set)
+ static constexpr Integer MASKL(int places) {
+ if (places <= 0) {
+ return {};
+ } else if (places >= bits) {
+ return MASKR(bits);
+ } else {
+ return MASKR(bits - places).NOT();
+ }
+ }
+
// Right-justified mask (e.g., MASKR(1) == 1, MASKR(2) == 3, &c.)
static constexpr Integer MASKR(int places) {
Integer result{nullptr};
return result;
}
- // Left-justified mask (e.g., MASKL(1) has only its sign bit set)
- static constexpr Integer MASKL(int places) {
- if (places <= 0) {
- return {};
- } else if (places >= bits) {
- return MASKR(bits);
- } else {
- return MASKR(bits - places).NOT();
- }
- }
-
static constexpr ValueWithOverflow ReadUnsigned(
const char *&pp, std::uint64_t base = 10) {
Integer result;
return {result, overflow};
}
- constexpr Integer &operator=(const Integer &) = default;
-
template<typename FROM>
- static constexpr ValueWithOverflow Convert(const FROM &that) {
+ static constexpr ValueWithOverflow ConvertUnsigned(const FROM &that) {
std::uint64_t field{that.ToUInt64()};
ValueWithOverflow result{field, false};
if constexpr (bits < 64) {
extern template class Integer<32>;
extern template class Integer<64>;
extern template class Integer<128>;
-
-template<int KIND> using IntrinsicInteger = Integer<KIND * CHAR_BIT>;
-using DefaultIntrinsicInteger =
- IntrinsicInteger<IntrinsicType::defaultIntegerKind>;
-
-} // namespace Fortran::evaluate
+} // namespace Fortran::evaluate::value
#endif // FORTRAN_EVALUATE_INTEGER_H_
--- /dev/null
+// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_EVALUATE_LOGICAL_H_
+#define FORTRAN_EVALUATE_LOGICAL_H_
+
+#include "integer.h"
+#include <cinttypes>
+
+namespace Fortran::evaluate::value {
+
+template<int BITS> class Logical {
+public:
+ static constexpr int bits{BITS};
+ constexpr Logical() {} // .FALSE.
+ constexpr Logical(bool truth) : word_{-std::uint64_t{truth}} {}
+
+ // For static expression evaluation, all the bits will have the same value.
+ constexpr bool IsTrue() const { return word_.BTEST(0); }
+
+ constexpr Logical NOT() const {
+ return {word_.NOT()};
+ }
+
+ constexpr Logical AND(const Logical &that) const {
+ return {word_.IAND(that.word_)};
+ }
+
+ constexpr Logical OR(const Logical &that) const {
+ return {word_.IOR(that.word_)};
+ }
+
+ constexpr Logical EQV(const Logical &that) const {
+ return NEQV(that).NOT();
+ }
+
+ constexpr Logical NEQV(const Logical &that) const {
+ return {word_.IEOR(that.word_)};
+ }
+
+private:
+ using Word = Integer<bits>;
+ constexpr Logical(const Word &w) : word_{w} {}
+ Word word_;
+};
+
+extern template class Logical<8>;
+extern template class Logical<16>;
+extern template class Logical<32>;
+extern template class Logical<64>;
+extern template class Logical<128>;
+} // namespace Fortran::evaluate::value
+#endif // FORTRAN_EVALUATE_LOGICAL_H_
+++ /dev/null
-// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
-//
-// Licensed under the Apache License, Version 2.0 (the "License");
-// you may not use this file except in compliance with the License.
-// You may obtain a copy of the License at
-//
-// http://www.apache.org/licenses/LICENSE-2.0
-//
-// Unless required by applicable law or agreed to in writing, software
-// distributed under the License is distributed on an "AS IS" BASIS,
-// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-// See the License for the specific language governing permissions and
-// limitations under the License.
-
-#include "real.h"
-
-namespace Fortran::evaluate {
-
-template class Real<Integer<16>, 11>;
-template class Real<Integer<32>, 24>;
-template class Real<Integer<64>, 53>;
-template class Real<Integer<80>, 64, false>;
-template class Real<Integer<128>, 112>;
-
-} // namespace Fortran::evaluate
#include <cinttypes>
#include <limits>
-namespace Fortran::evaluate {
+namespace Fortran::evaluate::value {
// Models IEEE-754 floating-point numbers. The first argument to this
// class template must be (or look like) an instance of Integer.
int bitsNeeded{absN.bits - (leadz + implicitMSB)};
int bitsLost{bitsNeeded - significandBits};
if (bitsLost <= 0) {
- Fraction fraction{Fraction::Convert(absN).value};
+ Fraction fraction{Fraction::ConvertUnsigned(absN).value};
result.flags |= result.value.Normalize(
isNegative, exponent, fraction.SHIFTL(-bitsLost));
} else {
- Fraction fraction{Fraction::Convert(absN.SHIFTR(bitsLost)).value};
+ Fraction fraction{Fraction::ConvertUnsigned(absN.SHIFTR(bitsLost)).value};
result.flags |= result.value.Normalize(isNegative, exponent, fraction);
RoundingBits roundingBits{absN, bitsLost};
result.flags |= result.value.Round(rounding, roundingBits);
return result;
}
- constexpr DefaultIntrinsicInteger EXPONENT() const {
+ template<typename INT>
+ constexpr INT EXPONENT() const {
std::uint64_t exponent{Exponent()};
if (exponent == maxExponent) {
- return DefaultIntrinsicInteger::HUGE();
+ return INT::HUGE();
} else {
return {static_cast<std::int64_t>(exponent - exponentBias)};
}
if (!fraction.IBITS(0, rshift).IsZero()) {
result.flags.set(RealFlag::Inexact);
}
- auto truncated = result.value.Convert(fraction.SHIFTR(rshift));
+ auto truncated = result.value.ConvertUnsigned(fraction.SHIFTR(rshift));
if (truncated.overflow) {
result.flags.set(RealFlag::Overflow);
} else {
if (lshift + precision >= result.value.bits) {
result.flags.set(RealFlag::Overflow);
} else {
- result.value = result.value.Convert(fraction).value.SHIFTL(lshift);
+ result.value = result.value.ConvertUnsigned(fraction).value.SHIFTL(lshift);
}
}
if (result.flags.test(RealFlag::Overflow)) {
};
constexpr Significand GetSignificand() const {
- return Significand::Convert(word_).value;
+ return Significand::ConvertUnsigned(word_).value;
}
constexpr Fraction GetFraction() const {
- Fraction result{Fraction::Convert(word_).value};
+ Fraction result{Fraction::ConvertUnsigned(word_).value};
if constexpr (!implicitMSB) {
return result;
} else {
word_ = Word{};
exponent = 0;
} else {
- word_ = Word::Convert(fraction).value;
+ word_ = Word::ConvertUnsigned(fraction).value;
if (lshift > 0) {
word_ = word_.SHIFTL(lshift);
if (roundingBits != nullptr) {
// N.B. No "double-double" support.
-} // namespace Fortran::evaluate
+} // namespace Fortran::evaluate::value
#endif // FORTRAN_EVALUATE_REAL_H_
#ifndef FORTRAN_EVALUATE_TYPE_H_
#define FORTRAN_EVALUATE_TYPE_H_
-#include <cinttypes>
-#include <cstddef>
+// These definitions map Fortran's intrinsic types to their value
+// representation types in the evaluation library for ease of template
+// programming.
-namespace Fortran::evaluate {
+#include "integer.h"
+#include "logical.h"
+#include "real.h"
-// Default REAL just simply has to be IEEE-754 single precision today.
-// It occupies one numeric storage unit by definition. The default INTEGER
-// and default LOGICAL intrinsic types also have to occupy one numeric
-// storage unit, so their kinds are forced. Default COMPLEX occupies
-// two numeric storage unit.
-using DefaultIntrinsicIntegerCType = std::int32_t;
+namespace Fortran::evaluate::type {
-class IntrinsicType {
-public:
- enum class Classification { Integer, Real, Complex, Character, Logical };
+enum class Classification { Integer, Real, Complex, Character, Logical };
- // Default REAL just simply has to be IEEE-754 single precision today.
- // It occupies one numeric storage unit by definition. The default INTEGER
- // and default LOGICAL intrinsic types also have to occupy one numeric
- // storage unit, so their kinds are forced. Default COMPLEX occupies
- // two numeric storage unit.
- using KindLenCType = DefaultIntrinsicIntegerCType;
- static constexpr KindLenCType defaultRealKind{4}; // IEEE-754 single
- static constexpr KindLenCType defaultIntegerKind{defaultRealKind};
- static constexpr KindLenCType kindLenIntegerKind{defaultIntegerKind};
- static constexpr KindLenCType defaultLogicalKind{defaultIntegerKind};
+template<int KIND> struct Integer {
+ static constexpr Classification classification{Classification::Integer};
+ static constexpr int kind{KIND};
+ static constexpr bool hasLen{false};
+ using ValueType = value::Integer<8 * kind>;
+};
- static constexpr IntrinsicType IntrinsicTypeParameterType() {
- return IntrinsicType{Classification::Integer, kindLenIntegerKind};
- }
+template<int KIND> struct Real {
+ static constexpr Classification classification{Classification::Real};
+ static constexpr int kind{KIND};
+ static constexpr bool hasLen{false};
+ using ValueType = value::Real<8 * K>;
+};
- IntrinsicType() = delete;
- constexpr IntrinsicType(
- Classification c, KindLenCType kind, KindLenCType len = 1)
- : classification_{c}, kind_{kind}, len_{len} {}
+#if 0 // TODO
+template<int KIND> struct Complex {
+ static constexpr Classification classification{Classification::Complex};
+ static constexpr int kind{KIND};
+ static constexpr bool hasLen{false};
+ using ValueType = value::Complex<8 * K>;
+};
+#endif
- // Defaulted kinds.
- constexpr explicit IntrinsicType(Classification c)
- : classification_{c}, kind_{-1} /* overridden immediately */ {
- switch (c) {
- case Classification::Integer: kind_ = defaultIntegerKind; break;
- case Classification::Real: kind_ = defaultRealKind; break;
- case Classification::Complex: kind_ = 2 * defaultRealKind; break;
- case Classification::Character: kind_ = 1; break;
- case Classification::Logical: kind_ = defaultLogicalKind; break;
- }
- }
- constexpr IntrinsicType(const IntrinsicType &) = default;
- constexpr IntrinsicType &operator=(const IntrinsicType &) = default;
+template<int KIND> struct Logical {
+ static constexpr Classification classification{Classification::Logical};
+ static constexpr int kind{KIND};
+ static constexpr bool hasLen{false};
+ using ValueType = value::Logical<8 * K>;
+};
- constexpr Classification classification() const { return classification_; }
- constexpr KindLenCType kind() const { return kind_; }
- constexpr KindLenCType len() const { return len_; }
+#if 0 // TODO
+template<int KIND> struct Character {
+ static constexpr Classification classification{Classification::Character};
+ static constexpr int kind{KIND};
+ static constexpr bool hasLen{true};
+ using ValueType = value::Character<8 * K>;
+};
+#endif
- // Not necessarily the size of an aligned allocation of runtime memory.
- constexpr std::size_t MinSizeInBytes() const {
- std::size_t n = kind_;
- if (classification_ == Classification::Character) {
- n *= len_;
- }
- return n;
- }
+// Default REAL just simply has to be IEEE-754 single precision today.
+// It occupies one numeric storage unit by definition. The default INTEGER
+// and default LOGICAL intrinsic types also have to occupy one numeric
+// storage unit, so their kinds are also forced. Default COMPLEX occupies
+// two numeric storage units.
-private:
- Classification classification_;
- KindLenCType kind_;
- KindLenCType len_{1}; // valid only for CHARACTER
-};
+using DefaultReal = Real<4>;
+using DefaultInteger = Integer<DefaultReal::kind>;
+using IntrinsicTypeParameterType = DefaultInteger;
+#if 0 // TODO
+using DefaultComplex = Complex<2 * DefaultReal::kind>;
+#endif
+using DefaultLogical = Logical<DefaultReal::kind>;
+#if 0 // TODO
+using DefaultCharacter = Character<1>;
+#endif
} // namespace Fortran::evaluate
#endif // FORTRAN_EVALUATE_TYPE_H_
#include "testing.h"
#include <cstdio>
-using Fortran::evaluate::Integer;
+using Fortran::evaluate::value::Integer;
using Fortran::evaluate::Ordering;
template<int BITS, typename INT = Integer<BITS>> void exhaustiveTesting() {
#include <cstdio>
using namespace Fortran::evaluate;
+using namespace Fortran::evaluate::value;
template<typename R> void basicTests(int rm, Rounding rounding) {
char desc[64];
#define COMPARE(x, rel, y) \
testing::Compare(__FILE__, __LINE__, #x, #rel, #y, (x), (y))
-// Functions called by thesemacros; do not call directly.
+// Functions called by these macros; do not call directly.
using FailureDetailPrinter = void (*)(const char *, ...);
FailureDetailPrinter Test(
const char *file, int line, const char *predicate, bool pass);
projects / platform / upstream / llvm.git / commitdiff