[flang] Lower simple scalar assignment

[clementval]

Summary

This patch hanlde lowering of simple scalar assignment.

This patch is part of the upstreaming effort from fir-dev branch.

Co-authored-by: Jean Perier <[e-mail]>

[clementval]

Remove commented code

[PeteSteinfeld]

All builds and tests correctly and looks good.

Thanks for doing this!

flang/include/flang/Lower/ConvertExpr.h

 using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
 
 /// Create an extended expression value.
 fir::ExtendedValue createSomeExtendedExpression(mlir::Location loc,
                                                 AbstractConverter &converter,
                                                 const SomeExpr &expr,
                                                 SymMap &symMap);
 
+/// Create an extended expression address.
+fir::ExtendedValue createSomeExtendedAddress(mlir::Location loc,
+                                             AbstractConverter &converter,
+                                             const SomeExpr &expr,
+                                             SymMap &symMap);
+
+// Attribute for an alloca that is a trivial adaptor for converting a value to
+// pass-by-ref semantics for a VALUE parameter. The optimizer may be able to
+// eliminate these.
+inline mlir::NamedAttribute getAdaptToByRefAttr(fir::FirOpBuilder &builder) {
+  return {mlir::StringAttr::get(builder.getContext(),
+                                fir::getAdaptToByRefAttrName()),
+          builder.getUnitAttr()};
+}
+
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_CONVERTEXPR_H

flang/include/flang/Lower/ConvertType.h

 class AbstractConverter;
 namespace pft {
 struct Variable;
 }
 
 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
 using SymbolRef = common::Reference<const semantics::Symbol>;
 
+// Type for compile time constant length type parameters.
+using LenParameterTy = std::int64_t;
+
 /// Get a FIR type based on a category and kind.
 mlir::Type getFIRType(mlir::MLIRContext *ctxt, common::TypeCategory tc,
                       int kind);
 
 /// Get a FIR type based on a category.
 mlir::Type getFIRType(Fortran::lower::AbstractConverter &,
                       common::TypeCategory tc);
 
 /// Translate a Fortran::evaluate::DataRef to an mlir::Type.
 mlir::Type translateDataRefToFIRType(Fortran::lower::AbstractConverter &,
                                      const evaluate::DataRef &dataRef);
 
 /// Translate a SomeExpr to an mlir::Type.
 mlir::Type translateSomeExprToFIRType(Fortran::lower::AbstractConverter &,
-                                      const SomeExpr *expr);
+                                      const SomeExpr &expr);
 
 /// Translate a Fortran::semantics::Symbol to an mlir::Type.
 mlir::Type translateSymbolToFIRType(Fortran::lower::AbstractConverter &,
                                     const SymbolRef symbol);
 
 /// Translate a Fortran::lower::pft::Variable to an mlir::Type.
 mlir::Type translateVariableToFIRType(Fortran::lower::AbstractConverter &,
                                       const pft::Variable &variable);

flang/include/flang/Lower/Support/Utils.h

 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_SUPPORT_UTILS_H
 #define FORTRAN_LOWER_SUPPORT_UTILS_H
 
 #include "flang/Common/indirection.h"
 #include "flang/Parser/char-block.h"
+#include "flang/Semantics/tools.h"
 #include "mlir/Dialect/StandardOps/IR/Ops.h"
 #include "mlir/IR/BuiltinAttributes.h"
 #include "llvm/ADT/StringRef.h"
 #include <cstdint>
 
+namespace Fortran::lower {
+using SomeExpr = Fortran::evaluate::Expr<Fortran::evaluate::SomeType>;
+}
+
 //===----------------------------------------------------------------------===//
 // Small inline helper functions to deal with repetitive, clumsy conversions.
 //===----------------------------------------------------------------------===//
 
 /// Convert an F18 CharBlock to an LLVM StringRef.
 inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) {
   return {cb.begin(), cb.size()};
 }

 const A &removeIndirection(const A &a) {
   return a;
 }
 template <typename A>
 const A &removeIndirection(const Fortran::common::Indirection<A> &a) {
   return a.value();
 }
 
