From e668139fdcd3d4acc8ba7963e507ce2b63ea5f2f Mon Sep 17 00:00:00 2001
From: peter klausler <pklausler@nvidia.com>
Date: Tue, 17 Dec 2019 15:59:25 -0800
Subject: [PATCH] [flang] Fix unparsing of assignment representation and excess
 parentheses

More fixes, and move prefix/infix/suffix strings into formatting.cc

Original-commit: flang-compiler/f18@49d68700e0ab105459fb1e05bf60f8ec352a8aac
Reviewed-on: https://github.com/flang-compiler/f18/pull/874
---
 flang/lib/evaluate/expression.h   |  39 -----
 flang/lib/evaluate/formatting.cc  | 242 +++++++++++++++++++-----------
 flang/lib/parser/unparse.cc       |   2 +
 flang/lib/semantics/assignment.cc |  33 ++--
 flang/lib/semantics/expression.cc |  29 ++--
 flang/lib/semantics/expression.h  |   5 +-
 flang/tools/f18/f18.cc            |   3 +
 7 files changed, 199 insertions(+), 154 deletions(-)

diff --git a/flang/lib/evaluate/expression.h b/flang/lib/evaluate/expression.h
index 7b3cb169da4d..34489d801fd8 100644
--- a/flang/lib/evaluate/expression.h
+++ b/flang/lib/evaluate/expression.h
@@ -192,12 +192,6 @@ public:
 
   std::ostream &AsFortran(std::ostream &) const;
 
-protected:
-  // Overridable functions for AsFortran()
-  static const char *Prefix() { return ""; }
-  static const char *Infix() { return ""; }
-  static const char *Suffix() { return ""; }
-
 private:
   Container operand_;
 };
@@ -232,8 +226,6 @@ struct Parentheses : public Operation<Parentheses<A>, A, A> {
   using Operand = A;
   using Base = Operation<Parentheses, A, A>;
   using Base::Base;
-  static const char *Prefix() { return "("; }
-  static const char *Suffix() { return ")"; }
 };
 
 template<typename A> struct Negate : public Operation<Negate<A>, A, A> {
@@ -241,7 +233,6 @@ template<typename A> struct Negate : public Operation<Negate<A>, A, A> {
   using Operand = A;
   using Base = Operation<Negate, A, A>;
   using Base::Base;
-  static const char *Prefix() { return "-"; }
 };
 
 template<int KIND>
@@ -257,9 +248,6 @@ struct ComplexComponent
   ComplexComponent(bool isImaginary, Expr<Operand> &&x)
     : Base{std::move(x)}, isImaginaryPart{isImaginary} {}
 
-  const char *Prefix() const { return isImaginaryPart ? "IMAG(" : "REAL("; }
-  const char *Suffix() const { return ")"; }
-
   bool isImaginaryPart{true};
 };
 
@@ -270,7 +258,6 @@ struct Not : public Operation<Not<KIND>, Type<TypeCategory::Logical, KIND>,
   using Operand = Result;
   using Base = Operation<Not, Result, Operand>;
   using Base::Base;
-  static const char *Prefix() { return ".NOT."; }
 };
 
 // Character lengths are determined by context in Fortran and do not
@@ -286,9 +273,6 @@ struct SetLength
   using LengthOperand = SubscriptInteger;
   using Base = Operation<SetLength, Result, CharacterOperand, LengthOperand>;
   using Base::Base;
-  static const char *Prefix() { return "%SET_LENGTH("; }
-  static const char *Infix() { return ","; }
-  static const char *Suffix() { return ")"; }
 };
 
 // Binary operations
@@ -298,7 +282,6 @@ template<typename A> struct Add : public Operation<Add<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Add, A, A, A>;
   using Base::Base;
