std::ostream &Convert<TO, FROMCAT>::AsFortran(std::ostream &o) const {
static_assert(TO::category == TypeCategory::Integer ||
TO::category == TypeCategory::Real ||
+ TO::category == TypeCategory::Character ||
TO::category == TypeCategory::Logical || !"Convert<> to bad category!");
- if constexpr (TO::category == TypeCategory::Integer) {
- o << "int";
+ if constexpr (TO::category == TypeCategory::Character) {
+ this->left().AsFortran(o << "achar(iachar(") << ')';
+ } else if constexpr (TO::category == TypeCategory::Integer) {
+ this->left().AsFortran(o << "int(");
} else if constexpr (TO::category == TypeCategory::Real) {
- o << "real";
- } else if constexpr (TO::category == TypeCategory::Logical) {
- o << "logical";
+ this->left().AsFortran(o << "real(");
+ } else {
+ this->left().AsFortran(o << "logical(");
}
- return this->left().AsFortran(o << '(') << ",kind=" << TO::kind << ')';
+ return o << ",kind=" << TO::kind << ')';
}
template<typename A> std::ostream &Relational<A>::Infix(std::ostream &o) const {
},
[](const ArrayConstructor<Result> &a) { return a.LEN(); },
[](const Parentheses<Result> &x) { return x.left().LEN(); },
+ [](const Convert<Result> &x) {
+ return std::visit(
+ [&](const auto &kx) { return kx.LEN(); }, x.left().u);
+ },
[](const Concat<KIND> &c) {
return c.left().LEN() + c.right().LEN();
},
// Conversions to specific types from expressions of known category and
// dynamic kind.
-template<typename TO, TypeCategory FROMCAT>
+template<typename TO, TypeCategory FROMCAT = TO::category>
struct Convert : public Operation<Convert<TO, FROMCAT>, TO, SomeKind<FROMCAT>> {
// 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.
TO::category == TypeCategory::Real) &&
(FROMCAT == TypeCategory::Integer ||
FROMCAT == TypeCategory::Real)) ||
+ (TO::category == TypeCategory::Character &&
+ FROMCAT == TypeCategory::Character) ||
(TO::category == TypeCategory::Logical &&
FROMCAT == TypeCategory::Logical));
using Result = TO;
Expr<SubscriptInteger> LEN() const;
std::variant<Constant<Result>, ArrayConstructor<Result>, Designator<Result>,
- FunctionRef<Result>, Parentheses<Result>, Concat<KIND>, Extremum<Result>>
+ FunctionRef<Result>, Parentheses<Result>, Convert<Result>, Concat<KIND>,
+ Extremum<Result>>
u;
};
explicit Expr(bool x) : u{Constant<Result>{x}} {}
private:
- using Operations = std::tuple<Convert<Result, TypeCategory::Logical>,
- Parentheses<Result>, Not<KIND>, LogicalOperation<KIND>>;
+ using Operations = std::tuple<Convert<Result>, Parentheses<Result>, Not<KIND>,
+ LogicalOperation<KIND>>;
using Relations = std::conditional_t<KIND == LogicalResult::kind,
std::tuple<Relational<SomeType>>, std::tuple<>>;
using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
// Unary operations
+template<typename TO, typename FROM> std::optional<TO> ConvertString(FROM &&s) {
+ if constexpr (std::is_same_v<TO, FROM>) {
+ return std::make_optional<TO>(std::move(s));
+ } else {
+ // Fortran character conversion is well defined between distinct kinds
+ // only when the actual characters are valid 7-bit ASCII.
+ TO str;
+ for (auto iter{s.cbegin()}; iter != s.cend(); ++iter) {
+ if (static_cast<std::uint64_t>(*iter) > 127) {
+ return std::nullopt;
+ }
+ str.push_back(*iter);
+ }
+ return std::make_optional<TO>(std::move(str));
+ }
+}
+
template<typename TO, TypeCategory FROMCAT>
Expr<TO> FoldOperation(
FoldingContext &context, Convert<TO, FROMCAT> &&convert) {
"INTEGER(%d) to INTEGER(%d) conversion overflowed"_en_US,
Operand::kind, TO::kind);
}
- return Expr<TO>{Constant<TO>{std::move(converted.value)}};
+ return ScalarConstantToExpr(std::move(converted.value));
} else if constexpr (Operand::category == TypeCategory::Real) {
auto converted{value->template ToInteger<Scalar<TO>>()};
if (converted.flags.test(RealFlag::InvalidArgument)) {
"REAL(%d) to INTEGER(%d) conversion overflowed"_en_US,
Operand::kind, TO::kind);
}
- return Expr<TO>{Constant<TO>{std::move(converted.value)}};
+ return ScalarConstantToExpr(std::move(converted.value));
}
} else if constexpr (TO::category == TypeCategory::Real) {
if constexpr (Operand::category == TypeCategory::Integer) {
TO::kind);
RealFlagWarnings(context, converted.flags, buffer);
}
- return Expr<TO>{Constant<TO>{std::move(converted.value)}};
+ return ScalarConstantToExpr(std::move(converted.value));
} else if constexpr (Operand::category == TypeCategory::Real) {
auto converted{Scalar<TO>::Convert(*value)};
if (!converted.flags.empty()) {
if (context.flushSubnormalsToZero()) {
converted.value = converted.value.FlushSubnormalToZero();
}
- return Expr<TO>{Constant<TO>{std::move(converted.value)}};
+ return ScalarConstantToExpr(std::move(converted.value));
+ }
+ } else if constexpr (TO::category == TypeCategory::Character &&
+ Operand::category == TypeCategory::Character) {
+ if (auto converted{ConvertString<Scalar<TO>>(std::move(*value))}) {
+ return ScalarConstantToExpr(std::move(*converted));
}
} else if constexpr (TO::category == TypeCategory::Logical &&
Operand::category == TypeCategory::Logical) {
- return Expr<TO>{Constant<TO>{value->IsTrue()}};
+ return Expr<TO>{value->IsTrue()};
}
}
return Expr<TO>{std::move(convert)};
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);
- }
+ if (auto *cx{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
+ return Expr<SomeType>{
+ ConvertToKind<TypeCategory::Character>(type.kind, std::move(*cx))};
}
break;
case TypeCategory::Logical:
break;
case TypeCategory::Derived:
if (auto fromType{x.GetType()}) {
- if (type == fromType) {
+ if (type == *fromType) {
return std::move(x);
}
}
}
std::optional<Expr<SomeType>> ConvertToType(
+ const semantics::Symbol &symbol, Expr<SomeType> &&x) {
+ if (int xRank{x.Rank()}; xRank > 0) {
+ if (symbol.Rank() != xRank) {
+ return std::nullopt;
+ }
+ }
+ if (auto symType{GetSymbolType(symbol)}) {
+ // TODO pmk CHARACTER length
+ return ConvertToType(*symType, std::move(x));
+ }
+ 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));
const DynamicType &, Expr<SomeType> &&);
std::optional<Expr<SomeType>> ConvertToType(
const DynamicType &, std::optional<Expr<SomeType>> &&);
+std::optional<Expr<SomeType>> ConvertToType(
+ const semantics::Symbol &, Expr<SomeType> &&);
// Conversions to the type of another expression
template<TypeCategory TC, int TK, typename FROM>
using Ty = TypeOf<A>;
static_assert(
std::is_same_v<Scalar<Ty>, std::decay_t<A>> || !"TypeOf<> is broken");
- return {Constant<Ty>{x}};
+ return Expr<TypeOf<A>>{Constant<Ty>{x}};
}
// Combine two expressions of the same specific numeric type with an operation
namespace Fortran::evaluate {
+template<typename A> bool PointeeComparison(const A *x, const A *y) {
+ return x == y || (x != nullptr && y != nullptr && *x == *y);
+}
+
bool DynamicType::operator==(const DynamicType &that) const {
return category == that.category && kind == that.kind &&
- charLength == that.charLength && derived == that.derived;
+ PointeeComparison(charLength, that.charLength) &&
+ PointeeComparison(derived, that.derived);
}
std::optional<DynamicType> GetSymbolType(const semantics::Symbol *symbol) {
return std::nullopt;
}
+std::optional<DynamicType> GetSymbolType(const semantics::Symbol *symbol) {
+ if (symbol != nullptr) {
+ return GetSymbolType(*symbol);
+ } else {
+ return std::nullopt;
+ }
+}
+
std::string DynamicType::AsFortran() const {
if (derived != nullptr) {
CHECK(category == TypeCategory::Derived);
bool SomeKind<TypeCategory::Derived>::operator==(
const SomeKind<TypeCategory::Derived> &that) const {
- return spec_ == that.spec_;
+ return PointeeComparison(spec_, that.spec_);
}
std::string SomeDerived::AsFortran() const {
// 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 &);
std::optional<DynamicType> GetSymbolType(const semantics::Symbol *);
template<TypeCategory CATEGORY, int KIND = 0> struct TypeBase {
template<typename T> std::optional<DynamicType> Designator<T>::GetType() const {
if constexpr (IsLengthlessIntrinsicType<Result>) {
return {Result::GetType()};
- } else if (const Symbol * symbol{GetLastSymbol()}) {
- return GetSymbolType(symbol);
} else {
- return std::nullopt;
+ return GetSymbolType(GetLastSymbol());
}
}
}
// Wraps a data reference in a typed Designator<>.
-static MaybeExpr Designate(DataRef &&dataRef) {
- const Symbol &symbol{dataRef.GetLastSymbol()};
- if (std::optional<DynamicType> dyType{GetSymbolType(&symbol)}) {
+static MaybeExpr Designate(DataRef &&ref) {
+ if (std::optional<DynamicType> dyType{GetSymbolType(ref.GetLastSymbol())}) {
return TypedWrapper<Designator, DataRef>(
- std::move(*dyType), std::move(dataRef));
+ std::move(*dyType), std::move(ref));
}
// TODO: graceful errors on CLASS(*) and TYPE(*) misusage
return std::nullopt;
// 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 (std::optional<DynamicType> dyType{GetSymbolType(ref.GetLastSymbol())}) {
if (dyType->category == TypeCategory::Character && ref.size() == 1) {
DataRef base{std::visit([](auto &&y) { return DataRef{std::move(y)}; },
std::move(ref.base()))};
std::optional<Expr<SubscriptInteger>> last{
GetSubstringBound(context, std::get<1>(range.t))};
const Symbol &symbol{checked->GetLastSymbol()};
- if (std::optional<DynamicType> dynamicType{GetSymbolType(&symbol)}) {
+ if (std::optional<DynamicType> dynamicType{GetSymbolType(symbol)}) {
if (dynamicType->category == TypeCategory::Character) {
return WrapperHelper<TypeCategory::Character, Designator,
Substring>(dynamicType->kind,
}
if (sym->detailsIf<semantics::TypeParamDetails>()) {
if (auto *designator{UnwrapExpr<Designator<SomeDerived>>(*dtExpr)}) {
- if (std::optional<DynamicType> dyType{GetSymbolType(sym)}) {
+ if (std::optional<DynamicType> dyType{GetSymbolType(*sym)}) {
if (dyType->category == TypeCategory::Integer) {
return AsMaybeExpr(
common::SearchTypes(TypeParamInquiryVisitor{dyType->kind,
if (symbol != nullptr) {
if (symbol->has<semantics::TypeParamDetails>()) {
context.Say(source,
- "Type parameter '%s' cannot be a component of this structure constructor"_err_en_US,
+ "Type parameter '%s' cannot be a component of this structure "
+ "constructor"_err_en_US,
symbol->name().ToString().data());
- } else if (checkConflicts) {
+ continue;
+ }
+ if (checkConflicts) {
auto componentIter{
std::find(components.begin(), components.end(), symbol)};
if (unavailable.find(symbol->name()) != unavailable.cend()) {
// C797, C798
context.Say(source,
- "Component '%s' conflicts with another component earlier in this structure constructor"_err_en_US,
+ "Component '%s' conflicts with another component earlier in "
+ "this structure constructor"_err_en_US,
symbol->name().ToString().data());
} else if (symbol->test(Symbol::Flag::ParentComp)) {
// Make earlier components unavailable once a whole parent appears.
if (MaybeExpr value{AnalyzeExpr(context, expr)}) {
// TODO pmk: C7104, C7105 check that pointer components are
// being initialized with data/procedure designators appropriately
- result.Add(*symbol, std::move(*value));
+ if (MaybeExpr converted{ConvertToType(*symbol, std::move(*value))}) {
+ result.Add(*symbol, std::move(*converted));
+ } else {
+ if (auto *msg{context.Say(expr.source,
+ "Structure constructor value is incompatible with component"_err_en_US)}) {
+ msg->Attach(symbol->name(), "Component declaration"_en_US);
+ }
+ }
}
}
}
result.Add(*symbol, common::Clone(*details->init()));
} else { // C799
if (auto *msg{context.Say(typeName,
- "Structure constructor lacks a value for component '%s'"_err_en_US,
+ "Structure constructor lacks a value for "
+ "component '%s'"_err_en_US,
symbol->name().ToString().data())}) {
msg->Attach(symbol->name(), "Absent component"_en_US);
}
bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) {
auto &parsedType{std::get<parser::DerivedTypeSpec>(x.t)};
const DeclTypeSpec *type{ProcessTypeSpec(parsedType)};
+
if (type == nullptr) {
return false;
}
return MakeDerivedType(std::move(spec), category);
}
-const DeclTypeSpec &Scope::MakeDerivedType(DeclTypeSpec::Category category,
- DerivedTypeSpec &&instance, SemanticsContext &semanticsContext) {
- DeclTypeSpec &type{declTypeSpecs_.emplace_back(
- category, DerivedTypeSpec{std::move(instance)})};
- type.derivedTypeSpec().Instantiate(*this, semanticsContext);
- return type;
-}
-
DeclTypeSpec &Scope::MakeDerivedType(const Symbol &typeSymbol) {
CHECK(typeSymbol.has<DerivedTypeDetails>());
CHECK(typeSymbol.scope() != nullptr);
if (typeIter != declTypeSpecs_.end()) {
return &*typeIter;
}
- return nullptr;
+ if (&parent_ == this) {
+ return nullptr;
+ }
+ return parent_.FindInstantiatedDerivedType(spec, category);
}
const DeclTypeSpec &Scope::FindOrInstantiateDerivedType(DerivedTypeSpec &&spec,
ParamValue &&length, KindExpr &&kind = KindExpr{0});
const DeclTypeSpec &MakeDerivedType(
DeclTypeSpec::Category, DerivedTypeSpec &&);
- const DeclTypeSpec &MakeDerivedType(
- DeclTypeSpec::Category, DerivedTypeSpec &&, SemanticsContext &);
DeclTypeSpec &MakeDerivedType(const Symbol &);
DeclTypeSpec &MakeDerivedType(DerivedTypeSpec &&, DeclTypeSpec::Category);
const DeclTypeSpec &MakeTypeStarType();
scope_ = &scope;
}
-bool DerivedTypeSpec::operator==(const DerivedTypeSpec &that) const {
- return &typeSymbol_ == &that.typeSymbol_ && parameters_ == that.parameters_;
-}
-
ParamValue &DerivedTypeSpec::AddParamValue(
SourceName name, ParamValue &&value) {
auto pair{parameters_.insert(std::make_pair(name, std::move(value)))};
expr_ = std::move(x);
}
-bool ParamValue::operator==(const ParamValue &that) const {
- return category_ == that.category_ && expr_ == that.expr_;
-}
-
std::ostream &operator<<(std::ostream &o, const ParamValue &x) {
if (x.isAssumed()) {
o << '*';
bool isDeferred() const { return category_ == Category::Deferred; }
const MaybeIntExpr &GetExplicit() const { return expr_; }
void SetExplicit(SomeIntExpr &&);
- bool operator==(const ParamValue &) const;
+ bool operator==(const ParamValue &that) const {
+ return category_ == that.category_ && expr_ == that.expr_;
+ }
private:
enum class Category { Explicit, Deferred, Assumed };
}
void FoldParameterExpressions(evaluate::FoldingContext &);
void Instantiate(Scope &, SemanticsContext &);
- bool operator==(const DerivedTypeSpec &) const; // for std::find()
+ bool operator==(const DerivedTypeSpec &that) const {
+ return &typeSymbol_ == &that.typeSymbol_ && parameters_ == that.parameters_;
+ }
private:
const Symbol &typeSymbol_;
projects / platform / upstream / llvm.git / commitdiff