+/// Clone subexpression and wrap it as a generic `Fortran::evaluate::Expr`.
+template <typename A>
+static Fortran::lower::SomeExpr toEvExpr(const A &x) {
+  return Fortran::evaluate::AsGenericExpr(Fortran::common::Clone(x));
+}
+
 #endif // FORTRAN_LOWER_SUPPORT_UTILS_H

flang/include/flang/Lower/Utils.h

-//===-- Lower/Utils.h -- utilities ------------------------------*- C++ -*-===//
-//
-// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-// See https://llvm.org/LICENSE.txt for license information.
-// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FORTRAN_LOWER_UTILS_H
-#define FORTRAN_LOWER_UTILS_H
-
-#include "flang/Common/indirection.h"
-#include "flang/Parser/char-block.h"
-#include "llvm/ADT/StringRef.h"
-
-/// Convert an F18 CharBlock to an LLVM StringRef
-inline llvm::StringRef toStringRef(const Fortran::parser::CharBlock &cb) {
-  return {cb.begin(), cb.size()};
-}
-
-/// Template helper to remove Fortran::common::Indirection wrappers.
-template <typename A>
-const A &removeIndirection(const A &a) {
-  return a;
-}
-template <typename A>
-const A &removeIndirection(const Fortran::common::Indirection<A> &a) {
-  return a.value();
-}
-
-#endif // FORTRAN_LOWER_UTILS_H

flang/include/flang/Optimizer/Dialect/FIROps.h

 mlir::ParseResult isValidCaseAttr(mlir::Attribute attr);
 mlir::ParseResult parseCmpcOp(mlir::OpAsmParser &parser,
                               mlir::OperationState &result);
 mlir::ParseResult parseSelector(mlir::OpAsmParser &parser,
                                 mlir::OperationState &result,
                                 mlir::OpAsmParser::OperandType &selector,
                                 mlir::Type &type);
 
+static constexpr llvm::StringRef getAdaptToByRefAttrName() {
+  return "adapt.valuebyref";
+}
+
 } // namespace fir
 
 #define GET_OP_CLASSES
 #include "flang/Optimizer/Dialect/FIROps.h.inc"
 
 #endif // FORTRAN_OPTIMIZER_DIALECT_FIROPS_H

flang/lib/Lower/Bridge.cpp

 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Support/FIRContext.h"
+#include "flang/Semantics/tools.h"
 #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
 #include "mlir/IR/PatternMatch.h"
 #include "mlir/Transforms/RegionUtils.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-bridge"
 
public:
   //===--------------------------------------------------------------------===//
 
   mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final {
     return lookupSymbol(sym).getAddr();
   }
 
   fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr,
                                  mlir::Location *loc = nullptr) override final {
-    TODO_NOLOC("Not implemented genExprAddr. Needed for more complex "
-               "expression lowering");
+    return createSomeExtendedAddress(loc ? *loc : toLocation(), *this, expr,
+                                     localSymbols);
   }
   fir::ExtendedValue
   genExprValue(const Fortran::lower::SomeExpr &expr,
                mlir::Location *loc = nullptr) override final {
     return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr,
                                         localSymbols);
   }
 
   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
     return foldingContext;
   }
 
   mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
     TODO_NOLOC("Not implemented genType DataRef. Needed for more complex "
                "expression lowering");
   }
-  mlir::Type genType(const Fortran::lower::SomeExpr &) override final {
-    TODO_NOLOC("Not implemented genType SomeExpr. Needed for more complex "
-               "expression lowering");
+  mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final {
+    return Fortran::lower::translateSomeExprToFIRType(*this, expr);
   }
   mlir::Type genType(Fortran::lower::SymbolRef sym) override final {
     return Fortran::lower::translateSymbolToFIRType(*this, sym);
   }
   mlir::Type genType(Fortran::common::TypeCategory tc) override final {
     TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex "
                "expression lowering");
   }