-  static const char *Infix() { return "+"; }
 };
 
 template<typename A> struct Subtract : public Operation<Subtract<A>, A, A, A> {
@@ -306,7 +289,6 @@ template<typename A> struct Subtract : public Operation<Subtract<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Subtract, A, A, A>;
   using Base::Base;
-  static const char *Infix() { return "-"; }
 };
 
 template<typename A> struct Multiply : public Operation<Multiply<A>, A, A, A> {
@@ -314,7 +296,6 @@ template<typename A> struct Multiply : public Operation<Multiply<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Multiply, A, A, A>;
   using Base::Base;
-  static const char *Infix() { return "*"; }
 };
 
 template<typename A> struct Divide : public Operation<Divide<A>, A, A, A> {
@@ -322,7 +303,6 @@ template<typename A> struct Divide : public Operation<Divide<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Divide, A, A, A>;
   using Base::Base;
-  static const char *Infix() { return "/"; }
 };
 
 template<typename A> struct Power : public Operation<Power<A>, A, A, A> {
@@ -330,7 +310,6 @@ template<typename A> struct Power : public Operation<Power<A>, A, A, A> {
   using Operand = A;
   using Base = Operation<Power, A, A, A>;
   using Base::Base;
-  static const char *Infix() { return "**"; }
 };
 
 template<typename A>
@@ -340,7 +319,6 @@ struct RealToIntPower : public Operation<RealToIntPower<A>, A, A, SomeInteger> {
   using BaseOperand = A;
   using ExponentOperand = SomeInteger;
   using Base::Base;
-  static const char *Infix() { return "**"; }
 };
 
 template<typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
@@ -352,13 +330,6 @@ template<typename A> struct Extremum : public Operation<Extremum<A>, A, A, A> {
     : Base{x, y}, ordering{ord} {}
   Extremum(Ordering ord, Expr<Operand> &&x, Expr<Operand> &&y)
     : Base{std::move(x), std::move(y)}, ordering{ord} {}
-
-  const char *Prefix() const {
-    return ordering == Ordering::Less ? "MIN(" : "MAX(";
-  }
-  static const char *Infix() { return ","; }
-  static const char *Suffix() { return ")"; }
-
   Ordering ordering{Ordering::Greater};
 };
 
@@ -371,9 +342,6 @@ struct ComplexConstructor
   using Operand = Type<TypeCategory::Real, KIND>;
   using Base = Operation<ComplexConstructor, Result, Operand, Operand>;
   using Base::Base;
-  static const char *Prefix() { return "("; }
-  static const char *Infix() { return ","; }
-  static const char *Suffix() { return ")"; }
 };
 
 template<int KIND>
@@ -385,7 +353,6 @@ struct Concat
   using Operand = Result;
   using Base = Operation<Concat, Result, Operand, Operand>;
   using Base::Base;
-  static const char *Infix() { return "//"; }
 };
 
 template<int KIND>
@@ -401,9 +368,6 @@ struct LogicalOperation
     : Base{x, y}, logicalOperator{opr} {}
   LogicalOperation(LogicalOperator opr, Expr<Operand> &&x, Expr<Operand> &&y)
     : Base{std::move(x), std::move(y)}, logicalOperator{opr} {}
-
-  const char *Infix() const;
-
   LogicalOperator logicalOperator;
 };
 
@@ -655,9 +619,6 @@ struct Relational : public Operation<Relational<T>, LogicalResult, T, T> {
     : Base{a, b}, opr{r} {}
   Relational(RelationalOperator r, Expr<Operand> &&a, Expr<Operand> &&b)
     : Base{std::move(a), std::move(b)}, opr{r} {}
-
-  const char *Infix() const;
-
   RelationalOperator opr;
 };
 
diff --git a/flang/lib/evaluate/formatting.cc b/flang/lib/evaluate/formatting.cc
index fc65ca7263c7..6cde8a940e5a 100644
--- a/flang/lib/evaluate/formatting.cc
+++ b/flang/lib/evaluate/formatting.cc
@@ -163,68 +163,72 @@ enum class Precedence {  // in increasing order for sane comparisons
   Power,  // **, which is right-associative unlike the other dyadic operators
   DefinedUnary,
   Parenthesize,  // (x), (real, imaginary)
-  Constant,  // parenthesize if negative integer/real operand
-  Primary,  // don't parenthesize
+  Literal,
+  Top,
 };
 
