[flang] begin work

Original-commit: flang-compiler/f18@82e434bf5966afa6e86a24a4de69d1ab537eb607
Reviewed-on: https://github.com/flang-compiler/f18/pull/101
Tree-same-pre-rewrite: false

diff --git a/flang/lib/CMakeLists.txt b/flang/lib/CMakeLists.txt
index 647d4b7..65bdcd5 100644 (file)
--- a/flang/lib/CMakeLists.txt
+++ b/flang/lib/CMakeLists.txt
@@ -13,5 +13,6 @@
 # limitations under the License.
 
 
+add_subdirectory(evaluate)
 add_subdirectory(parser)
 add_subdirectory(semantics)

diff --git a/flang/lib/evaluate/CMakeLists.txt b/flang/lib/evaluate/CMakeLists.txt
new file mode 100644 (file)
index 0000000..e865779
--- /dev/null
+++ b/flang/lib/evaluate/CMakeLists.txt
@@ -0,0 +1,17 @@
+# 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.
+
+add_library(FortranEvaluate
+  constant.cc
+)
\ No newline at end of file

diff --git a/flang/lib/evaluate/constant.cc b/flang/lib/evaluate/constant.cc
new file mode 100644 (file)
index 0000000..bd195c2
--- /dev/null
+++ b/flang/lib/evaluate/constant.cc
@@ -0,0 +1,63 @@
+// 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

diff --git a/flang/lib/evaluate/constant.h b/flang/lib/evaluate/constant.h
new file mode 100644 (file)
index 0000000..529ff58
--- /dev/null
+++ b/flang/lib/evaluate/constant.h
@@ -0,0 +1,139 @@
+// 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 "../parser/idioms.h"
+#include "type.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_

diff --git a/flang/lib/evaluate/type.h b/flang/lib/evaluate/type.h
new file mode 100644 (file)
index 0000000..5520462
--- /dev/null
+++ b/flang/lib/evaluate/type.h
@@ -0,0 +1,81 @@
+// 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_TYPE_H_
+#define FORTRAN_EVALUATE_TYPE_H_
+
+#include <cinttypes>
+#include <cstddef>
+
+namespace Fortran::evaluate {
+
+class IntrinsicType {
+public:
+  enum class Classification { Integer, Real, Complex, Character, Logical };
+
+  // Default REAL just has to be IEEE-754 single precision today.
+  // It occupies one numeric storage unit.  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 = std::int32_t;
+  static constexpr KindLenCType defaultRealKind{4};  // IEEE-754 single
+  static constexpr KindLenCType defaultIntegerKind{defaultRealKind};
+  static constexpr KindLenCType kindLenIntegerKind{defaultIntegerKind};
+  static constexpr KindLenCType defaultLogicalKind{defaultIntegerKind};
+
+  static constexpr IntrinsicType IntrinsicTypeParameterType() {
+    return IntrinsicType{Classification::Integer, kindLenIntegerKind};
+  }
+
+  IntrinsicType() = delete;
+  constexpr IntrinsicType(Classification c, KindLenCType kind,
+                         KindLenCType len = 1)
+    : classification_{c}, kind_{kind}, len_{len} {}
+
+  // 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;
+
+  constexpr Classification classification() const { return classification_; }
+  constexpr KindLenCType kind() const { return kind_; }
+  constexpr KindLenCType len() const { return len_; }
+
+  // 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;
+  }
+
+private:
+  Classification classification_;
+  KindLenCType kind_;
+  KindLenCType len_{1};  // valid only for CHARACTER
+};
+
+}  // namespace Fortran::evaluate
+#endif  // FORTRAN_EVALUATE_TYPE_H_