private:
   bool addSymbol(const Fortran::semantics::SymbolRef sym, mlir::Value val,
                  bool forced = false) {
     if (!forced && lookupSymbol(sym))
       return false;
     localSymbols.addSymbol(sym, val, forced);
     return true;
   }
 
+  bool isNumericScalarCategory(Fortran::common::TypeCategory cat) {
+    return cat == Fortran::common::TypeCategory::Integer ||
+           cat == Fortran::common::TypeCategory::Real ||
+           cat == Fortran::common::TypeCategory::Complex ||
+           cat == Fortran::common::TypeCategory::Logical;
+  }
+  bool isCharacterCategory(Fortran::common::TypeCategory cat) {
+    return cat == Fortran::common::TypeCategory::Character;
+  }
+  bool isDerivedCategory(Fortran::common::TypeCategory cat) {
+    return cat == Fortran::common::TypeCategory::Derived;
+  }
+
   void genFIRBranch(mlir::Block *targetBlock) {
     assert(targetBlock && "missing unconditional target block");
     builder->create<cf::BranchOp>(toLocation(), targetBlock);
   }
 
   //===--------------------------------------------------------------------===//
   // Termination of symbolically referenced execution units
   //===--------------------------------------------------------------------===//
void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit,
     }
     if (Fortran::semantics::IsFunction(symbol)) {
       genReturnSymbol(symbol);
     } else {
       genExitRoutine();
     }
   }
 
+  [[maybe_unused]] static bool
+  isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) {
+    const Fortran::semantics::Symbol *sym =
+        Fortran::evaluate::GetFirstSymbol(expr);
+    return sym && sym->IsFuncResult();
+  }
+
+  static bool isWholeAllocatable(const Fortran::lower::SomeExpr &expr) {
+    const Fortran::semantics::Symbol *sym =
+        Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr);
+    return sym && Fortran::semantics::IsAllocatable(*sym);
+  }
+
+  void genAssignment(const Fortran::evaluate::Assignment &assign) {
+    mlir::Location loc = toLocation();
+
+    std::visit(
+        Fortran::common::visitors{
+            // [1] Plain old assignment.
+            [&](const Fortran::evaluate::Assignment::Intrinsic &) {
+              const Fortran::semantics::Symbol *sym =
+                  Fortran::evaluate::GetLastSymbol(assign.lhs);
+
+              if (!sym)
+                TODO(loc, "assignment to pointer result of function reference");
+
+              std::optional<Fortran::evaluate::DynamicType> lhsType =
+                  assign.lhs.GetType();
+              assert(lhsType && "lhs cannot be typeless");
+              // Assignment to polymorphic allocatables may require changing the
+              // variable dynamic type (See Fortran 2018 10.2.1.3 p3).
+              if (lhsType->IsPolymorphic() && isWholeAllocatable(assign.lhs))
+                TODO(loc, "assignment to polymorphic allocatable");
+
+              // Note: No ad-hoc handling for pointers is required here. The
+              // target will be assigned as per 2018 10.2.1.3 p2. genExprAddr
+              // on a pointer returns the target address and not the address of
+              // the pointer variable.
+
+              if (assign.lhs.Rank() > 0) {
+                // Array assignment
+                // See Fortran 2018 10.2.1.3 p5, p6, and p7
+                TODO(toLocation(), "Array assignment");
+                return;
+              }
+
+              // Scalar assignment
+              const bool isNumericScalar =
+                  isNumericScalarCategory(lhsType->category());
+              fir::ExtendedValue rhs = isNumericScalar
+                                           ? genExprValue(assign.rhs)
+                                           : genExprAddr(assign.rhs);
+
+              if (isNumericScalar) {
+                // Fortran 2018 10.2.1.3 p8 and p9
+                // Conversions should have been inserted by semantic analysis,
+                // but they can be incorrect between the rhs and lhs. Correct
+                // that here.
+                mlir::Value addr = fir::getBase(genExprAddr(assign.lhs));
+                mlir::Value val = fir::getBase(rhs);
+                // A function with multiple entry points returning different
+                // types tags all result variables with one of the largest
+                // types to allow them to share the same storage.  Assignment
+                // to a result variable of one of the other types requires
+                // conversion to the actual type.
+                mlir::Type toTy = genType(assign.lhs);
+                mlir::Value cast =
+                    builder->convertWithSemantics(loc, toTy, val);
+                if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) {
+                  assert(isFuncResultDesignator(assign.lhs) && "type mismatch");
+                  addr = builder->createConvert(
+                      toLocation(), builder->getRefType(toTy), addr);
+                }
+                builder->create<fir::StoreOp>(loc, cast, addr);
+              } else if (isCharacterCategory(lhsType->category())) {
+                TODO(toLocation(), "Character assignment");
+              } else if (isDerivedCategory(lhsType->category())) {
+                TODO(toLocation(), "Derived type assignment");
+              } else {
+                llvm_unreachable("unknown category");
+              }
+            },
+
+            // [2] User defined assignment. If the context is a scalar
+            // expression then call the procedure.
+            [&](const Fortran::evaluate::ProcedureRef &procRef) {
+              TODO(toLocation(), "User defined assignment");
+            },
+
+            // [3] Pointer assignment with possibly empty bounds-spec. R1035: a
+            // bounds-spec is a lower bound value.
+            [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
+              TODO(toLocation(),
+                   "Pointer assignment with possibly empty bounds-spec");
+            },
+
+            // [4] Pointer assignment with bounds-remapping. R1036: a
+            // bounds-remapping is a pair, lower bound and upper bound.
+            [&](const Fortran::evaluate::Assignment::BoundsRemapping
+                    &boundExprs) {
+              TODO(toLocation(), "Pointer assignment with bounds-remapping");
+            },
+        },
+        assign.u);
+  }
+
   void genFIR(const Fortran::parser::CallStmt &stmt) {
     TODO(toLocation(), "CallStmt lowering");
   }
 
   void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) {
     TODO(toLocation(), "ComputedGotoStmt lowering");
   }
 