-template<typename A> constexpr Precedence ToPrecedence{Precedence::Primary};
-
-template<int KIND>
-constexpr Precedence ToPrecedence<LogicalOperation<KIND>>{Precedence::Or};
-template<int KIND>
-constexpr Precedence ToPrecedence<Not<KIND>>{Precedence::Not};
-template<typename T>
-constexpr Precedence ToPrecedence<Relational<T>>{Precedence::Relational};
-template<typename T>
-constexpr Precedence ToPrecedence<Add<T>>{Precedence::Additive};
-template<typename T>
-constexpr Precedence ToPrecedence<Subtract<T>>{Precedence::Additive};
-template<int KIND>
-constexpr Precedence ToPrecedence<Concat<KIND>>{Precedence::Additive};
-template<typename T>
-constexpr Precedence ToPrecedence<Negate<T>>{Precedence::Negate};
-template<typename T>
-constexpr Precedence ToPrecedence<Multiply<T>>{Precedence::Multiplicative};
-template<typename T>
-constexpr Precedence ToPrecedence<Divide<T>>{Precedence::Multiplicative};
-template<typename T>
-constexpr Precedence ToPrecedence<Power<T>>{Precedence::Power};
-template<typename T>
-constexpr Precedence ToPrecedence<RealToIntPower<T>>{Precedence::Power};
-template<typename T>
-constexpr Precedence ToPrecedence<Constant<T>>{Precedence::Constant};
-template<int KIND>
-constexpr Precedence ToPrecedence<SetLength<KIND>>{Precedence::Constant};
-template<typename T>
-constexpr Precedence ToPrecedence<Parentheses<T>>{Precedence::Parenthesize};
-template<int KIND>
-constexpr Precedence ToPrecedence<ComplexConstructor<KIND>>{
-    Precedence::Parenthesize};
-
-template<typename T>
-static constexpr Precedence GetPrecedence(const Expr<T> &expr) {
-  return std::visit(
-      [](const auto &x) {
-        static constexpr Precedence prec{
-            ToPrecedence<std::decay_t<decltype(x)>>};
-        if constexpr (prec == Precedence::Or) {
-          // Distinguish the four logical binary operations.
-          switch (x.logicalOperator) {
-            SWITCH_COVERS_ALL_CASES
-          case LogicalOperator::And: return Precedence::And;
-          case LogicalOperator::Or: return Precedence::Or;
-          case LogicalOperator::Not: return Precedence::Not;
-          case LogicalOperator::Eqv:
-          case LogicalOperator::Neqv: return Precedence::Equivalence;
-          }
-        }
-        return prec;
-      },
-      expr.u);
+template<typename A> constexpr Precedence ToPrecedence(const A &) {
+  return Precedence::Top;
 }
-template<TypeCategory CAT>
-static constexpr Precedence GetPrecedence(const Expr<SomeKind<CAT>> &expr) {
-  return std::visit([](const auto &x) { return GetPrecedence(x); }, expr.u);
+template<int KIND>
+static Precedence ToPrecedence(const LogicalOperation<KIND> &x) {
+  switch (x.logicalOperator) {
+    SWITCH_COVERS_ALL_CASES
+  case LogicalOperator::And: return Precedence::And;
+  case LogicalOperator::Or: return Precedence::Or;
+  case LogicalOperator::Not: return Precedence::Not;
+  case LogicalOperator::Eqv:
+  case LogicalOperator::Neqv: return Precedence::Equivalence;
+  }
+}
+template<int KIND> constexpr Precedence ToPrecedence(const Not<KIND> &) {
+  return Precedence::Not;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Relational<T> &) {
+  return Precedence::Relational;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Add<T> &) {
+  return Precedence::Additive;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Subtract<T> &) {
+  return Precedence::Additive;
+}
+template<int KIND> constexpr Precedence ToPrecedence(const Concat<KIND> &) {
+  return Precedence::Additive;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Negate<T> &) {
+  return Precedence::Negate;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Multiply<T> &) {
+  return Precedence::Multiplicative;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Divide<T> &) {
+  return Precedence::Multiplicative;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Power<T> &) {
+  return Precedence::Power;
+}
+template<typename T>
+constexpr Precedence ToPrecedence(const RealToIntPower<T> &) {
+  return Precedence::Power;
+}
+template<typename T> static Precedence ToPrecedence(const Constant<T> &x) {
+  static constexpr TypeCategory cat{T::category};
+  if constexpr (cat == TypeCategory::Integer || cat == TypeCategory::Real) {
+    if (auto n{GetScalarConstantValue<T>(x)}) {
+      if (n->IsNegative()) {
+        return Precedence::Negate;
+      }
+    }
+  }
+  return Precedence::Literal;
+}
+template<typename T> constexpr Precedence ToPrecedence(const Parentheses<T> &) {
+  return Precedence::Parenthesize;
+}
+
+template<typename T> static Precedence ToPrecedence(const Expr<T> &expr) {
+  return std::visit([](const auto &x) { return ToPrecedence(x); }, expr.u);
 }
 
 template<typename T> static bool IsNegatedScalarConstant(const Expr<T> &expr) {
@@ -243,29 +247,105 @@ static bool IsNegatedScalarConstant(const Expr<SomeKind<CAT>> &expr) {
       [](const auto &x) { return IsNegatedScalarConstant(x); }, expr.u);
 }
 
+struct OperatorSpelling {
+  const char *prefix{""}, *infix{","}, *suffix{""};
+};
+
+template<typename A> constexpr OperatorSpelling SpellOperator(const A &) {
+  return OperatorSpelling{};
+}
+template<typename A>
+constexpr OperatorSpelling SpellOperator(const Negate<A> &) {
+  return OperatorSpelling{"-", "", ""};
+}
+template<int KIND>
+static OperatorSpelling SpellOperator(const ComplexComponent<KIND> &x) {
+  return OperatorSpelling{x.isImaginaryPart ? "AIMAG(" : "REAL(", "", ")"};
+}
+template<int KIND> constexpr OperatorSpelling SpellOperator(const Not<KIND> &) {
+  return OperatorSpelling{".NOT.", "", ""};
+}
+template<int KIND>
+constexpr OperatorSpelling SpellOperator(const SetLength<KIND> &) {
+  return OperatorSpelling{"%SET_LENGTH(", ",", ")"};
+}
+template<int KIND>
+constexpr OperatorSpelling SpellOperator(const ComplexConstructor<KIND> &) {
+  return OperatorSpelling{"(", ",", ")"};
+}
+template<typename A> constexpr OperatorSpelling SpellOperator(const Add<A> &) {
+  return OperatorSpelling{"", "+", ""};
+}
+template<typename A>
+constexpr OperatorSpelling SpellOperator(const Subtract<A> &) {
+  return OperatorSpelling{"", "-", ""};
+}
+template<typename A>
+constexpr OperatorSpelling SpellOperator(const Multiply<A> &) {
+  return OperatorSpelling{"", "*", ""};
+}
+template<typename A>
+constexpr OperatorSpelling SpellOperator(const Divide<A> &) {
+  return OperatorSpelling{"", "/", ""};
+}
+template<typename A>
+constexpr OperatorSpelling SpellOperator(const Power<A> &) {
+  return OperatorSpelling{"", "**", ""};
+}
+template<typename A>
+constexpr OperatorSpelling SpellOperator(const RealToIntPower<A> &) {
+  return OperatorSpelling{"", "**", ""};
+}
+template<typename A>
+static OperatorSpelling SpellOperator(const Extremum<A> &x) {
+  return OperatorSpelling{
+      x.ordering == Ordering::Less ? "MIN(" : "MAX(", ",", ")"};
+}
+template<int KIND>
+constexpr OperatorSpelling SpellOperator(const Concat<KIND> &) {
+  return OperatorSpelling{"", "//", ""};
+}
+template<int KIND>
+static OperatorSpelling SpellOperator(const LogicalOperation<KIND> &x) {
+  return OperatorSpelling{"", AsFortran(x.logicalOperator), ""};
+}
+template<typename T>
+static OperatorSpelling SpellOperator(const Relational<T> &x) {
+  return OperatorSpelling{"", AsFortran(x.opr), ""};
+}
+
 template<typename D, typename R, typename... O>
 std::ostream &Operation<D, R, O...>::AsFortran(std::ostream &o) const {
-  Precedence lhsPrec{GetPrecedence(left())};
-  o << derived().Prefix();
-  static constexpr Precedence thisPrec{ToPrecedence<D>};
+  Precedence lhsPrec{ToPrecedence(left())};
+  OperatorSpelling spelling{SpellOperator(derived())};
+  o << spelling.prefix;
+  Precedence thisPrec{ToPrecedence(derived())};
   if constexpr (operands == 1) {
-    bool parens{lhsPrec < Precedence::Constant &&
-        !(thisPrec == Precedence::Not && lhsPrec == Precedence::Relational)};
-    o << (parens ? "(" : "") << left() << (parens ? ")" : "");
+    if (lhsPrec <= thisPrec) {
+      o << '(' << left() << ')';
+    } else {
+      o << left();
+    }
   } else {
-    bool lhsParens{lhsPrec == Precedence::Parenthesize || lhsPrec < thisPrec ||
-        (lhsPrec == thisPrec && lhsPrec == Precedence::Power) ||
-        (thisPrec != Precedence::Additive && lhsPrec == Precedence::Constant &&
-            IsNegatedScalarConstant(left()))};
-    o << (lhsParens ? "(" : "") << left() << (lhsParens ? ")" : "");
-    o << derived().Infix();
-    Precedence rhsPrec{GetPrecedence(right())};
-    bool rhsParens{rhsPrec == Precedence::Parenthesize ||
-        rhsPrec == Precedence::Negate || rhsPrec < thisPrec ||
-        (rhsPrec == Precedence::Constant && IsNegatedScalarConstant(right()))};
-    o << (rhsParens ? "(" : "") << right() << (rhsParens ? ")" : "");
+    if (lhsPrec == Precedence::Parenthesize) {
+      o << left();
+    } else if (lhsPrec < thisPrec ||
+        (lhsPrec == Precedence::Power && thisPrec == Precedence::Power)) {
+      o << '(' << left() << ')';
+    } else {
+      o << left();
+    }
+    o << spelling.infix;
+    Precedence rhsPrec{ToPrecedence(right())};
+    if (rhsPrec == Precedence::Parenthesize) {
+      o << right();
+    } else if (rhsPrec < thisPrec) {
+      o << '(' << right() << ')';
+    } else {
+      o << right();
+    }
   }
-  return o << derived().Suffix();
+  return o << spelling.suffix;
 }
 
 template<typename TO, TypeCategory FROMCAT>
@@ -287,19 +367,11 @@ std::ostream &Convert<TO, FROMCAT>::AsFortran(std::ostream &o) const {
   return o << ",kind=" << TO::kind << ')';
 }
 
-template<typename A> const char *Relational<A>::Infix() const {
-  return common::AsFortran(opr);
-}
-
 std::ostream &Relational<SomeType>::AsFortran(std::ostream &o) const {
   std::visit([&](const auto &rel) { rel.AsFortran(o); }, u);
   return o;
 }
 
-template<int KIND> const char *LogicalOperation<KIND>::Infix() const {
-  return AsFortran(logicalOperator);
-}
-
 template<typename T>
 std::ostream &EmitArray(std::ostream &o, const Expr<T> &expr) {
   return expr.AsFortran(o);
diff --git a/flang/lib/parser/unparse.cc b/flang/lib/parser/unparse.cc
index f68856edb7ea..e13118926993 100644
--- a/flang/lib/parser/unparse.cc
+++ b/flang/lib/parser/unparse.cc
@@ -847,7 +847,9 @@ public:
   }
   void Unparse(const AssignmentStmt &x) {  // R1032
     if (asFortran_ && x.typedAssignment.get()) {
+      Put(' ');
       asFortran_->assignment(out_, *x.typedAssignment);
+      Put('\n');
     } else {
       Walk(x.t, " = ");
     }
diff --git a/flang/lib/semantics/assignment.cc b/flang/lib/semantics/assignment.cc
index 57e55a669c00..526fe47dde45 100644
--- a/flang/lib/semantics/assignment.cc
+++ b/flang/lib/semantics/assignment.cc
@@ -359,19 +359,21 @@ private:
 };
 
 void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) {
-  const auto &lhs{std::get<parser::Variable>(stmt.t)};
-  const auto &rhs{std::get<parser::Expr>(stmt.t)};
-  auto lhsExpr{AnalyzeExpr(context_, lhs)};
-  auto rhsExpr{AnalyzeExpr(context_, rhs)};
-  CheckForImpureCall(lhsExpr);
-  CheckForImpureCall(rhsExpr);
-  // TODO: preserve analyzed typed expressions
-  if (forall_) {
-    // TODO: Warn if some name in forall_->activeNames or its outer
-    // contexts does not appear on LHS
-  }
-  if (lhsExpr && rhsExpr) {
-    CheckForPureContext(*lhsExpr, *rhsExpr, rhs.source, false /* not => */);
+  // Assignment statement analysis is in expression.cc where user-defined
+  // assignments can be recognized and replaced.
+  if (const evaluate::Assignment *
+      asst{AnalyzeAssignmentStmt(context_, stmt)}) {
+    if (const auto *intrinsicAsst{
+            std::get_if<evaluate::Assignment::IntrinsicAssignment>(&asst->u)}) {
+      CheckForImpureCall(intrinsicAsst->lhs);
+      CheckForImpureCall(intrinsicAsst->rhs);
+      if (forall_) {
+        // TODO: Warn if some name in forall_->activeNames or its outer
+        // contexts does not appear on LHS
+      }
+      CheckForPureContext(intrinsicAsst->lhs, intrinsicAsst->rhs,
+          std::get<parser::Expr>(stmt.t).source, false /* not => */);
+    }
   }
   // TODO: Fortran 2003 ALLOCATABLE assignment semantics (automatic
   // (re)allocation of LHS array when unallocated or nonconformable)
@@ -381,8 +383,9 @@ void AssignmentContext::Analyze(const parser::PointerAssignmentStmt &stmt) {
   CHECK(!where_);
   const auto &lhs{std::get<parser::DataRef>(stmt.t)};
   const auto &rhs{std::get<parser::Expr>(stmt.t)};
-  auto lhsExpr{AnalyzeExpr(context_, lhs)};
-  auto rhsExpr{AnalyzeExpr(context_, rhs)};
+  auto &foldingContext{context_.foldingContext()};
+  auto lhsExpr{evaluate::Fold(foldingContext, AnalyzeExpr(context_, lhs))};
+  auto rhsExpr{evaluate::Fold(foldingContext, AnalyzeExpr(context_, rhs))};
   CheckForImpureCall(lhsExpr);
   CheckForImpureCall(rhsExpr);
   // TODO: CheckForImpureCall() in the bounds / bounds remappings
diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index cb60f4fa52f7..34194838c575 100644
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -350,8 +350,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
   // These checks have to be deferred to these "top level" data-refs where
   // we can be sure that there are no following subscripts (yet).
   if (MaybeExpr result{Analyze(d.u)}) {
-    if (std::optional<evaluate::DataRef> dataRef{
-            evaluate::ExtractDataRef(std::move(result))}) {
+    if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
       return TopLevelChecks(std::move(*dataRef));
     }
     return result;
@@ -1853,16 +1852,20 @@ MaybeExpr ExpressionAnalyzer::AnalyzeCall(
   return std::nullopt;
 }
 
-void ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
-  ArgumentAnalyzer analyzer{*this};
-  analyzer.Analyze(std::get<parser::Variable>(x.t));
-  analyzer.Analyze(std::get<parser::Expr>(x.t));
-  if (!analyzer.fatalErrors()) {
-    std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
-    x.typedAssignment.reset(new GenericAssignmentWrapper{procRef
-            ? Assignment{std::move(*procRef)}
-            : Assignment{analyzer.MoveExpr(0), analyzer.MoveExpr(1)}});
+const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
+  if (!x.typedAssignment) {
+    ArgumentAnalyzer analyzer{*this};
+    analyzer.Analyze(std::get<parser::Variable>(x.t));
+    analyzer.Analyze(std::get<parser::Expr>(x.t));
+    if (!analyzer.fatalErrors()) {
+      std::optional<ProcedureRef> procRef{analyzer.TryDefinedAssignment()};
+      x.typedAssignment.reset(new GenericAssignmentWrapper{procRef
+              ? Assignment{std::move(*procRef)}
+              : Assignment{Fold(foldingContext_, analyzer.MoveExpr(0)),
+                    Fold(foldingContext_, analyzer.MoveExpr(1))}});
+    }
   }
+  return x.typedAssignment ? &x.typedAssignment->v : nullptr;
 }
 
 static bool IsExternalCalledImplicitly(
@@ -2824,9 +2827,9 @@ void AnalyzeCallStmt(SemanticsContext &context, const parser::CallStmt &call) {
   evaluate::ExpressionAnalyzer{context}.Analyze(call);
 }
 
-void AnalyzeAssignmentStmt(
+const evaluate::Assignment *AnalyzeAssignmentStmt(
     SemanticsContext &context, const parser::AssignmentStmt &stmt) {
-  evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
+  return evaluate::ExpressionAnalyzer{context}.Analyze(stmt);
 }
 
 ExprChecker::ExprChecker(SemanticsContext &context) : context_{context} {}
diff --git a/flang/lib/semantics/expression.h b/flang/lib/semantics/expression.h
index f016db0a4df9..f1b16c0bb2cc 100644
--- a/flang/lib/semantics/expression.h
+++ b/flang/lib/semantics/expression.h
@@ -238,7 +238,7 @@ public:
   MaybeExpr Analyze(const parser::StructureComponent &);
 
   void Analyze(const parser::CallStmt &);
-  void Analyze(const parser::AssignmentStmt &);
+  const Assignment *Analyze(const parser::AssignmentStmt &);
 
 protected:
   int IntegerTypeSpecKind(const parser::IntegerTypeSpec &);
@@ -386,7 +386,8 @@ evaluate::Expr<evaluate::SubscriptInteger> AnalyzeKindSelector(
     const std::optional<parser::KindSelector> &);
 
 void AnalyzeCallStmt(SemanticsContext &, const parser::CallStmt &);
-void AnalyzeAssignmentStmt(SemanticsContext &, const parser::AssignmentStmt &);
+const evaluate::Assignment *AnalyzeAssignmentStmt(
+    SemanticsContext &, const parser::AssignmentStmt &);
 
 // Semantic analysis of all expressions in a parse tree, which becomes
 // decorated with typed representations for top-level expressions.
diff --git a/flang/tools/f18/f18.cc b/flang/tools/f18/f18.cc
index ba5176588253..32ffa7c4e26a 100644
--- a/flang/tools/f18/f18.cc
+++ b/flang/tools/f18/f18.cc
@@ -451,6 +451,9 @@ int main(int argc, char *const argv[]) {
       options.isFixedForm = false;
     } else if (arg == "-Mextend") {
       options.fixedFormColumns = 132;
+    } else if (arg == "-Munlimited") {
+      // For reparsing f18's -E output of fixed-form cooked character stream
+      options.fixedFormColumns = 1000000;
     } else if (arg == "-Mbackslash") {
       options.features.Enable(
           Fortran::common::LanguageFeature::BackslashEscapes, false);