maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Run expression semantic analysis with rest of semantics. 

checkpoint array constructor semantics work

checkpoint

array constructors of lengthless intrinsic types

checkpoint

Correct ambiguous substring refs misparsed as array elements

Original-commit: flang-compiler/f18@2232549efe
Reviewed-on: https://github.com/flang-compiler/f18/pull/271
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2019-01-22 16:30:32 -08:00
parent 8a3a255070
commit 0ae3d43d76
23 changed files with 775 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
flang/lib/common/fortran.h
View File

@ -23,9 +23,14 @@
namespace Fortran::common {
// Fortran has five kinds of intrinsic data, and the derived types.
// Fortran has five kinds of intrinsic data types, plus the derived types.
ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived)
constexpr bool IsNumericTypeCategory(TypeCategory category) {
return category == TypeCategory::Integer || category == TypeCategory::Real ||
category == TypeCategory::Complex;
}
// Kinds of IMPORT statements. Default means IMPORT or IMPORT :: names.
ENUM_CLASS(ImportKind, Default, Only, None, All)

28
flang/lib/common/template.h
View File

@ -29,8 +29,7 @@ namespace Fortran::common {
// SearchTypeList<PREDICATE, TYPES...> scans a list of types. The zero-based
// index of the first type T in the list for which PREDICATE<T>::value() is
// true is returned, or -1 if the predicate is false for every type in the list.
// This is a compile-time operation; see SearchDynamicTypes below for a
// run-time form.
// This is a compile-time operation; see SearchTypes below for a run-time form.
template<int N, template<typename> class PREDICATE, typename TUPLE>
struct SearchTypeListHelper {
static constexpr int value() {
@ -245,28 +244,29 @@ std::optional<R> MapOptional(
// Given a VISITOR class of the general form
// struct VISITOR {
// using Result = ...;
// static constexpr std::size_t Types{...};
// template<std::size_t J> static Result Test();
// using Types = std::tuple<...>;
// template<typename T> Result Test() { ... }
// };
// SearchDynamicTypes will traverse the indices 0 .. (Types-1) and
// invoke VISITOR::Test<J>() until it returns a value that casts
// to true. If no invocation of Test succeeds, it returns a
// default-constructed Result.
// SearchTypes will traverse the element types in the tuple in order
// and invoke VISITOR::Test<T>() on each until it returns a value that
// casts to true. If no invocation of Test succeeds, SearchTypes will
// return a default-constructed value VISITOR::Result{}.
template<std::size_t J, typename VISITOR>
typename VISITOR::Result SearchDynamicTypesHelper(VISITOR &&visitor) {
if constexpr (J < VISITOR::Types) {
if (auto result{visitor.template Test<J>()}) {
typename VISITOR::Result SearchTypesHelper(VISITOR &&visitor) {
using Tuple = typename VISITOR::Types;
if constexpr (J < std::tuple_size_v<Tuple>) {
if (auto result{visitor.template Test<std::tuple_element_t<J, Tuple>>()}) {
return result;
}
return SearchDynamicTypesHelper<J + 1, VISITOR>(std::move(visitor));
return SearchTypesHelper<J + 1, VISITOR>(std::move(visitor));
} else {
return typename VISITOR::Result{};
}
}
template<typename VISITOR>
typename VISITOR::Result SearchDynamicTypes(VISITOR &&visitor) {
return SearchDynamicTypesHelper<0, VISITOR>(std::move(visitor));
typename VISITOR::Result SearchTypes(VISITOR &&visitor) {
return SearchTypesHelper<0, VISITOR>(std::move(visitor));
}
}
#endif // FORTRAN_COMMON_TEMPLATE_H_

54
flang/lib/evaluate/expression.cc
View File

@ -21,6 +21,7 @@
#include "../parser/characters.h"
#include "../parser/message.h"
#include <ostream>
#include <sstream>
#include <string>
#include <type_traits>
@ -107,15 +108,15 @@ template<typename T>
std::ostream &Emit(std::ostream &o, const CopyableIndirection<Expr<T>> &expr) {
return expr->AsFortran(o);
}
template<typename T>
std::ostream &Emit(std::ostream &, const ArrayConstructorValues<T> &);
template<typename ITEM, typename INT>
std::ostream &Emit(std::ostream &o, const ImpliedDo<ITEM, INT> &implDo) {
template<typename T>
std::ostream &Emit(std::ostream &o, const ImpliedDo<T> &implDo) {
o << '(';
Emit(o, *implDo.values);
o << ',' << INT::AsFortran() << "::";
o << implDo.controlVariableName.ToString();
o << ',' << ImpliedDoIndex::Result::AsFortran() << "::";
o << '=';
implDo.lower->AsFortran(o) << ',';
implDo.upper->AsFortran(o) << ',';
@ -136,8 +137,18 @@ std::ostream &Emit(std::ostream &o, const ArrayConstructorValues<T> &values) {
template<typename T>
std::ostream &ArrayConstructor<T>::AsFortran(std::ostream &o) const {
o << '[' << result.AsFortran() << "::";
Emit(o, *this);
o << '[' << GetType().AsFortran() << "::";
Emit(o, values);
return o << ']';
}
template<int KIND>
std::ostream &ArrayConstructor<Type<TypeCategory::Character, KIND>>::AsFortran(
std::ostream &o) const {
std::stringstream len;
length->AsFortran(len);
o << '[' << GetType().AsFortran(len.str()) << "::";
Emit(o, values);
return o << ']';
}
@ -149,17 +160,13 @@ std::ostream &ExpressionBase<RESULT>::AsFortran(std::ostream &o) const {
o << "z'" << x.Hexadecimal() << "'";
},
[&](const CopyableIndirection<Substring> &s) { s->AsFortran(o); },
[&](const ImpliedDoIndex &i) { o << i.name.ToString(); },
[&](const auto &x) { x.AsFortran(o); },
},
derived().u);
return o;
}
template<typename T> Expr<SubscriptInteger> ArrayConstructor<T>::LEN() const {
// TODO pmk: extract from type spec in array constructor
return AsExpr(Constant<SubscriptInteger>{0}); // TODO placeholder
}
template<int KIND>
Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
return std::visit(
@ -184,11 +191,6 @@ Expr<SubscriptInteger> Expr<Type<TypeCategory::Character, KIND>>::LEN() const {
Expr<SomeType>::~Expr() {}
template<typename T> DynamicType ArrayConstructor<T>::GetType() const {
// TODO: pmk: parameterized derived types, CHARACTER length
return result.GetType();
}
#if defined(__APPLE__) && defined(__GNUC__)
template<typename A>
typename ExpressionBase<A>::Derived &ExpressionBase<A>::derived() {
@ -231,10 +233,17 @@ template<typename A> int ExpressionBase<A>::Rank() const {
derived().u);
}
template<int KIND>
ArrayConstructor<Type<TypeCategory::Character, KIND>>::~ArrayConstructor() {}
// Equality testing for classes without EVALUATE_UNION_CLASS_BOILERPLATE()
template<typename V, typename O>
bool ImpliedDo<V, O>::operator==(const ImpliedDo<V, O> &that) const {
bool ImpliedDoIndex::operator==(const ImpliedDoIndex &that) const {
return name == that.name;
}
template<typename T>
bool ImpliedDo<T>::operator==(const ImpliedDo<T> &that) const {
return controlVariableName == that.controlVariableName &&
lower == that.lower && upper == that.upper && stride == that.stride &&
values == that.values;
@ -248,8 +257,13 @@ bool ArrayConstructorValues<R>::operator==(
template<typename R>
bool ArrayConstructor<R>::operator==(const ArrayConstructor<R> &that) const {
return *static_cast<const ArrayConstructorValues<R> *>(this) == that &&
result == that.result && typeParameterValues == that.typeParameterValues;
return type == that.type && values == that.values;
}
template<int KIND>
bool ArrayConstructor<Type<TypeCategory::Character, KIND>>::operator==(
const ArrayConstructor<Type<TypeCategory::Character, KIND>> &that) const {
return length == that.length && values == that.values;
}
bool GenericExprWrapper::operator==(const GenericExprWrapper &that) const {

91
flang/lib/evaluate/expression.h
View File

@ -31,6 +31,7 @@
#include "../lib/parser/char-block.h"
#include "../lib/parser/message.h"
#include <algorithm>
#include <list>
#include <ostream>
#include <tuple>
#include <type_traits>
@ -58,7 +59,7 @@ using common::RelationalOperator;
// Everything that can appear in, or as, a valid Fortran expression must be
// represented with an instance of some class containing a Result typedef that
// maps to some instantiation of Type<CATEGORY, KIND>, SomeKind<CATEGORY>,
// or SomeType.
// or SomeType. (Exception: BOZ literal constants in generic Expr<SomeType>.)
template<typename A> using ResultType = typename std::decay_t<A>::Result;
// Common Expr<> behaviors: every Expr<T> derives from ExpressionBase<T>.
@ -212,7 +213,8 @@ private:
// dynamic kind.
template<typename TO, TypeCategory FROMCAT>
struct Convert : public Operation<Convert<TO, FROMCAT>, TO, SomeKind<FROMCAT>> {
// Fortran doesn't have conversions between kinds of CHARACTER.
// Fortran doesn't have conversions between kinds of CHARACTER apart from
// assignments, and in those the data must be convertible to/from 7-bit ASCII.
// Conversions between kinds of COMPLEX are represented piecewise.
static_assert(((TO::category == TypeCategory::Integer ||
TO::category == TypeCategory::Real) &&
@ -392,47 +394,67 @@ struct LogicalOperation
template<typename RESULT> struct ArrayConstructorValues;
template<typename VALUES, typename OPERAND> struct ImpliedDo {
using Values = VALUES;
using Operand = OPERAND;
using Result = ResultType<Values>;
static_assert(Operand::category == TypeCategory::Integer);
struct ImpliedDoIndex {
using Result = SubscriptInteger;
bool operator==(const ImpliedDoIndex &) const;
static constexpr int Rank() { return 0; }
parser::CharBlock name; // nested implied DOs must use distinct names
};
template<typename RESULT> struct ImpliedDo {
using Result = RESULT;
bool operator==(const ImpliedDo &) const;
parser::CharBlock controlVariableName;
CopyableIndirection<Expr<Operand>> lower, upper, stride;
CopyableIndirection<Values> values;
CopyableIndirection<Expr<ResultType<ImpliedDoIndex>>> lower, upper, stride;
CopyableIndirection<ArrayConstructorValues<RESULT>> values;
};
template<typename RESULT> struct ArrayConstructorValue {
using Result = RESULT;
EVALUATE_UNION_CLASS_BOILERPLATE(ArrayConstructorValue)
template<typename INT>
using ImpliedDo = ImpliedDo<ArrayConstructorValues<Result>, INT>;
common::CombineVariants<std::variant<CopyableIndirection<Expr<Result>>>,
common::MapTemplate<ImpliedDo, IntegerTypes>>
u;
std::variant<CopyableIndirection<Expr<Result>>, ImpliedDo<Result>> u;
};
template<typename RESULT> struct ArrayConstructorValues {
using Result = RESULT;
CLASS_BOILERPLATE(ArrayConstructorValues)
template<typename A> void Push(A &&x) { values.emplace_back(std::move(x)); }
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(ArrayConstructorValues)
ArrayConstructorValues() {}
bool operator==(const ArrayConstructorValues &) const;
template<typename A> void Push(A &&x) { values.emplace_back(std::move(x)); }
std::vector<ArrayConstructorValue<Result>> values;
};
template<typename RESULT>
struct ArrayConstructor : public ArrayConstructorValues<RESULT> {
template<typename RESULT> struct ArrayConstructor {
using Result = RESULT;
using ArrayConstructorValues<Result>::ArrayConstructorValues;
DynamicType GetType() const;
CLASS_BOILERPLATE(ArrayConstructor)
ArrayConstructor(Result &&t, ArrayConstructorValues<Result> &&v)
: type{std::move(t)}, values{std::move(v)} {
CHECK(type.category != TypeCategory::Character);
}
bool operator==(const ArrayConstructor<RESULT> &) const;
DynamicType GetType() const { return type.GetType(); }
static constexpr int Rank() { return 1; }
Expr<SubscriptInteger> LEN() const;
bool operator==(const ArrayConstructor &) const;
std::ostream &AsFortran(std::ostream &) const;
Result type;
ArrayConstructorValues<Result> values;
};
Result result;
std::vector<Expr<SubscriptInteger>> typeParameterValues;
template<int KIND>
struct ArrayConstructor<Type<TypeCategory::Character, KIND>> {
using Result = Type<TypeCategory::Character, KIND>;
CLASS_BOILERPLATE(ArrayConstructor)
ArrayConstructor(
ArrayConstructorValues<Result> &&v, Expr<SubscriptInteger> &&len)
: values{std::move(v)}, length{std::move(len)} {}
~ArrayConstructor();
bool operator==(const ArrayConstructor<Result> &) const;
static constexpr DynamicType GetType() { return Result::GetType(); }
static constexpr int Rank() { return 1; }
std::ostream &AsFortran(std::ostream &) const;
const Expr<SubscriptInteger> &LEN() const { return *length; }
ArrayConstructorValues<Result> values;
CopyableIndirection<Expr<SubscriptInteger>> length;
};
// Expression representations for each type category.
@ -450,16 +472,20 @@ public:
: u{Constant<Result>{n}} {}
private:
using Conversions = std::variant<Convert<Result, TypeCategory::Integer>,
using Conversions = std::tuple<Convert<Result, TypeCategory::Integer>,
Convert<Result, TypeCategory::Real>>;
using Operations = std::variant<Parentheses<Result>, Negate<Result>,
using Operations = std::tuple<Parentheses<Result>, Negate<Result>,
Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
Power<Result>, Extremum<Result>>;
using Others = std::variant<Constant<Result>, ArrayConstructor<Result>,
using Indices = std::conditional_t<KIND == ImpliedDoIndex::Result::kind,
std::tuple<ImpliedDoIndex>, std::tuple<>>;
using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
TypeParamInquiry<KIND>, Designator<Result>, FunctionRef<Result>>;
public:
common::CombineVariants<Operations, Conversions, Others> u;
common::TupleToVariant<
common::CombineTuples<Operations, Conversions, Indices, Others>>
u;
};
template<int KIND>
@ -592,15 +618,16 @@ public:
explicit Expr(bool x) : u{Constant<Result>{x}} {}
private:
using Operations = std::variant<Convert<Result, TypeCategory::Logical>,
using Operations = std::tuple<Convert<Result, TypeCategory::Logical>,
Parentheses<Result>, Not<KIND>, LogicalOperation<KIND>>;
using Relations = std::conditional_t<KIND == LogicalResult::kind,
std::variant<Relational<SomeType>>, std::variant<>>;
using Others = std::variant<Constant<Result>, ArrayConstructor<Result>,
std::tuple<Relational<SomeType>>, std::tuple<>>;
using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
Designator<Result>, FunctionRef<Result>>;
public:
common::CombineVariants<Operations, Relations, Others> u;
common::TupleToVariant<common::CombineTuples<Operations, Relations, Others>>
u;
};
FOR_EACH_LOGICAL_KIND(extern template class Expr)

15
flang/lib/evaluate/fold.cc
View File

@ -68,7 +68,7 @@ Component FoldOperation(FoldingContext &context, Component &&component) {
Triplet FoldOperation(FoldingContext &context, Triplet &&triplet) {
return {Fold(context, triplet.lower()), Fold(context, triplet.upper()),
Fold(context, triplet.stride())};
Fold(context, Expr<SubscriptInteger>{triplet.stride()})};
}
Subscript FoldOperation(FoldingContext &context, Subscript &&subscript) {
@ -660,14 +660,16 @@ bool IsConstExpr(ConstExprContext &, const Symbol *symbol) {
return symbol->attrs().test(semantics::Attr::PARAMETER);
}
bool IsConstExpr(ConstExprContext &, const CoarrayRef &) { return false; }
bool IsConstExpr(ConstExprContext &, const ImpliedDoIndex &) {
return true; // only tested when bounds are constant
}
// Prototypes for mutual recursion
template<typename D, typename R, typename O1>
bool IsConstExpr(ConstExprContext &, const Operation<D, R, O1> &);
template<typename D, typename R, typename O1, typename O2>
bool IsConstExpr(ConstExprContext &, const Operation<D, R, O1, O2> &);
template<typename V, typename O>
bool IsConstExpr(ConstExprContext &, const ImpliedDo<V, O> &);
template<typename V> bool IsConstExpr(ConstExprContext &, const ImpliedDo<V> &);
template<typename A>
bool IsConstExpr(ConstExprContext &, const ArrayConstructorValue<A> &);
template<typename A>
@ -709,8 +711,8 @@ bool IsConstExpr(
return IsConstExpr(context, operation.left()) &&
IsConstExpr(context, operation.right());
}
template<typename V, typename O>
bool IsConstExpr(ConstExprContext &context, const ImpliedDo<V, O> &impliedDo) {
template<typename V>
bool IsConstExpr(ConstExprContext &context, const ImpliedDo<V> &impliedDo) {
if (!IsConstExpr(context, impliedDo.lower) ||
!IsConstExpr(context, impliedDo.upper) ||
!IsConstExpr(context, impliedDo.stride)) {
@ -732,8 +734,7 @@ bool IsConstExpr(
}
template<typename A>
bool IsConstExpr(ConstExprContext &context, const ArrayConstructor<A> &array) {
return IsConstExpr(context, array.values) &&
IsConstExpr(context, array.typeParameterValues);
return IsConstExpr(context, array.values);
}
bool IsConstExpr(ConstExprContext &context, const BaseObject &base) {
return IsConstExpr(context, base.u);

62
flang/lib/evaluate/tools.cc
View File

@ -494,4 +494,66 @@ Expr<SomeLogical> BinaryLogicalOperation(
},
AsSameKindExprs(std::move(x), std::move(y)));
}
template<TypeCategory TO>
std::optional<Expr<SomeType>> ConvertToNumeric(int kind, Expr<SomeType> &&x) {
static_assert(common::IsNumericTypeCategory(TO));
return std::visit(
[=](auto &&cx) -> std::optional<Expr<SomeType>> {
using cxType = std::decay_t<decltype(cx)>;
if constexpr (!std::is_same_v<cxType, BOZLiteralConstant>) {
if constexpr (IsNumericTypeCategory(ResultType<cxType>::category)) {
return std::make_optional(
Expr<SomeType>{ConvertToKind<TO>(kind, std::move(cx))});
}
}
return std::nullopt;
},
std::move(x.u));
}
std::optional<Expr<SomeType>> ConvertToType(
const DynamicType &type, Expr<SomeType> &&x) {
switch (type.category) {
case TypeCategory::Integer:
return ConvertToNumeric<TypeCategory::Integer>(type.kind, std::move(x));
case TypeCategory::Real:
return ConvertToNumeric<TypeCategory::Real>(type.kind, std::move(x));
case TypeCategory::Complex:
return ConvertToNumeric<TypeCategory::Complex>(type.kind, std::move(x));
case TypeCategory::Character:
if (auto fromType{x.GetType()}) {
if (fromType->category == TypeCategory::Character &&
fromType->kind == type.kind) {
// TODO pmk: adjusting CHARACTER length via conversion
return std::move(x);
}
}
break;
case TypeCategory::Logical:
if (auto *cx{UnwrapExpr<Expr<SomeLogical>>(x)}) {
return Expr<SomeType>{
ConvertToKind<TypeCategory::Logical>(type.kind, std::move(*cx))};
}
break;
case TypeCategory::Derived:
if (auto fromType{x.GetType()}) {
if (type == fromType) {
return std::move(x);
}
}
break;
default: CRASH_NO_CASE;
}
return std::nullopt;
}
std::optional<Expr<SomeType>> ConvertToType(
const DynamicType &type, std::optional<Expr<SomeType>> &&x) {
if (x.has_value()) {
return ConvertToType(type, std::move(*x));
} else {
return std::nullopt;
}
}
}

83
flang/lib/evaluate/tools.h
View File

@ -164,6 +164,16 @@ Expr<TO> ConvertToType(Expr<SomeKind<FROMCAT>> &&x) {
Scalar<Part> zero;
return Expr<TO>{ComplexConstructor<TO::kind>{
ConvertToType<Part>(std::move(x)), Expr<Part>{Constant<Part>{zero}}}};
} else if constexpr (FROMCAT == TypeCategory::Complex) {
// Extract and convert the real component of a complex value
return std::visit(
[&](auto &&z) {
using ZType = ResultType<decltype(z)>;
using Part = typename ZType::Part;
return ConvertToType<TO, TypeCategory::Real>(Expr<SomeReal>{
Expr<Part>{ComplexComponent<Part::kind>{false, std::move(z)}}});
},
std::move(x.u));
} else {
return Expr<TO>{Convert<TO, FROMCAT>{std::move(x)}};
}
@ -194,6 +204,11 @@ Expr<TO> ConvertToType(Expr<SomeKind<FROMCAT>> &&x) {
}
}
template<typename TO, TypeCategory FROMCAT, int FROMKIND>
Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
return ConvertToType<TO, FROMCAT>(Expr<SomeKind<FROMCAT>>{std::move(x)});
}
template<typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
static_assert(IsSpecificIntrinsicType<TO>);
using Value = typename Constant<TO>::Value;
@ -206,21 +221,20 @@ template<typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
}
}
template<TypeCategory TC, int TK, TypeCategory FC>
Expr<Type<TC, TK>> ConvertTo(
const Expr<Type<TC, TK>> &, Expr<SomeKind<FC>> &&x) {
// Conversions to dynamic types
std::optional<Expr<SomeType>> ConvertToType(
const DynamicType &, Expr<SomeType> &&);
std::optional<Expr<SomeType>> ConvertToType(
const DynamicType &, std::optional<Expr<SomeType>> &&);
// Conversions to the type of another expression
template<TypeCategory TC, int TK, typename FROM>
Expr<Type<TC, TK>> ConvertTo(const Expr<Type<TC, TK>> &, FROM &&x) {
return ConvertToType<Type<TC, TK>>(std::move(x));
}
template<TypeCategory TC, int TK, TypeCategory FC, int FK>
Expr<Type<TC, TK>> ConvertTo(
const Expr<Type<TC, TK>> &, Expr<Type<FC, FK>> &&x) {
return AsExpr(ConvertToType<Type<TC, TK>>(AsCategoryExpr(std::move(x))));
}
template<TypeCategory TC, TypeCategory FC>
Expr<SomeKind<TC>> ConvertTo(
const Expr<SomeKind<TC>> &to, Expr<SomeKind<FC>> &&from) {
template<TypeCategory TC, typename FROM>
Expr<SomeKind<TC>> ConvertTo(const Expr<SomeKind<TC>> &to, FROM &&from) {
return std::visit(
[&](const auto &toKindExpr) {
using KindExpr = std::decay_t<decltype(toKindExpr)>;
@ -230,14 +244,8 @@ Expr<SomeKind<TC>> ConvertTo(
to.u);
}
template<TypeCategory TC, TypeCategory FC, int FK>
Expr<SomeKind<TC>> ConvertTo(
const Expr<SomeKind<TC>> &to, Expr<Type<FC, FK>> &&from) {
return ConvertTo(to, AsCategoryExpr(std::move(from)));
}
template<typename FT>
Expr<SomeType> ConvertTo(const Expr<SomeType> &to, Expr<FT> &&from) {
template<typename FROM>
Expr<SomeType> ConvertTo(const Expr<SomeType> &to, FROM &&from) {
return std::visit(
[&](const auto &toCatExpr) {
return AsGenericExpr(ConvertTo(toCatExpr, std::move(from)));
@ -245,28 +253,16 @@ Expr<SomeType> ConvertTo(const Expr<SomeType> &to, Expr<FT> &&from) {
to.u);
}
template<TypeCategory CAT>
Expr<SomeKind<CAT>> ConvertTo(
const Expr<SomeKind<CAT>> &to, BOZLiteralConstant &&from) {
return std::visit(
[&](const auto &tok) {
using Ty = ResultType<decltype(tok)>;
return AsCategoryExpr(ConvertToType<Ty>(std::move(from)));
},
to.u);
}
// Convert an expression of some known category to a dynamically chosen
// kind of some category (usually but not necessarily distinct).
template<TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper {
using Result = std::optional<Expr<SomeKind<TOCAT>>>;
static constexpr std::size_t Types{std::tuple_size_v<CategoryTypes<TOCAT>>};
using Types = CategoryTypes<TOCAT>;
ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
template<std::size_t J> Result Test() {
using Ty = std::tuple_element_t<J, CategoryTypes<TOCAT>>;
if (kind == Ty::kind) {
template<typename T> Result Test() {
if (kind == T::kind) {
return std::make_optional(
AsCategoryExpr(ConvertToType<Ty>(std::move(value))));
AsCategoryExpr(ConvertToType<T>(std::move(value))));
}
return std::nullopt;
}
@ -276,7 +272,7 @@ template<TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper {
template<TypeCategory TOCAT, typename VALUE>
Expr<SomeKind<TOCAT>> ConvertToKind(int kind, VALUE &&x) {
return common::SearchDynamicTypes(
return common::SearchTypes(
ConvertToKindHelper<TOCAT, VALUE>{kind, std::move(x)})
.value();
}
@ -501,21 +497,20 @@ Expr<SomeKind<CAT>> operator/(
return PromoteAndCombine<Divide, CAT>(std::move(x), std::move(y));
}
// A utility for use with common::SearchDynamicTypes to create generic
// expressions when an intrinsic type category for (say) a variable is known
// A utility for use with common::SearchTypes to create generic expressions
// when an intrinsic type category for (say) a variable is known
// but the kind parameter value is not.
template<TypeCategory CAT, template<typename> class TEMPLATE, typename VALUE>
struct TypeKindVisitor {
using Result = std::optional<Expr<SomeType>>;
static constexpr std::size_t Types{std::tuple_size_v<CategoryTypes<CAT>>};
using Types = CategoryTypes<CAT>;
TypeKindVisitor(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
TypeKindVisitor(int k, const VALUE &x) : kind{k}, value{x} {}
template<std::size_t J> Result Test() {
using Ty = std::tuple_element_t<J, CategoryTypes<CAT>>;
if (kind == Ty::kind) {
return AsGenericExpr(TEMPLATE<Ty>{std::move(value)});
template<typename T> Result Test() {
if (kind == T::kind) {
return AsGenericExpr(TEMPLATE<T>{std::move(value)});
}
return std::nullopt;
}

14
flang/lib/evaluate/type.cc
View File

@ -118,15 +118,23 @@ std::optional<DynamicType> GetSymbolType(const semantics::Symbol *symbol) {
}
std::string DynamicType::AsFortran() const {
if (category == TypeCategory::Derived) {
// TODO: derived type parameters
if (derived != nullptr) {
CHECK(category == TypeCategory::Derived);
return "TYPE("s + derived->typeSymbol().name().ToString() + ')';
} else {
// TODO: CHARACTER length
return EnumToString(category) + '(' + std::to_string(kind) + ')';
}
}
std::string DynamicType::AsFortran(std::string &&charLenExpr) const {
if (!charLenExpr.empty() && category == TypeCategory::Character) {
return "CHARACTER(KIND=" + std::to_string(kind) +
",len=" + std::move(charLenExpr) + ')';
} else {
return AsFortran();
}
}
DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const {
switch (category) {
case TypeCategory::Integer:

28
flang/lib/evaluate/type.h
View File

@ -44,27 +44,35 @@ namespace Fortran::evaluate {
using common::TypeCategory;
// Specific intrinsic types are represented by specializations of
// this class template Type<CATEGORY, KIND>.
template<TypeCategory CATEGORY, int KIND = 0> class Type;
using SubscriptInteger = Type<TypeCategory::Integer, 8>;
using LogicalResult = Type<TypeCategory::Logical, 1>;
using LargestReal = Type<TypeCategory::Real, 16>;
// DynamicType is suitable for use as the result type for
// GetType() functions and member functions.
// GetType() functions and member functions. It does *not*
// hold CHARACTER length type parameter expressions -- those
// must be derived via LEN() member functions or packaged
// elsewhere (e.g. as in ArrayConstructor).
struct DynamicType {
bool operator==(const DynamicType &that) const;
bool operator==(const DynamicType &) const;
std::string AsFortran() const;
std::string AsFortran(std::string &&charLenExpr) const;
DynamicType ResultTypeForMultiply(const DynamicType &) const;
TypeCategory category;
int kind{0}; // set only for intrinsic types
const semantics::DerivedTypeSpec *derived{nullptr};
const semantics::Symbol *descriptor{nullptr};
const semantics::DerivedTypeSpec *derived{nullptr}; // TYPE(T), CLASS(T)
const semantics::Symbol *descriptor{nullptr}; // CHARACTER, CLASS(T/*)
};
// Result will be missing when a symbol is absent or
// has an erroneous type, e.g., REAL(KIND=666).
std::optional<DynamicType> GetSymbolType(const semantics::Symbol *);
// Specific intrinsic types are represented by specializations of
// this class template Type<CATEGORY, KIND>.
template<TypeCategory CATEGORY, int KIND = 0> class Type;
template<TypeCategory CATEGORY, int KIND = 0> struct TypeBase {
static constexpr TypeCategory category{CATEGORY};
static constexpr int kind{KIND};
@ -172,10 +180,6 @@ template<typename T> using Scalar = typename std::decay_t<T>::Scalar;
template<TypeCategory CATEGORY, typename T>
using SameKind = Type<CATEGORY, std::decay_t<T>::kind>;
using SubscriptInteger = Type<TypeCategory::Integer, 8>;
using LogicalResult = Type<TypeCategory::Logical, 1>;
using LargestReal = Type<TypeCategory::Real, 16>;
// Many expressions, including subscripts, CHARACTER lengths, array bounds,
// and effective type parameter values, are of a maximal kind of INTEGER.
using IndirectSubscriptIntegerExpr =

45
flang/lib/evaluate/variable.cc
View File

@ -29,17 +29,17 @@ namespace Fortran::evaluate {
// Constructors, accessors, mutators
Triplet::Triplet() : stride_{Expr<SubscriptInteger>{1}} {}
Triplet::Triplet(std::optional<Expr<SubscriptInteger>> &&l,
std::optional<Expr<SubscriptInteger>> &&u,
std::optional<Expr<SubscriptInteger>> &&s) {
std::optional<Expr<SubscriptInteger>> &&s)
: stride_{s.has_value() ? std::move(*s) : Expr<SubscriptInteger>{1}} {
if (l.has_value()) {
lower_ = IndirectSubscriptIntegerExpr::Make(std::move(*l));
lower_.emplace(std::move(*l));
}
if (u.has_value()) {
upper_ = IndirectSubscriptIntegerExpr::Make(std::move(*u));
}
if (s.has_value()) {
stride_ = IndirectSubscriptIntegerExpr::Make(std::move(*s));
upper_.emplace(std::move(*u));
}
}
@ -57,11 +57,14 @@ std::optional<Expr<SubscriptInteger>> Triplet::upper() const {
return std::nullopt;
}
std::optional<Expr<SubscriptInteger>> Triplet::stride() const {
if (stride_) {
return {**stride_};
const Expr<SubscriptInteger> &Triplet::stride() const { return *stride_; }
bool Triplet::IsStrideOne() const {
if (auto stride{ToInt64(*stride_)}) {
return stride == 1;
} else {
return false;
}
return std::nullopt;
}
CoarrayRef::CoarrayRef(std::vector<const Symbol *> &&c,
@ -90,13 +93,13 @@ std::optional<Expr<SomeInteger>> CoarrayRef::team() const {
CoarrayRef &CoarrayRef::set_stat(Expr<SomeInteger> &&v) {
CHECK(IsVariable(v));
stat_ = CopyableIndirection<Expr<SomeInteger>>::Make(std::move(v));
stat_.emplace(std::move(v));
return *this;
}
CoarrayRef &CoarrayRef::set_team(Expr<SomeInteger> &&v, bool isTeamNumber) {
CHECK(IsVariable(v));
team_ = CopyableIndirection<Expr<SomeInteger>>::Make(std::move(v));
team_.emplace(std::move(v));
teamIsTeamNumber_ = isTeamNumber;
return *this;
}
@ -104,10 +107,10 @@ CoarrayRef &CoarrayRef::set_team(Expr<SomeInteger> &&v, bool isTeamNumber) {
void Substring::SetBounds(std::optional<Expr<SubscriptInteger>> &lower,
std::optional<Expr<SubscriptInteger>> &upper) {
if (lower.has_value()) {
lower_ = IndirectSubscriptIntegerExpr::Make(std::move(*lower));
lower_.emplace(std::move(*lower));
}
if (upper.has_value()) {
upper_ = IndirectSubscriptIntegerExpr::Make(std::move(*upper));
upper_.emplace(std::move(*upper));
}
}
@ -156,8 +159,12 @@ std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
std::optional<std::int64_t> length;
if (literal != nullptr) {
length = (*literal)->data().size();
} else {
// TODO pmk: get max character length from symbol
} else if (const Symbol * symbol{GetLastSymbol()}) {
if (const semantics::DeclTypeSpec * type{symbol->GetType()}) {
if (type->category() == semantics::DeclTypeSpec::Character) {
length = ToInt64(type->characterTypeSpec().length().GetExplicit());
}
}
}
if (*ubi < 1 || (lbi.has_value() && *ubi < *lbi)) {
// Zero-length string: canonicalize
@ -298,9 +305,7 @@ std::ostream &Component::AsFortran(std::ostream &o) const {
std::ostream &Triplet::AsFortran(std::ostream &o) const {
Emit(o, lower_) << ':';
Emit(o, upper_);
if (stride_) {
Emit(o << ':', stride_);
}
Emit(o << ':', *stride_);
return o;
}
@ -657,7 +662,7 @@ bool TypeParamInquiry<KIND>::operator==(
}
bool Triplet::operator==(const Triplet &that) const {
return lower_ == that.lower_ && upper_ == that.upper_ &&
stride_ == that.stride_;
*stride_ == *that.stride_;
}
bool ArrayRef::operator==(const ArrayRef &that) const {
return u == that.u && subscript == that.subscript;

10
flang/lib/evaluate/variable.h
View File

@ -21,6 +21,8 @@
// Fortran 2018 language standard (q.v.) and uses strong typing to ensure
// that only admissable combinations can be constructed.
// TODO pmk: convert remaining structs to classes
#include "call.h"
#include "common.h"
#include "static-data.h"
@ -120,19 +122,21 @@ EXPAND_FOR_EACH_INTEGER_KIND(
// R921 subscript-triplet
class Triplet {
public:
Triplet() {}
Triplet();
DEFAULT_CONSTRUCTORS_AND_ASSIGNMENTS(Triplet)
Triplet(std::optional<Expr<SubscriptInteger>> &&,
std::optional<Expr<SubscriptInteger>> &&,
std::optional<Expr<SubscriptInteger>> &&);
std::optional<Expr<SubscriptInteger>> lower() const;
std::optional<Expr<SubscriptInteger>> upper() const;
std::optional<Expr<SubscriptInteger>> stride() const;
const Expr<SubscriptInteger> &stride() const;
bool operator==(const Triplet &) const;
bool IsStrideOne() const;
std::ostream &AsFortran(std::ostream &) const;
private:
std::optional<IndirectSubscriptIntegerExpr> lower_, upper_, stride_;
std::optional<IndirectSubscriptIntegerExpr> lower_, upper_;
IndirectSubscriptIntegerExpr stride_;
};
// R919 subscript when rank 0, R923 vector-subscript when rank 1

6
flang/lib/parser/parse-tree.h
View File

@ -60,6 +60,7 @@ CLASS_TRAIT(TupleTrait)
// here.
namespace Fortran::semantics {
class Symbol;
class DeclTypeSpec;
}
// Expressions in the parse tree have owning pointers that can be set to
@ -700,6 +701,7 @@ struct DerivedTypeSpec {
// R702 type-spec -> intrinsic-type-spec | derived-type-spec
struct TypeSpec {
UNION_CLASS_BOILERPLATE(TypeSpec);
mutable const semantics::DeclTypeSpec *declTypeSpec{nullptr};
std::variant<IntrinsicTypeSpec, DerivedTypeSpec> u;
};
@ -1693,9 +1695,9 @@ struct Expr {
explicit Expr(Designator &&);
explicit Expr(FunctionReference &&);
// Filled in later during semantic analysis of the expression.
// TODO: May be temporary; remove if caching no longer required.
// Filled in after successful semantic analysis of the expression.
mutable common::OwningPointer<evaluate::GenericExprWrapper> typedExpr;
CharBlock source;
std::variant<common::Indirection<CharLiteralConstantSubstring>,

396
flang/lib/semantics/expression.cc
View File

@ -13,7 +13,6 @@
// limitations under the License.
#include "expression.h"
#include "dump-parse-tree.h" // TODO pmk temporary
#include "scope.h"
#include "semantics.h"
#include "symbol.h"
@ -27,7 +26,12 @@
#include <functional>
#include <optional>
#include <iostream> // TODO pmk rm
// TODO pmk remove when scaffolding is obsolete
#define PMKDEBUG 1
#if PMKDEBUG
#include "dump-parse-tree.h"
#include <iostream>
#endif
// Typedef for optional generic expressions (ubiquitous in this file)
using MaybeExpr =
@ -109,9 +113,50 @@ struct CallAndArguments {
ActualArguments arguments;
};
struct DynamicTypeWithLength : public DynamicType {
std::optional<Expr<SubscriptInteger>> length;
};
std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
ExpressionAnalysisContext &context,
const std::optional<parser::TypeSpec> &spec) {
if (spec.has_value()) {
if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) {
// Name resolution sets TypeSpec::declTypeSpec only when it's valid
// (viz., an intrinsic type with valid known kind or a non-polymorphic
// & non-ABSTRACT derived type).
if (const semantics::IntrinsicTypeSpec *
intrinsic{typeSpec->AsIntrinsic()}) {
TypeCategory category{intrinsic->category()};
if (auto kind{ToInt64(intrinsic->kind())}) {
DynamicTypeWithLength result{category, static_cast<int>(*kind)};
if (category == TypeCategory::Character) {
const semantics::CharacterTypeSpec &cts{
typeSpec->characterTypeSpec()};
const semantics::ParamValue len{cts.length()};
// N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() &
// type guards, but not in array constructors.
if (len.GetExplicit().has_value()) {
Expr<SomeInteger> copy{*len.GetExplicit()};
result.length = ConvertToType<SubscriptInteger>(std::move(copy));
}
}
return result;
}
} else if (const semantics::DerivedTypeSpec *
derived{typeSpec->AsDerived()}) {
return DynamicTypeWithLength{TypeCategory::Derived, 0, derived};
}
}
}
return std::nullopt;
}
// Forward declarations of additional AnalyzeExpr specializations and overloads
template<typename... As>
MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &, const std::variant<As...> &);
template<typename A>
MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &, const std::optional<A> &);
static MaybeExpr AnalyzeExpr(
ExpressionAnalysisContext &, const parser::Designator &);
static MaybeExpr AnalyzeExpr(
@ -217,12 +262,21 @@ MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, const A &x) {
// Definitions of AnalyzeExpr() specializations follow.
// Helper subroutines are intermixed.
// Variants are silently traversed by AnalyzeExpr().
// Variants and optionals are silently traversed by AnalyzeExpr().
template<typename... As>
MaybeExpr AnalyzeExpr(
ExpressionAnalysisContext &context, const std::variant<As...> &u) {
return std::visit([&](const auto &x) { return AnalyzeExpr(context, x); }, u);
}
template<typename A>
MaybeExpr AnalyzeExpr(
ExpressionAnalysisContext &context, const std::optional<A> &x) {
if (x.has_value()) {
return AnalyzeExpr(context, *x);
} else {
return std::nullopt;
}
}
// Wraps a object in an explicitly typed representation (e.g., Designator<>
// or FunctionRef<>) that has been instantiated on a dynamically chosen type.
@ -230,7 +284,7 @@ MaybeExpr AnalyzeExpr(
template<TypeCategory CATEGORY, template<typename> typename WRAPPER,
typename WRAPPED>
MaybeExpr WrapperHelper(int kind, WRAPPED &&x) {
return common::SearchDynamicTypes(
return common::SearchTypes(
TypeKindVisitor<CATEGORY, WRAPPER, WRAPPED>{kind, std::move(x)});
}
@ -269,8 +323,44 @@ static MaybeExpr Designate(DataRef &&dataRef) {
return std::nullopt;
}
// Catch and resolve the ambiguous parse of a substring reference
// that looks like a 1-D array element or section.
static MaybeExpr ResolveAmbiguousSubstring(
ExpressionAnalysisContext &context, ArrayRef &&ref) {
const Symbol &symbol{ref.GetLastSymbol()};
if (std::optional<DynamicType> dyType{GetSymbolType(&symbol)}) {
if (dyType->category == TypeCategory::Character &&
ref.subscript.size() == 1) {
DataRef base{std::visit(
[](auto &&y) { return DataRef{std::move(y)}; }, std::move(ref.u))};
std::optional<Expr<SubscriptInteger>> lower, upper;
if (std::visit(
common::visitors{
[&](IndirectSubscriptIntegerExpr &&x) {
lower = std::move(*x);
return true;
},
[&](Triplet &&triplet) {
lower = triplet.lower();
upper = triplet.upper();
return triplet.IsStrideOne();
},
},
std::move(ref.subscript[0].u))) {
return WrapperHelper<TypeCategory::Character, Designator, Substring>(
dyType->kind,
Substring{std::move(base), std::move(lower), std::move(upper)});
}
}
}
return std::nullopt;
}
// Some subscript semantic checks must be deferred until all of the
// subscripts are in hand.
// subscripts are in hand. This is also where we can catch the
// ambiguous parse of a substring reference that looks like a 1-D array
// element or section.
static MaybeExpr CompleteSubscripts(
ExpressionAnalysisContext &context, ArrayRef &&ref) {
const Symbol &symbol{ref.GetLastSymbol()};
@ -283,7 +373,11 @@ static MaybeExpr CompleteSubscripts(
}
int subscripts = ref.subscript.size();
if (subscripts != symbolRank) {
context.Say("reference to rank-%d object '%s' has %d subscripts"_err_en_US,
if (MaybeExpr substring{
ResolveAmbiguousSubstring(context, std::move(ref))}) {
return substring;
}
context.Say("Reference to rank-%d object '%s' has %d subscripts"_err_en_US,
symbolRank, symbol.name().ToString().data(), subscripts);
} else if (subscripts == 0) {
// nothing to check
@ -292,8 +386,8 @@ static MaybeExpr CompleteSubscripts(
if (baseRank > 0) {
int rank{ref.Rank()};
if (rank > 0) {
context.Say(
"subscripts of rank-%d component reference have rank %d, but must all be scalar"_err_en_US,
context.Say("Subscripts of rank-%d component reference have rank %d, "
"but must all be scalar"_err_en_US,
baseRank, rank);
}
}
@ -302,8 +396,8 @@ static MaybeExpr CompleteSubscripts(
// C928 & C1002
if (Triplet * last{std::get_if<Triplet>(&ref.subscript.back().u)}) {
if (!last->upper().has_value() && details->IsAssumedSize()) {
context.Say(
"assumed-size array '%s' must have explicit final subscript upper bound value"_err_en_US,
context.Say("Assumed-size array '%s' must have explicit final "
"subscript upper bound value"_err_en_US,
symbol.name().ToString().data());
}
}
@ -433,7 +527,7 @@ MaybeExpr IntLiteralConstant(
AnalyzeKindParam(context, std::get<std::optional<parser::KindParam>>(x.t),
context.GetDefaultKind(TypeCategory::Integer))};
auto value{std::get<0>(x.t)}; // std::(u)int64_t
auto result{common::SearchDynamicTypes(
auto result{common::SearchTypes(
TypeKindVisitor<TypeCategory::Integer, Constant, std::int64_t>{
kind, static_cast<std::int64_t>(value)})};
if (!result.has_value()) {
@ -468,15 +562,14 @@ Constant<TYPE> ReadRealLiteral(
struct RealTypeVisitor {
using Result = std::optional<Expr<SomeReal>>;
static constexpr std::size_t Types{std::tuple_size_v<RealTypes>};
using Types = RealTypes;
RealTypeVisitor(int k, parser::CharBlock lit, FoldingContext &ctx)
: kind{k}, literal{lit}, context{ctx} {}
template<std::size_t J> Result Test() {
using Ty = std::tuple_element_t<J, RealTypes>;
if (kind == Ty::kind) {
return {AsCategoryExpr(ReadRealLiteral<Ty>(literal, context))};
template<typename T> Result Test() {
if (kind == T::kind) {
return {AsCategoryExpr(ReadRealLiteral<T>(literal, context))};
}
return std::nullopt;
}
@ -520,7 +613,7 @@ static MaybeExpr AnalyzeExpr(
context.Say(
"explicit kind parameter on real constant disagrees with exponent letter"_en_US);
}
auto result{common::SearchDynamicTypes(
auto result{common::SearchTypes(
RealTypeVisitor{kind, x.real.source, context.GetFoldingContext()})};
if (!result.has_value()) {
context.Say("unsupported REAL(KIND=%d)"_err_en_US, kind);
@ -610,7 +703,7 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context,
AnalyzeKindParam(context, std::get<std::optional<parser::KindParam>>(x.t),
context.GetDefaultKind(TypeCategory::Logical))};
bool value{std::get<bool>(x.t)};
auto result{common::SearchDynamicTypes(
auto result{common::SearchTypes(
TypeKindVisitor<TypeCategory::Logical, Constant, bool>{
kind, std::move(value)})};
if (!result.has_value()) {
@ -645,19 +738,17 @@ static MaybeExpr AnalyzeExpr(
return {AsGenericExpr(std::move(value.value))};
}
// For use with SearchDynamicTypes to create a TypeParamInquiry with the
// For use with SearchTypes to create a TypeParamInquiry with the
// right integer kind.
struct TypeParamInquiryVisitor {
using Result = std::optional<Expr<SomeInteger>>;
static constexpr std::size_t Types{
std::tuple_size_v<CategoryTypes<TypeCategory::Integer>>};
using Types = IntegerTypes;
TypeParamInquiryVisitor(int k, SymbolOrComponent &&b, const Symbol &param)
: kind{k}, base{std::move(b)}, parameter{param} {}
template<std::size_t J> Result Test() {
using Ty = std::tuple_element_t<J, CategoryTypes<TypeCategory::Integer>>;
if (kind == Ty::kind) {
template<typename T> Result Test() {
if (kind == T::kind) {
return Expr<SomeInteger>{
Expr<Ty>{TypeParamInquiry<Ty::kind>{std::move(base), parameter}}};
Expr<T>{TypeParamInquiry<T::kind>{std::move(base), parameter}}};
}
return std::nullopt;
}
@ -670,7 +761,7 @@ static std::optional<Expr<SomeInteger>> MakeTypeParamInquiry(
const Symbol *symbol) {
if (std::optional<DynamicType> dyType{GetSymbolType(symbol)}) {
if (dyType->category == TypeCategory::Integer) {
return common::SearchDynamicTypes(TypeParamInquiryVisitor{
return common::SearchTypes(TypeParamInquiryVisitor{
dyType->kind, SymbolOrComponent{nullptr}, *symbol});
}
}
@ -680,7 +771,10 @@ static std::optional<Expr<SomeInteger>> MakeTypeParamInquiry(
// Names and named constants
static MaybeExpr AnalyzeExpr(
ExpressionAnalysisContext &context, const parser::Name &n) {
if (n.symbol == nullptr) {
if (std::optional<int> kind{context.IsAcImpliedDo(n.source)}) {
return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
*kind, AsExpr(ImpliedDoIndex{n.source})));
} else if (n.symbol == nullptr) {
context.Say(
n.source, "TODO INTERNAL: name was not resolved to a symbol"_err_en_US);
} else if (n.symbol->attrs().test(semantics::Attr::PARAMETER)) {
@ -944,7 +1038,7 @@ static MaybeExpr AnalyzeExpr(
CHECK(dyType.has_value());
CHECK(dyType->category == TypeCategory::Integer);
return AsMaybeExpr(
common::SearchDynamicTypes(TypeParamInquiryVisitor{dyType->kind,
common::SearchTypes(TypeParamInquiryVisitor{dyType->kind,
IgnoreAnySubscripts(std::move(*designator)), *sym}));
} else {
context.Say(name,
@ -1015,9 +1109,221 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context,
return std::nullopt;
}
static MaybeExpr AnalyzeExpr(
ExpressionAnalysisContext &context, const parser::ArrayConstructor &) {
context.Say("TODO: ArrayConstructor unimplemented"_en_US);
static int IntegerTypeSpecKind(
ExpressionAnalysisContext &context, const parser::IntegerTypeSpec &spec) {
Expr<SubscriptInteger> value{context.Analyze(TypeCategory::Integer, spec.v)};
if (auto kind{ToInt64(value)}) {
return static_cast<int>(*kind);
}
context.SayAt(spec, "Constant INTEGER kind value required here"_err_en_US);
return context.GetDefaultKind(TypeCategory::Integer);
}
template<int KIND, typename A>
std::optional<Expr<Type<TypeCategory::Integer, KIND>>> GetSpecificIntExpr(
ExpressionAnalysisContext &context, const A &x) {
if (MaybeExpr y{AnalyzeExpr(context, x)}) {
Expr<SomeInteger> *intExpr{UnwrapExpr<Expr<SomeInteger>>(*y)};
CHECK(intExpr != nullptr);
return ConvertToType<Type<TypeCategory::Integer, KIND>>(
std::move(*intExpr));
}
return std::nullopt;
}
// Array constructors
struct ArrayConstructorContext {
void Push(MaybeExpr &&);
void Add(const parser::AcValue &);
ExpressionAnalysisContext &exprContext;
std::optional<DynamicTypeWithLength> &type;
bool typesMustMatch{false};
ArrayConstructorValues<SomeType> values;
};
void ArrayConstructorContext::Push(MaybeExpr &&x) {
if (x.has_value()) {
DynamicTypeWithLength xType;
if (auto dyType{x->GetType()}) {
*static_cast<DynamicType *>(&xType) = *dyType;
}
if (Expr<SomeCharacter> * charExpr{UnwrapExpr<Expr<SomeCharacter>>(*x)}) {
CHECK(xType.category == TypeCategory::Character);
xType.length =
std::visit([](const auto &kc) { return kc.LEN(); }, charExpr->u);
}
if (!type.has_value()) {
// If there is no explicit type-spec in an array constructor, the type
// of the array is the declared type of all of the elements, which must
// be well-defined.
// TODO: Possible language extension: use the most general type of
// the values as the type of a numeric constructed array, convert all
// of the other values to that type. Alternative: let the first value
// determine the type, and convert the others to that type.
type = std::move(xType);
values.Push(std::move(*x));
} else if (typesMustMatch) {
if (static_cast<const DynamicType &>(*type) ==
static_cast<const DynamicType &>(xType)) {
values.Push(std::move(*x));
} else {
exprContext.Say(
"Values in array constructor must have the same declared type when no explicit type appears"_err_en_US);
}
} else {
if (auto cast{ConvertToType(*type, std::move(*x))}) {
values.Push(std::move(*cast));
} else {
exprContext.Say(
"Value in array constructor could not be converted to the type of the array"_err_en_US);
}
}
}
}
void ArrayConstructorContext::Add(const parser::AcValue &x) {
using IntType = ResultType<ImpliedDoIndex>;
std::visit(
common::visitors{
[&](const parser::AcValue::Triplet &triplet) {
// Transform l:u(:s) into (_,_=l,u(,s)) with an anonymous index '_'
std::optional<Expr<IntType>> lower{
GetSpecificIntExpr<IntType::kind>(
exprContext, std::get<0>(triplet.t))};
std::optional<Expr<IntType>> upper{
GetSpecificIntExpr<IntType::kind>(
exprContext, std::get<1>(triplet.t))};
std::optional<Expr<IntType>> stride{
GetSpecificIntExpr<IntType::kind>(
exprContext, std::get<2>(triplet.t))};
if (lower.has_value() && upper.has_value()) {
if (!stride.has_value()) {
stride = Expr<IntType>{1};
}
if (!type.has_value()) {
type = DynamicTypeWithLength{IntType::GetType()};
}
ArrayConstructorContext nested{exprContext, type, typesMustMatch};
parser::CharBlock name;
nested.Push(Expr<SomeType>{
Expr<SomeInteger>{Expr<IntType>{ImpliedDoIndex{name}}}});
values.Push(ImpliedDo<SomeType>{name, std::move(*lower),
std::move(*upper), std::move(*stride),
std::move(nested.values)});
}
},
[&](const common::Indirection<parser::Expr> &expr) {
if (MaybeExpr v{exprContext.Analyze(*expr)}) {
Push(std::move(*v));
}
},
[&](const common::Indirection<parser::AcImpliedDo> &impliedDo) {
const auto &control{
std::get<parser::AcImpliedDoControl>(impliedDo->t)};
const auto &bounds{
std::get<parser::LoopBounds<parser::ScalarIntExpr>>(control.t)};
parser::CharBlock name{bounds.name.thing.thing.source};
int kind{IntType::kind};
if (auto &its{std::get<std::optional<parser::IntegerTypeSpec>>(
control.t)}) {
kind = IntegerTypeSpecKind(exprContext, *its);
}
bool inserted{exprContext.AddAcImpliedDo(name, kind)};
if (!inserted) {
exprContext.SayAt(name,
"Implied DO index is active in surrounding implied DO loop and cannot have the same name"_err_en_US);
}
std::optional<Expr<IntType>> lower{
GetSpecificIntExpr<IntType::kind>(exprContext, bounds.lower)};
std::optional<Expr<IntType>> upper{
GetSpecificIntExpr<IntType::kind>(exprContext, bounds.upper)};
std::optional<Expr<IntType>> stride{
GetSpecificIntExpr<IntType::kind>(exprContext, bounds.step)};
ArrayConstructorContext nested{exprContext, type, typesMustMatch};
for (const auto &value :
std::get<std::list<parser::AcValue>>(impliedDo->t)) {
nested.Add(value);
}
if (lower.has_value() && upper.has_value()) {
if (!stride.has_value()) {
stride = Expr<IntType>{1};
}
values.Push(ImpliedDo<SomeType>{name, std::move(*lower),
std::move(*upper), std::move(*stride),
std::move(nested.values)});
}
if (inserted) {
exprContext.RemoveAcImpliedDo(name);
}
},
},
x.u);
}
// Inverts a collection of generic ArrayConstructorValues<SomeType> that
// all happen to have or be convertible to the same actual type T into
// one ArrayConstructor<T>.
template<typename T>
ArrayConstructorValues<T> MakeSpecific(
ArrayConstructorValues<SomeType> &&from) {
ArrayConstructorValues<T> to;
for (ArrayConstructorValue<SomeType> &x : from.values) {
std::visit(
common::visitors{
[&](CopyableIndirection<Expr<SomeType>> &&expr) {
auto *typed{UnwrapExpr<Expr<T>>(*expr)};
CHECK(typed != nullptr);
to.Push(std::move(*typed));
},
[&](ImpliedDo<SomeType> &&impliedDo) {
to.Push(ImpliedDo<T>{impliedDo.controlVariableName,
std::move(*impliedDo.lower), std::move(*impliedDo.upper),
std::move(*impliedDo.stride),
MakeSpecific<T>(std::move(*impliedDo.values))});
},
},
std::move(x.u));
}
return to;
}
struct ArrayConstructorTypeVisitor {
using Result = MaybeExpr;
using Types = LengthlessIntrinsicTypes;
template<typename T> Result Test() {
if (type.category == T::category && type.kind == T::kind) {
if constexpr (T::category == TypeCategory::Character) {
CHECK(type.length.has_value());
return AsMaybeExpr(ArrayConstructor<T>{
MakeSpecific<T>(std::move(values)), std::move(*type.length)});
} else {
return AsMaybeExpr(
ArrayConstructor<T>{T{}, MakeSpecific<T>(std::move(values))});
}
} else {
return std::nullopt;
}
}
DynamicTypeWithLength type;
ArrayConstructorValues<SomeType> values;
};
static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &exprContext,
const parser::ArrayConstructor &array) {
const parser::AcSpec &acSpec{array.v};
std::optional<DynamicTypeWithLength> type{
AnalyzeTypeSpec(exprContext, acSpec.type)};
bool typesMustMatch{!type.has_value()};
ArrayConstructorContext context{exprContext, type, typesMustMatch};
for (const parser::AcValue &value : acSpec.values) {
context.Add(value);
}
if (type.has_value()) {
ArrayConstructorTypeVisitor visitor{
std::move(*type), std::move(context.values)};
return common::SearchTypes(std::move(visitor));
}
return std::nullopt;
}
@ -1502,6 +1808,28 @@ DynamicType ExpressionAnalysisContext::GetDefaultKindOfType(
common::TypeCategory category) {
return {category, GetDefaultKind(category)};
}
bool ExpressionAnalysisContext::AddAcImpliedDo(
parser::CharBlock name, int kind) {
return acImpliedDos_.insert(std::make_pair(name, kind)).second;
}
void ExpressionAnalysisContext::RemoveAcImpliedDo(parser::CharBlock name) {
auto iter{acImpliedDos_.find(name)};
if (iter != acImpliedDos_.end()) {
acImpliedDos_.erase(iter);
}
}
std::optional<int> ExpressionAnalysisContext::IsAcImpliedDo(
parser::CharBlock name) const {
auto iter{acImpliedDos_.find(name)};
if (iter != acImpliedDos_.cend()) {
return {iter->second};
} else {
return std::nullopt;
}
}
}
namespace Fortran::semantics {
@ -1517,12 +1845,16 @@ public:
bool Pre(const parser::Expr &expr) {
if (expr.typedExpr.get() == nullptr) {
if (MaybeExpr checked{AnalyzeExpr(context_, expr)}) {
// checked->AsFortran(std::cout << "pmk: checked expression: ") << '\n';
#if PMKDEBUG
// checked->AsFortran(std::cout << "checked expression: ") << '\n';
#endif
expr.typedExpr.reset(
new evaluate::GenericExprWrapper{std::move(*checked)});
} else {
#if PMKDEBUG
std::cout << "TODO: expression analysis failed for this expression: ";
DumpTree(std::cout, expr);
#endif
}
}
return false;

8
flang/lib/semantics/expression.h
View File

@ -21,8 +21,10 @@
#include "../evaluate/expression.h"
#include "../evaluate/tools.h"
#include "../evaluate/type.h"
#include "../parser/char-block.h"
#include "../parser/parse-tree-visitor.h"
#include "../parser/parse-tree.h"
#include <map>
#include <optional>
#include <variant>
@ -98,8 +100,14 @@ public:
int GetDefaultKind(common::TypeCategory);
DynamicType GetDefaultKindOfType(common::TypeCategory);
// Manage a set of active array constructor implied DO loops.
bool AddAcImpliedDo(parser::CharBlock, int);
void RemoveAcImpliedDo(parser::CharBlock);
std::optional<int> IsAcImpliedDo(parser::CharBlock) const;
private:
semantics::SemanticsContext &context_;
std::map<parser::CharBlock, int> acImpliedDos_; // values are INTEGER kinds
};
template<typename PARSED>

122
flang/lib/semantics/resolve-names.cc
View File

@ -267,7 +267,7 @@ public:
void Post(const parser::DeclarationTypeSpec::TypeStar &);
bool Pre(const parser::TypeGuardStmt &);
void Post(const parser::TypeGuardStmt &);
bool Pre(const parser::AcSpec &);
void Post(const parser::TypeSpec &);
protected:
struct State {
@ -687,10 +687,14 @@ public:
protected:
bool BeginDecl();
void EndDecl();
// Declare a construct or statement entity. If there isn't a type specified
// Declare a construct entity. If there isn't a type specified
// it comes from the entity in the containing scope, or implicit rules.
// Return pointer to the new symbol, or nullptr on error.
Symbol *DeclareConstructEntity(const parser::Name &);
// Declare a statement entity (e.g., an implied DO loop index).
// If there isn't a type specified, implicit rules apply.
// Return pointer to the new symbol, or nullptr on error.
Symbol *DeclareStatementEntity(const parser::Name &);
bool CheckUseError(const parser::Name &);
void CheckAccessibility(const parser::Name &, bool, const Symbol &);
@ -774,9 +778,11 @@ public:
bool Pre(const parser::LocalitySpec::Local &);
bool Pre(const parser::LocalitySpec::LocalInit &);
bool Pre(const parser::LocalitySpec::Shared &);
bool Pre(const parser::AcSpec &);
bool Pre(const parser::AcImpliedDo &);
bool Pre(const parser::DataImpliedDo &);
bool Pre(const parser::DataStmt &);
void Post(const parser::DataStmt &);
bool Pre(const parser::DataStmtSet &);
void Post(const parser::DataStmtSet &);
bool Pre(const parser::DoConstruct &);
void Post(const parser::DoConstruct &);
void Post(const parser::ConcurrentControl &);
@ -846,7 +852,7 @@ private:
}
bool CheckDef(const std::optional<parser::Name> &);
void CheckRef(const std::optional<parser::Name> &);
void CheckIntegerType(const Symbol &);
void CheckScalarIntegerType(const Symbol &);
const DeclTypeSpec &ToDeclTypeSpec(evaluate::DynamicType &&);
const DeclTypeSpec &ToDeclTypeSpec(
evaluate::DynamicType &&, SubscriptIntExpr &&length);
@ -1150,15 +1156,27 @@ void DeclTypeSpecVisitor::Post(const parser::TypeGuardStmt &) {
EndDeclTypeSpec();
}
bool DeclTypeSpecVisitor::Pre(const parser::AcSpec &x) {
// AcSpec can occur within a TypeDeclarationStmt: save and restore state
auto savedState{SetDeclTypeSpecState({})};
BeginDeclTypeSpec();
Walk(x.type);
Walk(x.values);
EndDeclTypeSpec();
SetDeclTypeSpecState(savedState);
return false;
void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
// Record the resolved DeclTypeSpec in the parse tree for use by
// expression semantics if the DeclTypeSpec is a valid TypeSpec.
// The grammar ensures that it's an intrinsic or derived type spec,
// not TYPE(*) or CLASS(*) or CLASS(T).
if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
switch (spec->category()) {
case DeclTypeSpec::Numeric:
case DeclTypeSpec::Logical:
case DeclTypeSpec::Character: typeSpec.declTypeSpec = spec; break;
case DeclTypeSpec::TypeDerived:
if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
if (derived->typeSymbol().attrs().test(Attr::ABSTRACT)) {
Say("ABSTRACT derived type may not be used here"_err_en_US);
}
typeSpec.declTypeSpec = spec;
}
break;
default: CRASH_NO_CASE;
}
}
}
void DeclTypeSpecVisitor::Post(
@ -2985,6 +3003,26 @@ Symbol *DeclarationVisitor::DeclareConstructEntity(const parser::Name &name) {
return &symbol;
}
Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name) {
if (auto *prev{FindSymbol(name)}) {
if (prev->owner() == currScope()) {
SayAlreadyDeclared(name, *prev);
return nullptr;
}
name.symbol = nullptr;
}
Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
if (symbol.has<ObjectEntityDetails>()) {
if (auto *type{GetDeclTypeSpec()}) {
SetType(name, *type);
} else {
ApplyImplicitRules(symbol);
}
return Resolve(name, &symbol);
}
return nullptr;
}
// Set the type of an entity or report an error.
void DeclarationVisitor::SetType(
const parser::Name &name, const DeclTypeSpec &type) {
@ -3173,6 +3211,39 @@ bool ConstructVisitor::Pre(const parser::LocalitySpec::Shared &x) {
return false;
}
bool ConstructVisitor::Pre(const parser::AcSpec &x) {
// AcSpec can occur within a TypeDeclarationStmt: save and restore state
auto savedState{SetDeclTypeSpecState({})};
BeginDeclTypeSpec();
Walk(x.type);
EndDeclTypeSpec();
SetDeclTypeSpecState(savedState);
PushScope(Scope::Kind::ImpliedDos, nullptr);
Walk(x.values);
PopScope();
return false;
}
bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
auto &values{std::get<std::list<parser::AcValue>>(x.t)};
auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
auto &bounds{std::get<parser::LoopBounds<parser::ScalarIntExpr>>(control.t)};
if (type) {
BeginDeclTypeSpec();
DeclarationVisitor::Post(*type);
}
if (auto *symbol{DeclareStatementEntity(bounds.name.thing.thing)}) {
CheckScalarIntegerType(*symbol);
}
if (type) {
EndDeclTypeSpec();
}
Walk(bounds);
Walk(values);
return false;
}
bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
auto &objects{std::get<std::list<parser::DataIDoObject>>(x.t)};
auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(x.t)};
@ -3182,8 +3253,8 @@ bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
BeginDeclTypeSpec();
DeclarationVisitor::Post(*type);
}
if (auto *symbol{DeclareConstructEntity(bounds.name.thing.thing)}) {
CheckIntegerType(*symbol);
if (auto *symbol{DeclareStatementEntity(bounds.name.thing.thing)}) {
CheckScalarIntegerType(*symbol);
}
if (type) {
EndDeclTypeSpec();
@ -3193,11 +3264,11 @@ bool ConstructVisitor::Pre(const parser::DataImpliedDo &x) {
return false;
}
bool ConstructVisitor::Pre(const parser::DataStmt &) {
PushScope(Scope::Kind::Block, nullptr);
bool ConstructVisitor::Pre(const parser::DataStmtSet &) {
PushScope(Scope::Kind::ImpliedDos, nullptr);
return true;
}
void ConstructVisitor::Post(const parser::DataStmt &) { PopScope(); }
void ConstructVisitor::Post(const parser::DataStmtSet &) { PopScope(); }
bool ConstructVisitor::Pre(const parser::DoConstruct &x) {
if (x.IsDoConcurrent()) {
@ -3214,7 +3285,7 @@ void ConstructVisitor::Post(const parser::DoConstruct &x) {
void ConstructVisitor::Post(const parser::ConcurrentControl &x) {
auto &name{std::get<parser::Name>(x.t)};
if (auto *symbol{DeclareConstructEntity(name)}) {
CheckIntegerType(*symbol);
CheckScalarIntegerType(*symbol);
}
}
@ -3334,10 +3405,17 @@ void ConstructVisitor::CheckRef(const std::optional<parser::Name> &x) {
}
}
void ConstructVisitor::CheckIntegerType(const Symbol &symbol) {
void ConstructVisitor::CheckScalarIntegerType(const Symbol &symbol) {
if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
if (details->IsArray()) {
Say(symbol.name(), "Variable '%s' is not scalar"_err_en_US);
return;
}
}
if (auto *type{symbol.GetType()}) {
if (!type->IsNumeric(TypeCategory::Integer)) {
Say(symbol.name(), "Variable '%s' is not scalar integer"_err_en_US);
Say(symbol.name(), "Variable '%s' is not integer"_err_en_US);
return;
}
}
}

2
flang/lib/semantics/scope.h
View File

@ -38,7 +38,7 @@ class Scope {
public:
ENUM_CLASS(Kind, System, Global, Module, MainProgram, Subprogram, DerivedType,
Block, Forall)
Block, Forall, ImpliedDos)
using ImportKind = common::ImportKind;
// Create the Global scope -- the root of the scope tree

9
flang/lib/semantics/semantics.cc
View File

@ -71,9 +71,6 @@ bool Semantics::Perform() {
if (AnyFatalError()) {
return false;
}
if (AnyFatalError()) {
return false;
}
CheckDoConcurrentConstraints(context_.messages(), program_);
if (AnyFatalError()) {
return false;
@ -83,10 +80,8 @@ bool Semantics::Perform() {
if (AnyFatalError()) {
return false;
}
if (context_.debugExpressions()) {
AnalyzeExpressions(program_, context_);
AnalyzeAssignments(program_, context_);
}
AnalyzeExpressions(program_, context_);
AnalyzeAssignments(program_, context_);
return !AnyFatalError();
}

6
flang/lib/semantics/semantics.h
View File

@ -46,7 +46,6 @@ public:
}
const std::string &moduleDirectory() const { return moduleDirectory_; }
const bool warningsAreErrors() const { return warningsAreErrors_; }
const bool debugExpressions() const { return debugExpressions_; }
const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }
Scope &globalScope() { return globalScope_; }
parser::Messages &messages() { return messages_; }
@ -64,10 +63,6 @@ public:
warningsAreErrors_ = x;
return *this;
}
SemanticsContext &set_debugExpressions(bool x) {
debugExpressions_ = x;
return *this;
}
const DeclTypeSpec &MakeNumericType(TypeCategory, int kind = 0);
const DeclTypeSpec &MakeLogicalType(int kind = 0);
@ -82,7 +77,6 @@ private:
std::vector<std::string> searchDirectories_;
std::string moduleDirectory_{"."s};
bool warningsAreErrors_{false};
bool debugExpressions_{false};
const evaluate::IntrinsicProcTable intrinsics_;
Scope globalScope_;
parser::Messages messages_;

4
flang/lib/semantics/type.cc
View File

@ -276,10 +276,6 @@ const LogicalTypeSpec &DeclTypeSpec::logicalTypeSpec() const {
CHECK(category_ == Logical);
return std::get<LogicalTypeSpec>(typeSpec_);
}
const CharacterTypeSpec &DeclTypeSpec::characterTypeSpec() const {
CHECK(category_ == Character);
return std::get<CharacterTypeSpec>(typeSpec_);
}
const DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() const {
CHECK(category_ == TypeDerived || category_ == ClassDerived);
return std::get<DerivedTypeSpec>(typeSpec_);

7
flang/lib/semantics/type.h
View File

@ -149,7 +149,7 @@ public:
CharacterTypeSpec(ParamValue &&length, KindExpr &&kind)
: IntrinsicTypeSpec(TypeCategory::Character, std::move(kind)),
length_{std::move(length)} {}
const ParamValue length() const { return length_; }
const ParamValue &length() const { return length_; }
private:
ParamValue length_;
@ -280,7 +280,10 @@ public:
bool IsNumeric(TypeCategory) const;
const NumericTypeSpec &numericTypeSpec() const;
const LogicalTypeSpec &logicalTypeSpec() const;
const CharacterTypeSpec &characterTypeSpec() const;
const CharacterTypeSpec &characterTypeSpec() const {
CHECK(category_ == Character);
return std::get<CharacterTypeSpec>(typeSpec_);
}
const DerivedTypeSpec &derivedTypeSpec() const;
DerivedTypeSpec &derivedTypeSpec();

13
flang/test/semantics/resolve30.f90
View File

@ -28,16 +28,3 @@ subroutine s2
y = 1
end block
end
subroutine s3
integer j
block
import, only: j
type t
!ERROR: 'i' from host scoping unit is not accessible due to IMPORT
real :: x(10) = [(i, &
!ERROR: 'i' from host scoping unit is not accessible due to IMPORT
i=1,10)]
end type
end block
end subroutine

11
flang/test/semantics/resolve35.f90
View File

@ -45,14 +45,19 @@ end
subroutine s4
real :: a(10), b(10)
complex :: x
!ERROR: Variable 'x' is not scalar integer
integer :: i(2)
!ERROR: Variable 'x' is not integer
forall(x=1:10)
a(x) = b(x)
end forall
!ERROR: Variable 'y' is not scalar integer
!ERROR: Variable 'y' is not integer
forall(y=1:10)
a(y) = b(y)
end forall
!ERROR: Variable 'i' is not scalar
forall(i=1:10)
a(i) = b(i)
end forall
end
subroutine s5
@ -68,7 +73,7 @@ subroutine s6
real, dimension(n) :: x
data(x(i), i=1, n) / n * 0.0 /
!ERROR: Index name 't' conflicts with existing identifier
data(x(t), t=1, n) / n * 0.0 /
forall(t=1:n) x(t) = 0.0
contains
subroutine t
end

8
flang/tools/f18/f18.cc
View File

@ -92,7 +92,6 @@ struct DriverOptions {
bool dumpUnparseWithSymbols{false};
bool dumpParseTree{false};
bool dumpSymbols{false};
bool debugExpressions{false};
bool debugResolveNames{false};
bool debugSemantics{false};
bool measureTree{false};
@ -213,7 +212,7 @@ std::string CompileFortran(std::string path, Fortran::parser::Options options,
}
// TODO: Change this predicate to just "if (!driver.debugNoSemantics)"
if (driver.debugSemantics || driver.debugResolveNames || driver.dumpSymbols ||
driver.dumpUnparseWithSymbols || driver.debugExpressions) {
driver.dumpUnparseWithSymbols) {
Fortran::semantics::Semantics semantics{
semanticsContext, parseTree, parsing.cooked()};
semantics.Perform();
@ -392,8 +391,6 @@ int main(int argc, char *const argv[]) {
driver.dumpParseTree = true;
} else if (arg == "-fdebug-dump-symbols") {
driver.dumpSymbols = true;
} else if (arg == "-fdebug-expressions") {
driver.debugExpressions = true;
} else if (arg == "-fdebug-resolve-names") {
driver.debugResolveNames = true;
} else if (arg == "-fdebug-measure-parse-tree") {
@ -494,8 +491,7 @@ int main(int argc, char *const argv[]) {
Fortran::semantics::SemanticsContext semanticsContext{defaultKinds};
semanticsContext.set_moduleDirectory(driver.moduleDirectory)
.set_searchDirectories(driver.searchDirectories)
.set_warningsAreErrors(driver.warningsAreErrors)
.set_debugExpressions(driver.debugExpressions);
.set_warningsAreErrors(driver.warningsAreErrors);
if (!anyFiles) {
driver.measureTree = true;