void genFIR(const Fortran::parser::WhereStmt &stmt) {
     TODO(toLocation(), "WhereStmt lowering");
   }
 
   void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) {
     TODO(toLocation(), "PointerAssignmentStmt lowering");
   }
 
   void genFIR(const Fortran::parser::AssignmentStmt &stmt) {
-    TODO(toLocation(), "AssignmentStmt lowering");
+    genAssignment(*stmt.typedAssignment->v);
   }
 
   void genFIR(const Fortran::parser::SyncAllStmt &stmt) {
     TODO(toLocation(), "SyncAllStmt lowering");
   }
 
   void genFIR(const Fortran::parser::SyncImagesStmt &stmt) {
     TODO(toLocation(), "SyncImagesStmt lowering");

flang/lib/Lower/ConvertExpr.cpp

 // there for more information on these data structures. Generally speaking,
 // these data structures are a strongly typed family of abstract data types
 // that, composed as trees, describe the syntax of Fortran expressions.
 //
 // This part of the bridge can traverse these tree structures and lower them
 // to the correct FIR representation in SSA form.
 //===----------------------------------------------------------------------===//
 
+/// Place \p exv in memory if it is not already a memory reference. If
+/// \p forceValueType is provided, the value is first casted to the provided
+/// type before being stored (this is mainly intended for logicals whose value
+/// may be `i1` but needed to be stored as Fortran logicals).
+static fir::ExtendedValue
+placeScalarValueInMemory(fir::FirOpBuilder &builder, mlir::Location loc,
+                         const fir::ExtendedValue &exv,
+                         mlir::Type storageType) {
+  mlir::Value valBase = fir::getBase(exv);
+  if (fir::conformsWithPassByRef(valBase.getType()))
+    return exv;
+
+  assert(!fir::hasDynamicSize(storageType) &&
+         "only expect statically sized scalars to be by value");
+
+  // Since `a` is not itself a valid referent, determine its value and
+  // create a temporary location at the beginning of the function for
+  // referencing.
+  mlir::Value val = builder.createConvert(loc, storageType, valBase);
+  mlir::Value temp = builder.createTemporary(
+      loc, storageType,
+      llvm::ArrayRef<mlir::NamedAttribute>{
+          Fortran::lower::getAdaptToByRefAttr(builder)});
+  builder.create<fir::StoreOp>(loc, val, temp);
+  return fir::substBase(exv, temp);
+}
+
 /// Generate a load of a value from an address. Beware that this will lose
 /// any dynamic type information for polymorphic entities (note that unlimited
 /// polymorphic cannot be loaded and must not be provided here).
 static fir::ExtendedValue genLoad(fir::FirOpBuilder &builder,
                                   mlir::Location loc,
                                   const fir::ExtendedValue &addr) {
   return addr.match(
       [](const fir::CharBoxValue &box) -> fir::ExtendedValue { return box; },
public:
   explicit ScalarExprLowering(mlir::Location loc,
                               Fortran::lower::AbstractConverter &converter,
                               Fortran::lower::SymMap &symMap)
       : location{loc}, converter{converter},
         builder{converter.getFirOpBuilder()}, symMap{symMap} {}
 
   mlir::Location getLoc() { return location; }
 
+  template <typename A>
+  mlir::Value genunbox(const A &expr) {
+    ExtValue e = genval(expr);
+    if (const fir::UnboxedValue *r = e.getUnboxed())
+      return *r;
+    fir::emitFatalError(getLoc(), "unboxed expression expected");
+  }
+
   /// Generate an integral constant of `value`
   template <int KIND>
   mlir::Value genIntegerConstant(mlir::MLIRContext *context,
                                  std::int64_t value) {
     mlir::Type type =
         converter.genType(Fortran::common::TypeCategory::Integer, KIND);
     return builder.createIntegerConstant(getLoc(), type, value);
   }
genval(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) {
     TODO(getLoc(), "genval comparison");
   }
 
   template <Fortran::common::TypeCategory TC1, int KIND,
             Fortran::common::TypeCategory TC2>
   ExtValue
   genval(const Fortran::evaluate::Convert<Fortran::evaluate::Type<TC1, KIND>,
                                           TC2> &convert) {
-    TODO(getLoc(), "genval convert<TC1, KIND, TC2>");
+    mlir::Type ty = converter.genType(TC1, KIND);
+    mlir::Value operand = genunbox(convert.left());
+    return builder.convertWithSemantics(getLoc(), ty, operand);
   }
 
   template <typename A>
   ExtValue genval(const Fortran::evaluate::Parentheses<A> &op) {
     TODO(getLoc(), "genval parentheses<A>");
   }
 
   template <int KIND>
fir::ExtendedValue genval(
     TODO(getLoc(), "genval constant derived");
   }
 
   template <typename A>
   ExtValue genval(const Fortran::evaluate::ArrayConstructor<A> &) {
     TODO(getLoc(), "genval ArrayConstructor<A>");
   }
 
+  ExtValue gen(const Fortran::evaluate::ComplexPart &x) {
+    TODO(getLoc(), "gen ComplexPart");
+  }
   ExtValue genval(const Fortran::evaluate::ComplexPart &x) {
     TODO(getLoc(), "genval ComplexPart");
   }
 
+  ExtValue gen(const Fortran::evaluate::Substring &s) {
+    TODO(getLoc(), "gen Substring");
+  }
   ExtValue genval(const Fortran::evaluate::Substring &ss) {
     TODO(getLoc(), "genval Substring");
   }
 
   ExtValue genval(const Fortran::evaluate::Subscript &subs) {
     TODO(getLoc(), "genval Subscript");
   }
 
+  ExtValue gen(const Fortran::evaluate::DataRef &dref) {
+    TODO(getLoc(), "gen DataRef");
+  }
   ExtValue genval(const Fortran::evaluate::DataRef &dref) {
     TODO(getLoc(), "genval DataRef");
   }
 
+  ExtValue gen(const Fortran::evaluate::Component &cmpt) {
+    TODO(getLoc(), "gen Component");
+  }
   ExtValue genval(const Fortran::evaluate::Component &cmpt) {
     TODO(getLoc(), "genval Component");
   }
 
   ExtValue genval(const Fortran::semantics::Bound &bound) {
     TODO(getLoc(), "genval Bound");
   }
 
+  ExtValue gen(const Fortran::evaluate::ArrayRef &aref) {
+    TODO(getLoc(), "gen ArrayRef");
+  }
   ExtValue genval(const Fortran::evaluate::ArrayRef &aref) {
     TODO(getLoc(), "genval ArrayRef");
   }
 
+  ExtValue gen(const Fortran::evaluate::CoarrayRef &coref) {
+    TODO(getLoc(), "gen CoarrayRef");
+  }
   ExtValue genval(const Fortran::evaluate::CoarrayRef &coref) {
     TODO(getLoc(), "genval CoarrayRef");
   }
 
   template <typename A>
+  ExtValue gen(const Fortran::evaluate::Designator<A> &des) {
+    return std::visit([&](const auto &x) { return gen(x); }, des.u);
+  }
+  template <typename A>
   ExtValue genval(const Fortran::evaluate::Designator<A> &des) {
     return std::visit([&](const auto &x) { return genval(x); }, des.u);
   }
 
   template <typename A>
+  ExtValue gen(const Fortran::evaluate::FunctionRef<A> &funcRef) {
+    TODO(getLoc(), "gen FunctionRef<A>");
+  }
+
+  template <typename A>
   ExtValue genval(const Fortran::evaluate::FunctionRef<A> &funcRef) {
     TODO(getLoc(), "genval FunctionRef<A>");
   }
 
   ExtValue genval(const Fortran::evaluate::ProcedureRef &procRef) {
     TODO(getLoc(), "genval ProcedureRef");
   }
 
   template <typename A>
-  bool isScalar(const A &x) {
-    return x.Rank() == 0;
-  }
-
-  template <typename A>
   ExtValue genval(const Fortran::evaluate::Expr<A> &x) {
     if (isScalar(x))
       return std::visit([&](const auto &e) { return genval(e); }, x.u);
     TODO(getLoc(), "genval Expr<A> arrays");
   }
 
+  /// Helper to detect Transformational function reference.
+  template <typename T>
+  bool isTransformationalRef(const T &) {
+    return false;
+  }
+  template <typename T>
+  bool isTransformationalRef(const Fortran::evaluate::FunctionRef<T> &funcRef) {
+    return !funcRef.IsElemental() && funcRef.Rank();
+  }
+  template <typename T>
+  bool isTransformationalRef(Fortran::evaluate::Expr<T> expr) {
+    return std::visit([&](const auto &e) { return isTransformationalRef(e); },
+                      expr.u);
+  }
+
+  template <typename A>
+  ExtValue gen(const Fortran::evaluate::Expr<A> &x) {
+    // Whole array symbols or components, and results of transformational
+    // functions already have a storage and the scalar expression lowering path
+    // is used to not create a new temporary storage.
+    if (isScalar(x) ||
+        Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(x) ||
+        isTransformationalRef(x))
+      return std::visit([&](const auto &e) { return genref(e); }, x.u);
+    TODO(getLoc(), "gen Expr non-scalar");
+  }
+
+  template <typename A>
+  bool isScalar(const A &x) {
+    return x.Rank() == 0;
+  }
+
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
                       Fortran::common::TypeCategory::Logical, KIND>> &exp) {
     return std::visit([&](const auto &e) { return genval(e); }, exp.u);
   }
 
+  using RefSet =
+      std::tuple<Fortran::evaluate::ComplexPart, Fortran::evaluate::Substring,
+                 Fortran::evaluate::DataRef, Fortran::evaluate::Component,
+                 Fortran::evaluate::ArrayRef, Fortran::evaluate::CoarrayRef,
+                 Fortran::semantics::SymbolRef>;
+  template <typename A>
+  static constexpr bool inRefSet = Fortran::common::HasMember<A, RefSet>;
+
+  template <typename A, typename = std::enable_if_t<inRefSet<A>>>
+  ExtValue genref(const A &a) {
+    return gen(a);
+  }
+  template <typename A>
+  ExtValue genref(const A &a) {
+    mlir::Type storageType = converter.genType(toEvExpr(a));
+    return placeScalarValueInMemory(builder, getLoc(), genval(a), storageType);
+  }
+
+  template <typename A, template <typename> typename T,
+            typename B = std::decay_t<T<A>>,
+            std::enable_if_t<
+                std::is_same_v<B, Fortran::evaluate::Expr<A>> ||
+                    std::is_same_v<B, Fortran::evaluate::Designator<A>> ||
+                    std::is_same_v<B, Fortran::evaluate::FunctionRef<A>>,
+                bool> = true>
+  ExtValue genref(const T<A> &x) {
+    return gen(x);
+  }
+
 private:
   mlir::Location location;
   Fortran::lower::AbstractConverter &converter;
   fir::FirOpBuilder &builder;
   Fortran::lower::SymMap &symMap;
 };
 } // namespace
 
 fir::ExtendedValue Fortran::lower::createSomeExtendedExpression(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
   LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n');
   return ScalarExprLowering{loc, converter, symMap}.genval(expr);
 }
