call.cc
common.cc
complex.cc
+ constant.cc
decimal.cc
expression.cc
fold.cc
--- /dev/null
+// Copyright (c) 2019, 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 "type.h"
+#include "../parser/characters.h"
+
+namespace Fortran::evaluate {
+template<typename T>
+std::ostream &Constant<T>::AsFortran(std::ostream &o) const {
+ if (Rank() > 0) {
+ o << "reshape([" << GetType().AsFortran() << "::";
+ }
+ for (const auto &value : values_) {
+ if constexpr (T::category == TypeCategory::Integer) {
+ o << value.SignedDecimal() << '_' << T::kind;
+ } else if constexpr (T::category == TypeCategory::Real ||
+ T::category == TypeCategory::Complex) {
+ value.AsFortran(o, T::kind);
+ } else if constexpr (T::category == TypeCategory::Character) {
+ o << T::kind << '_' << parser::QuoteCharacterLiteral(value);
+ } else if constexpr (T::category == TypeCategory::Logical) {
+ if (value.IsTrue()) {
+ o << ".true.";
+ } else {
+ o << ".false.";
+ }
+ o << '_' << Result::kind;
+ } else {
+ value.u.AsFortran(o);
+ }
+ }
+ if (Rank() > 0) {
+ o << "],shape=";
+ char ch{'['};
+ for (auto dim : shape_) {
+ o << ch << dim;
+ ch = ',';
+ }
+ o << "])";
+ }
+ return o;
+}
+
+template<typename T> Constant<SubscriptInteger> Constant<T>::SHAPE() const {
+ using IntType = Scalar<SubscriptInteger>;
+ std::vector<IntType> result;
+ for (std::int64_t dim : shape_) {
+ result.emplace_back(dim);
+ }
+ return {std::move(result), std::vector<std::int64_t>{Rank()}};
+}
+
+FOR_EACH_INTRINSIC_KIND(template class Constant)
+}
--- /dev/null
+// Copyright (c) 2019, 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 <ostream>
+
+namespace Fortran::evaluate {
+// Wraps a constant value in a class templated by its resolved type.
+// N.B. Generic constants are represented by generic expressions
+// (like Expr<SomeInteger> & Expr<SomeType>) wrapping the appropriate
+// instantiations of Constant.
+template<typename T> class Constant {
+ static_assert(std::is_same_v<T, SomeDerived> || IsSpecificIntrinsicType<T>);
+
+public:
+ using Result = T;
+ using Value = Scalar<Result>;
+
+ CLASS_BOILERPLATE(Constant)
+ template<typename A> Constant(const A &x) : values_{x} {}
+ template<typename A>
+ Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
+ : values_{std::move(x)} {}
+ Constant(std::vector<Value> &&x, std::vector<std::int64_t> &&s)
+ : values_(std::move(x)), shape_(std::move(s)) {}
+
+ constexpr DynamicType GetType() const { return Result::GetType(); }
+ int Rank() const { return static_cast<int>(shape_.size()); }
+ bool operator==(const Constant &that) const {
+ return shape_ == that.shape_ && values_ == that.values_;
+ }
+ std::size_t size() const { return values_.size(); }
+ const std::vector<std::int64_t> &shape() const { return shape_; }
+ std::int64_t LEN() const {
+ if constexpr (T::category != TypeCategory::Character) {
+ common::die("LEN() of non-character Constant");
+ } else if (values_.empty()) {
+ return 0;
+ } else {
+ return static_cast<std::int64_t>(values_[0].size());
+ }
+ }
+
+ const Value &operator*() const {
+ CHECK(values_.size() == 1);
+ return values_.at(0);
+ }
+
+ const Value &At(const std::vector<std::int64_t> &index) {
+ CHECK(index.size() == static_cast<std::size_t>(Rank()));
+ std::int64_t stride{1}, offset{0};
+ int dim{0};
+ for (std::int64_t j : index) {
+ std::int64_t bound{shape_[dim++]};
+ CHECK(j >= 1 && j <= bound);
+ offset += stride * (j - 1);
+ stride *= bound;
+ }
+ return values_.at(offset);
+ }
+
+ Constant<SubscriptInteger> SHAPE() const;
+ std::ostream &AsFortran(std::ostream &) const;
+
+private:
+ std::vector<Value> values_;
+ std::vector<std::int64_t> shape_;
+ // TODO pmk: make CHARACTER values contiguous
+};
+
+FOR_EACH_INTRINSIC_KIND(extern template class Constant)
+}
+#endif // FORTRAN_EVALUATE_CONSTANT_H_
-// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+// Copyright (c) 2018-2019, 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.
#include "tools.h"
#include "variable.h"
#include "../common/idioms.h"
-#include "../parser/characters.h"
#include "../parser/message.h"
#include <ostream>
#include <sstream>
}
template<typename T>
-std::ostream &Constant<T>::AsFortran(std::ostream &o) const {
- if constexpr (T::category == TypeCategory::Integer) {
- return o << value.SignedDecimal() << '_' << T::kind;
- } else if constexpr (T::category == TypeCategory::Real ||
- T::category == TypeCategory::Complex) {
- return value.AsFortran(o, T::kind);
- } else if constexpr (T::category == TypeCategory::Character) {
- return o << T::kind << '_' << parser::QuoteCharacterLiteral(value);
- } else if constexpr (T::category == TypeCategory::Logical) {
- if (value.IsTrue()) {
- o << ".true.";
- } else {
- o << ".false.";
- }
- return o << '_' << Result::kind;
- } else {
- return value.u.AsFortran(o);
- }
-}
-
-template<typename T>
std::ostream &Emit(std::ostream &o, const CopyableIndirection<Expr<T>> &expr) {
return expr->AsFortran(o);
}
return std::visit(
common::visitors{
[](const Constant<Result> &c) {
- return AsExpr(Constant<SubscriptInteger>{c.value.size()});
+ return AsExpr(Constant<SubscriptInteger>{c.LEN()});
},
[](const ArrayConstructor<Result> &a) { return a.LEN(); },
[](const Parentheses<Result> &x) { return x.left().LEN(); },
// for equality.
#include "common.h"
+#include "constant.h"
#include "type.h"
#include "variable.h"
#include "../lib/common/fortran.h"
// evaluation.
#include "common.h"
+#include "constant.h"
#include "expression.h"
#include "tools.h"
#include "type.h"
template<typename T>
const Scalar<T> *GetScalarConstantValue(const Expr<T> &expr) {
if (const auto *c{UnwrapExpr<Constant<T>>(expr)}) {
- return &c->value;
+ if (c->size() == 1) {
+ return &**c;
+ } else {
+ return nullptr;
+ }
} else if (const auto *parens{UnwrapExpr<Parentheses<T>>(expr)}) {
return GetScalarConstantValue<T>(parens->left());
} else {
#ifndef FORTRAN_EVALUATE_TOOLS_H_
#define FORTRAN_EVALUATE_TOOLS_H_
+#include "constant.h"
#include "expression.h"
#include "../common/idioms.h"
#include "../common/unwrap.h"
-// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
+// Copyright (c) 2018-2019, 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.
using LengthlessIntrinsicTypes =
common::CombineTuples<NumericTypes, LogicalTypes>;
-// Predicate: does a type represent a specific intrinsic type?
+// Predicates: does a type represent a specific intrinsic type?
template<typename T>
constexpr bool IsSpecificIntrinsicType{common::HasMember<T, AllIntrinsicTypes>};
#define FOR_EACH_TYPE_AND_KIND(PREFIX) \
FOR_EACH_INTRINSIC_KIND(PREFIX) \
FOR_EACH_CATEGORY_TYPE(PREFIX)
-
-// Wraps a constant scalar value of a specific intrinsic type
-// in a class with its resolved type.
-// N.B. Array constants are represented as array constructors
-// and derived type constants are structure constructors; generic
-// constants are generic expressions wrapping these constants.
-template<typename T> struct Constant {
- static_assert(IsSpecificIntrinsicType<T>);
- using Result = T;
- using Value = Scalar<Result>;
-
- CLASS_BOILERPLATE(Constant)
- template<typename A> Constant(const A &x) : value{x} {}
- template<typename A>
- Constant(std::enable_if_t<!std::is_reference_v<A>, A> &&x)
- : value(std::move(x)) {}
-
- constexpr DynamicType GetType() const { return Result::GetType(); }
- int Rank() const { return 0; }
- bool operator==(const Constant &that) const { return value == that.value; }
- std::ostream &AsFortran(std::ostream &) const;
-
- Value value;
-};
}
#endif // FORTRAN_EVALUATE_TYPE_H_
#include "call.h"
#include "common.h"
+#include "constant.h"
#include "static-data.h"
#include "type.h"
#include "../common/idioms.h"
using Result = ResultType<decltype(ckExpr)>;
auto *cp{std::get_if<Constant<Result>>(&ckExpr.u)};
CHECK(cp != nullptr); // the parent was parsed as a constant string
+ CHECK(cp->size() == 1);
StaticDataObject::Pointer staticData{StaticDataObject::Create()};
staticData->set_alignment(Result::kind)
.set_itemBytes(Result::kind)
- .Push(cp->value);
+ .Push(**cp);
Substring substring{std::move(staticData), std::move(lower.value()),
std::move(upper.value())};
return AsGenericExpr(Expr<SomeCharacter>{