+
+fir::ExtendedValue Fortran::lower::createSomeExtendedAddress(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
+  LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "address: ") << '\n');
+  return ScalarExprLowering{loc, converter, symMap}.gen(expr);
+}

flang/lib/Lower/ConvertType.cpp

 //===-- ConvertType.cpp ---------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Support/Utils.h"
 #include "flang/Lower/Todo.h"
-#include "flang/Lower/Utils.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
 
 #define DEBUG_TYPE "flang-lower-type"
 

 
 /// Discover the type of an Fortran::evaluate::Expr<T> and convert it to an
 /// mlir::Type. The type returned may be an MLIR standard or FIR type.
 class TypeBuilder {
 public:
   TypeBuilder(Fortran::lower::AbstractConverter &converter)
       : converter{converter}, context{&converter.getMLIRContext()} {}
 
+  mlir::Type genExprType(const Fortran::lower::SomeExpr &expr) {
+    std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
+    if (!dynamicType)
+      return genTypelessExprType(expr);
+    Fortran::common::TypeCategory category = dynamicType->category();
+
+    mlir::Type baseType;
+    if (category == Fortran::common::TypeCategory::Derived) {
+      TODO(converter.getCurrentLocation(), "genExprType derived");
+    } else {
+      // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
+      baseType = genFIRType(context, category, dynamicType->kind());
+    }
+    std::optional<Fortran::evaluate::Shape> shapeExpr =
+        Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
+    fir::SequenceType::Shape shape;
+    if (shapeExpr) {
+      translateShape(shape, std::move(*shapeExpr));
+    } else {
+      // Shape static analysis cannot return something useful for the shape.
+      // Use unknown extents.
+      int rank = expr.Rank();
+      if (rank < 0)
+        TODO(converter.getCurrentLocation(),
+             "Assumed rank expression type lowering");
+      for (int dim = 0; dim < rank; ++dim)
+        shape.emplace_back(fir::SequenceType::getUnknownExtent());
+    }
+    if (!shape.empty())
+      return fir::SequenceType::get(shape, baseType);
+    return baseType;
+  }
+
   template <typename A>
   void translateShape(A &shape, Fortran::evaluate::Shape &&shapeExpr) {
     for (Fortran::evaluate::MaybeExtentExpr extentExpr : shapeExpr) {
       fir::SequenceType::Extent extent = fir::SequenceType::getUnknownExtent();
       if (std::optional<std::int64_t> constantExtent =
               toInt64(std::move(extentExpr)))
         extent = *constantExtent;
       shape.push_back(extent);
     }
   }
 
   template <typename A>
   std::optional<std::int64_t> toInt64(A &&expr) {
     return Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
         converter.getFoldingContext(), std::move(expr)));
   }
 
+  mlir::Type genTypelessExprType(const Fortran::lower::SomeExpr &expr) {
+    return std::visit(
+        Fortran::common::visitors{
+            [&](const Fortran::evaluate::BOZLiteralConstant &) -> mlir::Type {
+              return mlir::NoneType::get(context);
+            },
+            [&](const Fortran::evaluate::NullPointer &) -> mlir::Type {
+              return fir::ReferenceType::get(mlir::NoneType::get(context));
+            },
+            [&](const Fortran::evaluate::ProcedureDesignator &proc)
+                -> mlir::Type {
+              TODO(converter.getCurrentLocation(),
+                   "genTypelessExprType ProcedureDesignator");
+            },
+            [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
+              return mlir::NoneType::get(context);
+            },
+            [](const auto &x) -> mlir::Type {
+              using T = std::decay_t<decltype(x)>;
+              static_assert(!Fortran::common::HasMember<
+                                T, Fortran::evaluate::TypelessExpression>,
+                            "missing typeless expr handling in type lowering");
+              llvm::report_fatal_error("not a typeless expression");
+            },
+        },
+        expr.u);
+  }
+
   mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
                            bool isAlloc = false, bool isPtr = false) {
     mlir::Location loc = converter.genLocation(symbol.name());
     mlir::Type ty;
     // If the symbol is not the same as the ultimate one (i.e, it is host or use
     // associated), all the symbol properties are the ones of the ultimate
     // symbol but the volatile and asynchronous attributes that may differ. To
     // avoid issues with helper functions that would not follow association

 
 mlir::Type Fortran::lower::translateDataRefToFIRType(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::evaluate::DataRef &dataRef) {
   return TypeBuilder{converter}.gen(dataRef);
 }
 
 mlir::Type Fortran::lower::translateSomeExprToFIRType(
-    Fortran::lower::AbstractConverter &converter, const SomeExpr *expr) {
-  return TypeBuilder{converter}.gen(*expr);
+    Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
+  return TypeBuilder{converter}.genExprType(expr);
 }
 
 mlir::Type Fortran::lower::translateSymbolToFIRType(
     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
   return TypeBuilder{converter}.genSymbolType(symbol);
 }
 
 mlir::Type Fortran::lower::translateVariableToFIRType(

flang/lib/Lower/Mangler.cpp

 //===-- Mangler.cpp -------------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Mangler.h"
 #include "flang/Common/reference.h"
+#include "flang/Lower/Support/Utils.h"
 #include "flang/Lower/Todo.h"
-#include "flang/Lower/Utils.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Optimizer/Support/InternalNames.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/ADT/ArrayRef.h"
 #include "llvm/ADT/Optional.h"
 #include "llvm/ADT/SmallVector.h"
 #include "llvm/ADT/StringRef.h"
 #include "llvm/ADT/Twine.h"

flang/test/Lower/assignment.f90

+! RUN: bbc %s -o "-" -emit-fir | FileCheck %s
+
+subroutine sub1(a)
+  integer :: a
+  a = 1
+end
+
+! CHECK-LABEL: func @_QPsub1(
+! CHECK-SAME:    %[[ARG0:.*]]: !fir.ref<i32>
+! CHECK:         %[[C1:.*]] = arith.constant 1 : i32
+! CHECK:         fir.store %[[C1]] to %[[ARG0]] : !fir.ref<i32>
+
+subroutine sub2(a, b)
+  integer(4) :: a
+  integer(8) :: b
+  a = b
+end
+
+! CHECK-LABEL: func @_QPsub2(
+! CHECK:         %[[A:.*]]: !fir.ref<i32> {fir.bindc_name = "a"}
+! CHECK:         %[[B:.*]]: !fir.ref<i64> {fir.bindc_name = "b"}
+! CHECK:         %[[B_VAL:.*]] = fir.load %arg1 : !fir.ref<i64>
+! CHECK:         %[[B_CONV:.*]] = fir.convert %[[B_VAL]] : (i64) -> i32
+! CHECK:         fir.store %[[B_CONV]] to %[[A]] : !fir.ref<i32>