[flang] Finish substring lowering

[jeanPerier]

Summary

Hlfir.designate was made to support substrings but so far substrings
were not yet lowered to it. Implement support for them.

[PeteSteinfeld]

Other than the one nit, all builds and tests correctly and looks good.

flang/lib/Lower/ConvertExprToHLFIR.cpp

178–181

Braces aren't needed for the "then" part of this "if".

[vzakhari]

flang/lib/Lower/ConvertExprToHLFIR.cpp

178–181

Pete, it is actually required by LLVM coding style (https://llvm.org/docs/CodingStandards.html#don-t-use-braces-on-simple-single-statement-bodies-of-if-else-loop-statements):

// Use braces for the `if` block to keep it uniform with the `else` block.
if (isa<FunctionDecl>(D)) {
  handleFunctionDecl(D);
} else {
  // In this `else` case, it is necessary that we explain the situation with
  // this surprisingly long comment, so it would be unclear without the braces
  // whether the following statement is in the scope of the `if`.
  handleOtherDecl(D);
}

[PeteSteinfeld]

flang/lib/Lower/ConvertExprToHLFIR.cpp

178–181

Thanks for letting me know!

flang/include/flang/Optimizer/Builder/Character.h

public:
   void createPadding(const fir::CharBoxValue &str, mlir::Value lower,
                      mlir::Value upper);
 
   /// Create str(lb:ub), lower bounds must always be specified, upper
   /// bound is optional.
   fir::CharBoxValue createSubstring(const fir::CharBoxValue &str,
                                     llvm::ArrayRef<mlir::Value> bounds);
 
+  /// Compute substring base address given the raw address (not fir.boxchar) of
+  /// a scalar string, a substring / lower bound, and the substring type.
+  mlir::Value genSubstringBase(mlir::Value stringRawAddr,
+                               mlir::Value lowerBound,
+                               mlir::Type substringAddrType,
+                               mlir::Value one = {});
+
   /// Return blank character of given \p type !fir.char<kind>
   mlir::Value createBlankConstant(fir::CharacterType type);
 
   /// Lower \p lhs = \p rhs where \p lhs and \p rhs are scalar characters.
   /// It handles cases where \p lhs and \p rhs may overlap.
   void createAssign(const fir::ExtendedValue &lhs,
                     const fir::ExtendedValue &rhs);
 

flang/include/flang/Optimizer/Builder/HLFIRTools.h

 /// Function to translate FortranVariableOpInterface to fir::ExtendedValue.
 /// It may generates IR to unbox fir.boxchar, but has otherwise no side effects
 /// on the IR.
 fir::ExtendedValue
 translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
                          fir::FortranVariableOpInterface fortranVariable);
 
 /// Generate declaration for a fir::ExtendedValue in memory.
-EntityWithAttributes genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
+fir::FortranVariableOpInterface genDeclare(mlir::Location loc,
+                                           fir::FirOpBuilder &builder,
                                            const fir::ExtendedValue &exv,
                                            llvm::StringRef name,
                                            fir::FortranVariableFlagsAttr flags);
 
 /// Generate an hlfir.associate to build a variable from an expression value.
 /// The type of the variable must be provided so that scalar logicals are
 /// properly typed when placed in memory.
 hlfir::AssociateOp genAssociateExpr(mlir::Location loc,
                                     fir::FirOpBuilder &builder,
                                     hlfir::Entity value,
                                     mlir::Type variableType,
llvm::SmallVector<mlir::Value> getIndexExtents(mlir::Location loc,
                                                fir::FirOpBuilder &builder,
                                                mlir::Value shape);
 
 /// Read length parameters into result if this entity has any.
 void genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
                          Entity entity,
                          llvm::SmallVectorImpl<mlir::Value> &result);
 
+/// Get the length of a character entity. Crashes if the entity is not
+/// a character entity.
+mlir::Value genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,
+                          Entity entity);
+
 /// Return the fir base, shape, and type parameters for a variable. Note that
 /// type parameters are only added if the entity is not a box and the type
 /// parameters is not a constant in the base type. This matches the arguments
 /// expected by fir.embox/fir.array_coor.
 std::pair<mlir::Value, mlir::Value> genVariableFirBaseShapeAndParams(
     mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,
     llvm::SmallVectorImpl<mlir::Value> &typeParams);
 

flang/lib/Lower/ConvertExprToHLFIR.cpp

 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/IntrinsicCall.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/Complex.h"
 #include "flang/Optimizer/Builder/Runtime/Character.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "llvm/ADT/TypeSwitch.h"
 
 namespace {
 
 /// Lower Designators to HLFIR.
 class HlfirDesignatorBuilder {
 public:
   HlfirDesignatorBuilder(mlir::Location loc,
                          Fortran::lower::AbstractConverter &converter,
using OtherDesignators =
       decltype(Fortran::evaluate::Designator<Fortran::evaluate::Type<
                    Fortran::evaluate::TypeCategory::Integer, 4>>::u);
   hlfir::EntityWithAttributes gen(const OtherDesignators &designatorVariant) {
     return std::visit(
         [&](const auto &x) -> hlfir::EntityWithAttributes { return gen(x); },
         designatorVariant);
   }
 
+  hlfir::EntityWithAttributes
+  gen(const Fortran::evaluate::NamedEntity &namedEntity) {
+    if (namedEntity.IsSymbol())
+      return gen(Fortran::evaluate::SymbolRef{namedEntity.GetLastSymbol()});
+    return gen(namedEntity.GetComponent());
+  }
+
 private:
   /// Struct that is filled while visiting a part-ref (in the "visit" member
   /// function) before the top level "gen" generates an hlfir.declare for the
   /// part ref. It contains the lowered pieces of the part-ref that will
   /// become the operands of an hlfir.declare.
   struct PartInfo {
     fir::FortranVariableOpInterface base;
     hlfir::DesignateOp::Subscripts subscripts;
     mlir::Value resultShape;
     llvm::SmallVector<mlir::Value> typeParams;
+    llvm::SmallVector<mlir::Value, 2> substring;
   };
 
   /// Generate an hlfir.declare for a part-ref given a filled PartInfo and the
   /// FIR type for this part-ref.
   fir::FortranVariableOpInterface genDeclare(mlir::Type resultValueType,
                                              PartInfo &partInfo) {
     // Compute hlfir.declare result type.
     // TODO: ensure polymorphic aspect of base of component  will be
if (charType && charType.hasDynamicLen())
           fir::BoxCharType::get(charType.getContext(), charType.getFKind());
     else if (resultValueType.isa<fir::SequenceType>() ||
              fir::hasDynamicSize(resultValueType))
       resultType = fir::BoxType::get(resultValueType);
     else
       resultType = fir::ReferenceType::get(resultValueType);
 
     std::optional<bool> complexPart;
-    llvm::SmallVector<mlir::Value> substring;
     auto designate = getBuilder().create<hlfir::DesignateOp>(
         getLoc(), resultType, partInfo.base.getBase(), "",
-        /*componentShape=*/mlir::Value{}, partInfo.subscripts, substring,
-        complexPart, partInfo.resultShape, partInfo.typeParams);
+        /*componentShape=*/mlir::Value{}, partInfo.subscripts,
+        partInfo.substring, complexPart, partInfo.resultShape,
+        partInfo.typeParams);
     return mlir::cast<fir::FortranVariableOpInterface>(
         designate.getOperation());
   }
 
   fir::FortranVariableOpInterface
   gen(const Fortran::evaluate::SymbolRef &symbolRef) {
     if (llvm::Optional<fir::FortranVariableOpInterface> varDef =
             getSymMap().lookupVariableDefinition(symbolRef))
hlfir::EntityWithAttributes gen(const Fortran::evaluate::ArrayRef &arrayRef) {
     mlir::Type resultType = visit(arrayRef, partInfo);
     return genDeclare(resultType, partInfo);
   }
 
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::CoarrayRef &coarrayRef) {
     TODO(getLoc(), "lowering CoarrayRef to HLFIR");
   }
+  mlir::Type visit(const Fortran::evaluate::CoarrayRef &, PartInfo &) {
+    TODO(getLoc(), "lowering CoarrayRef to HLFIR");
+  }
 
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::ComplexPart &complexPart) {
     TODO(getLoc(), "lowering complex part to HLFIR");
   }
 
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::Substring &substring) {
-    TODO(getLoc(), "lowering substrings to HLFIR");
+    PartInfo partInfo;
+    mlir::Type baseStringType = std::visit(
+        [&](const auto &x) { return visit(x, partInfo); }, substring.parent());
+    assert(partInfo.typeParams.size() == 1 && "expect base string length");
+    // Compute the substring lower and upper bound.
+    partInfo.substring.push_back(genSubscript(substring.lower()));
+    if (Fortran::evaluate::MaybeExtentExpr upperBound = substring.upper())
+      partInfo.substring.push_back(genSubscript(*upperBound));
+    else
+      partInfo.substring.push_back(partInfo.typeParams[0]);
+    fir::FirOpBuilder &builder = getBuilder();
+    mlir::Location loc = getLoc();
+    mlir::Type idxTy = builder.getIndexType();
+    partInfo.substring[0] =
+        builder.createConvert(loc, idxTy, partInfo.substring[0]);
+    partInfo.substring[1] =
+        builder.createConvert(loc, idxTy, partInfo.substring[1]);
+    // Try using constant length if available. mlir::arith folding would
+    // most likely be able to fold "max(ub-lb+1,0)" too, but getting
+    // the constant length in the FIR types would be harder.
+    std::optional<int64_t> cstLen =
+        Fortran::evaluate::ToInt64(Fortran::evaluate::Fold(
+            getConverter().getFoldingContext(), substring.LEN()));
+    if (cstLen) {
+      partInfo.typeParams[0] =
+          builder.createIntegerConstant(loc, idxTy, *cstLen);
+    } else {
+      // Compute "len = max(ub-lb+1,0)" (Fortran 2018 9.4.1).
+      mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+      auto boundsDiff = builder.create<mlir::arith::SubIOp>(
+          loc, partInfo.substring[1], partInfo.substring[0]);
+      auto rawLen = builder.create<mlir::arith::AddIOp>(loc, boundsDiff, one);
+      partInfo.typeParams[0] =
+          fir::factory::genMaxWithZero(builder, loc, rawLen);
+    }
+    mlir::Type resultType = changeLengthInCharacterType(
+        loc, baseStringType,
+        cstLen ? *cstLen : fir::CharacterType::unknownLen());
+    return genDeclare(resultType, partInfo);
+  }
+
+  static mlir::Type changeLengthInCharacterType(mlir::Location loc,
+                                                mlir::Type type,
+                                                int64_t newLen) {
+    return llvm::TypeSwitch<mlir::Type, mlir::Type>(type)
+        .Case<fir::CharacterType>([&](fir::CharacterType charTy) -> mlir::Type {
+          return fir::CharacterType::get(charTy.getContext(), charTy.getFKind(),
+                                         newLen);
+        })
+        .Case<fir::SequenceType>([&](fir::SequenceType seqTy) -> mlir::Type {
+          return fir::SequenceType::get(
+              seqTy.getShape(),
+              changeLengthInCharacterType(loc, seqTy.getEleTy(), newLen));
+        })
+        .Case<fir::PointerType, fir::HeapType, fir::ReferenceType,
+              fir::BoxType>([&](auto t) -> mlir::Type {
+          using FIRT = decltype(t);
+          return FIRT::get(
+              changeLengthInCharacterType(loc, t.getEleTy(), newLen));
+        })
+        .Default([loc](mlir::Type t) -> mlir::Type {
+          fir::emitFatalError(loc, "expected character type");
+        });
+  }
+
+  mlir::Type visit(const Fortran::evaluate::DataRef &dataRef,
+                   PartInfo &partInfo) {
+    return std::visit([&](const auto &x) { return visit(x, partInfo); },
+                      dataRef.u);
+  }
+
+  mlir::Type
+  visit(const Fortran::evaluate::StaticDataObject::Pointer &staticObject,
+        PartInfo &partInfo) {
+    fir::FirOpBuilder &builder = getBuilder();
+    mlir::Location loc = getLoc();
+    std::optional<std::string> string = staticObject->AsString();
+    // TODO: see if StaticDataObject can be replaced by something based on
+    // Constant<T> to avoid dealing with endianness here for KIND>1.
+    // This will also avoid making string copies here.
+    if (!string)
+      TODO(loc, "StaticDataObject::Pointer substring with kind > 1");
+    fir::ExtendedValue exv =
+        fir::factory::createStringLiteral(builder, getLoc(), *string);
+    auto flags = fir::FortranVariableFlagsAttr::get(
+        builder.getContext(), fir::FortranVariableFlagsEnum::parameter);
+    partInfo.base = hlfir::genDeclare(loc, builder, exv, ".stringlit", flags);
+    partInfo.typeParams.push_back(fir::getLen(exv));
+    return partInfo.base.getElementOrSequenceType();
   }
 
   mlir::Type visit(const Fortran::evaluate::SymbolRef &symbolRef,
                    PartInfo &partInfo) {
     partInfo.base = gen(symbolRef);
     hlfir::genLengthParameters(getLoc(), getBuilder(), partInfo.base,
                                partInfo.typeParams);
     return partInfo.base.getElementOrSequenceType();
private:
   }
 
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::TypeParamInquiry &) {
     TODO(getLoc(), "lowering type parameter inquiry to HLFIR");
   }
 
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::DescriptorInquiry &desc) {
-    TODO(getLoc(), "lowering descriptor inquiry to HLFIR");
+    mlir::Location loc = getLoc();
+    auto &builder = getBuilder();
+    hlfir::EntityWithAttributes entity =
+        HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
+                               getStmtCtx())
+            .gen(desc.base());
+    using ResTy = Fortran::evaluate::DescriptorInquiry::Result;
+    mlir::Type resultType =
+        getConverter().genType(ResTy::category, ResTy::kind);
+    auto castResult = [&](mlir::Value v) {
+      return hlfir::EntityWithAttributes{
+          builder.createConvert(loc, resultType, v)};
+    };
+    switch (desc.field()) {
+    case Fortran::evaluate::DescriptorInquiry::Field::Len:
+      return castResult(hlfir::genCharLength(loc, builder, entity));
+    case Fortran::evaluate::DescriptorInquiry::Field::LowerBound:
+      TODO(loc, "lower bound inquiry in HLFIR");
+    case Fortran::evaluate::DescriptorInquiry::Field::Extent:
+      TODO(loc, "extent inquiry in HLFIR");
+    case Fortran::evaluate::DescriptorInquiry::Field::Rank:
+      TODO(loc, "rank inquiry on assumed rank");
+    case Fortran::evaluate::DescriptorInquiry::Field::Stride:
+      // So far the front end does not generate this inquiry.
+      TODO(loc, "stride inquiry");
+    }
+    llvm_unreachable("unknown descriptor inquiry");
   }
 
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::ImpliedDoIndex &var) {
     TODO(getLoc(), "lowering implied do index to HLFIR");
   }
 
   hlfir::EntityWithAttributes

flang/lib/Optimizer/Builder/Character.cpp

fir::factory::DoLoopHelper{builder, loc}.createLoop(
       [&](fir::FirOpBuilder &bldr, mlir::Value index) {
         auto rhsIndex = bldr.create<mlir::arith::SubIOp>(loc, index, lhsLenIdx);
         auto charVal = createLoadCharAt(fromBuff, rhsIndex);
         createStoreCharAt(toBuff, index, charVal);
       });
   return temp;
 }
 
+mlir::Value fir::factory::CharacterExprHelper::genSubstringBase(
+    mlir::Value stringRawAddr, mlir::Value lowerBound,
+    mlir::Type substringAddrType, mlir::Value one) {
+  if (!one)
+    one = builder.createIntegerConstant(loc, lowerBound.getType(), 1);
+  auto offset =
+      builder.create<mlir::arith::SubIOp>(loc, lowerBound, one).getResult();
+  auto addr = createElementAddr(stringRawAddr, offset);
+  return builder.createConvert(loc, substringAddrType, addr);
+}
+
 fir::CharBoxValue fir::factory::CharacterExprHelper::createSubstring(
     const fir::CharBoxValue &box, llvm::ArrayRef<mlir::Value> bounds) {
   // Constant need to be materialize in memory to use fir.coordinate_of.
   auto nbounds = bounds.size();
   if (nbounds < 1 || nbounds > 2) {
     mlir::emitError(loc, "Incorrect number of bounds in substring");
     return {mlir::Value{}, mlir::Value{}};
   }
   mlir::SmallVector<mlir::Value> castBounds;
   // Convert bounds to length type to do safe arithmetic on it.
   for (auto bound : bounds)
     castBounds.push_back(
         builder.createConvert(loc, builder.getCharacterLengthType(), bound));
   auto lowerBound = castBounds[0];
   // FIR CoordinateOp is zero based but Fortran substring are one based.
-  auto one = builder.createIntegerConstant(loc, lowerBound.getType(), 1);
-  auto offset =
-      builder.create<mlir::arith::SubIOp>(loc, lowerBound, one).getResult();
-  auto addr = createElementAddr(box.getBuffer(), offset);
   auto kind = getCharacterKind(box.getBuffer().getType());
   auto charTy = fir::CharacterType::getUnknownLen(builder.getContext(), kind);
   auto resultType = builder.getRefType(charTy);
-  auto substringRef = builder.createConvert(loc, resultType, addr);
+  auto one = builder.createIntegerConstant(loc, lowerBound.getType(), 1);
+  auto substringRef =
+      genSubstringBase(box.getBuffer(), lowerBound, resultType, one);
 
   // Compute the length.
   mlir::Value substringLen;
   if (nbounds < 2) {
     substringLen =
         builder.create<mlir::arith::SubIOp>(loc, box.getLen(), castBounds[0]);
   } else {
     substringLen =

flang/lib/Optimizer/Builder/HLFIRTools.cpp

if (variable.isCharacter()) {
     return fir::CharBoxValue(firBase, variable.getExplicitCharLen());
   }
   if (variable.isArray())
     return fir::ArrayBoxValue(firBase, getExplicitExtents(variable),
                               getExplicitLbounds(variable));
   return firBase;
 }
 
-hlfir::EntityWithAttributes
+fir::FortranVariableOpInterface
 hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
                   const fir::ExtendedValue &exv, llvm::StringRef name,
                   fir::FortranVariableFlagsAttr flags) {
 
   mlir::Value base = fir::getBase(exv);
   assert(fir::conformsWithPassByRef(base.getType()) &&
          "entity being declared must be in memory");
   mlir::Value shapeOrShift;
if (entity.isCharacter()) {
     auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
     assert(!cleanup && "translation of entity should not yield cleanup");
     result.push_back(fir::factory::readCharLen(builder, loc, exv));
     return;
   }
   TODO(loc, "inquire PDTs length parameters in HLFIR");
 }
 
+mlir::Value hlfir::genCharLength(mlir::Location loc, fir::FirOpBuilder &builder,
+                                 hlfir::Entity entity) {
+  llvm::SmallVector<mlir::Value, 1> lenParams;
+  genLengthParameters(loc, builder, entity, lenParams);
+  assert(lenParams.size() == 1 && "characters must have one length parameters");
+  return lenParams[0];
+}
+
 std::pair<mlir::Value, mlir::Value> hlfir::genVariableFirBaseShapeAndParams(
     mlir::Location loc, fir::FirOpBuilder &builder, Entity entity,
     llvm::SmallVectorImpl<mlir::Value> &typeParams) {
   auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
   assert(!cleanup && "variable to Exv should not produce cleanup");
   if (entity.hasLengthParameters()) {
     auto params = fir::getTypeParams(exv);
     typeParams.append(params.begin(), params.end());

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

fir::ExtendedValue res =
         fir::factory::CharacterExprHelper{builder, loc}.createConcatenate(
             *lhsExv.getCharBox(), *rhsExv.getCharBox());
     // Ensure the memory type is the same as the result type.
     mlir::Type addrType = fir::ReferenceType::get(
         hlfir::getFortranElementType(concat.getResult().getType()));
     mlir::Value cast = builder.createConvert(loc, addrType, fir::getBase(res));
     res = fir::substBase(res, cast);
     auto hlfirTempRes = hlfir::genDeclare(loc, builder, res, "tmp",
-                                          fir::FortranVariableFlagsAttr{});
+                                          fir::FortranVariableFlagsAttr{})
+                            .getBase();
     mlir::Value bufferizedExpr =
         packageBufferizedExpr(loc, builder, hlfirTempRes, false);
     rewriter.replaceOp(concat, bufferizedExpr);
     return mlir::success();
   }
 };
 
 struct SetLengthOpConversion

flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp

 //===- ConvertToFIR.cpp - Convert HLFIR to FIR ----------------------------===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 // This file defines a pass to lower HLFIR to FIR
 //===----------------------------------------------------------------------===//
 
+#include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/HLFIRTools.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Runtime/Assign.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
public:
 
   mlir::LogicalResult
   matchAndRewrite(hlfir::DesignateOp designate,
                   mlir::PatternRewriter &rewriter) const override {
     mlir::Location loc = designate.getLoc();
     auto module = designate->getParentOfType<mlir::ModuleOp>();
     fir::FirOpBuilder builder(rewriter, fir::getKindMapping(module));
 
-    if (designate.getComponent() || designate.getComplexPart() ||
-        !designate.getSubstring().empty()) {
-      // build path.
-      TODO(loc, "hlfir::designate with complex part or substring or component");
-    }
+    if (designate.getComponent() || designate.getComplexPart())
+      TODO(loc, "hlfir::designate with complex part or component");
 
     hlfir::Entity baseEntity(designate.getMemref());
     if (baseEntity.isMutableBox())
       TODO(loc, "hlfir::designate load of pointer or allocatable");
 
     mlir::Type designateResultType = designate.getResult().getType();
     llvm::SmallVector<mlir::Value> firBaseTypeParameters;
     auto [base, shape] = hlfir::genVariableFirBaseShapeAndParams(
if (designateResultType.isa<fir::BoxType>()) {
         if (isTriplet) {
           triples.push_back(subscripts[i++]);
           triples.push_back(subscripts[i++]);
         } else {
           triples.push_back(undef);
           triples.push_back(undef);
         }
       }
+      llvm::SmallVector<mlir::Value, 2> substring;
+      if (!designate.getSubstring().empty()) {
+        substring.push_back(designate.getSubstring()[0]);
+        mlir::Type idxTy = builder.getIndexType();
+        // fir.slice op substring expects the zero based lower bound.
+        mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+        substring[0] = builder.createConvert(loc, idxTy, substring[0]);
+        substring[0] =
+            builder.create<mlir::arith::SubIOp>(loc, substring[0], one);
+        substring.push_back(designate.getTypeparams()[0]);
+      }
+
       mlir::Value slice = builder.create<fir::SliceOp>(
-          loc, triples, /*path=*/mlir::ValueRange{});
+          loc, triples, /*fields=*/mlir::ValueRange{}, substring);
       llvm::SmallVector<mlir::Type> resultType{designateResultType};
       mlir::Value resultBox;
       if (base.getType().isa<fir::BoxType>())
         resultBox =
             builder.create<fir::ReboxOp>(loc, resultType, base, shape, slice);
       else
         resultBox = builder.create<fir::EmboxOp>(loc, resultType, base, shape,
                                                  slice, firBaseTypeParameters);
       rewriter.replaceOp(designate, resultBox);
       return mlir::success();
     }
 
-    // Indexing a single element (use fir.array_coor of fir.coordinate_of).
+    // Otherwise, the result is the address of a scalar. The base may be an
+    // array, or a scalar.
+    mlir::Type resultAddressType = designateResultType;
+    if (auto boxCharType = designateResultType.dyn_cast<fir::BoxCharType>())
+      resultAddressType = fir::ReferenceType::get(boxCharType.getEleTy());
 
-    if (designate.getIndices().empty()) {
-      // Scalar substring or complex part.
-      // generate fir.coordinate_of.
-      TODO(loc, "hlfir::designate to fir.coordinate_of");
-    }
+    // Array element indexing.
+    if (!designate.getIndices().empty()) {
+      auto eleTy = hlfir::getFortranElementType(base.getType());
+      auto arrayCoorType = fir::ReferenceType::get(eleTy);
+      base = builder.create<fir::ArrayCoorOp>(loc, arrayCoorType, base, shape,
+                                              /*slice=*/mlir::Value{},
+                                              designate.getIndices(),
+                                              firBaseTypeParameters);
+    }
+
+    // Scalar substring (potentially on the previously built array element).
+    if (!designate.getSubstring().empty())
+      base = fir::factory::CharacterExprHelper{builder, loc}.genSubstringBase(
+          base, designate.getSubstring()[0], resultAddressType);
 
-    // Generate fir.array_coor
-    mlir::Type resultType = designateResultType;
-    if (auto boxCharType = designateResultType.dyn_cast<fir::BoxCharType>())
-      resultType = fir::ReferenceType::get(boxCharType.getEleTy());
-    auto arrayCoor = builder.create<fir::ArrayCoorOp>(
-        loc, resultType, base, shape,
-        /*slice=*/mlir::Value{}, designate.getIndices(), firBaseTypeParameters);
+    // Cast/embox the computed scalar address if needed.
     if (designateResultType.isa<fir::BoxCharType>()) {
       assert(designate.getTypeparams().size() == 1 &&
              "must have character length");
       auto emboxChar = builder.create<fir::EmboxCharOp>(
-          loc, designateResultType, arrayCoor, designate.getTypeparams()[0]);
+          loc, designateResultType, base, designate.getTypeparams()[0]);
       rewriter.replaceOp(designate, emboxChar.getResult());
     } else {
-      rewriter.replaceOp(designate, arrayCoor.getResult());
+      base = builder.createConvert(loc, designateResultType, base);
+      rewriter.replaceOp(designate, base);
     }
     return mlir::success();
   }
 };
 
 class NoReassocOpConversion
     : public mlir::OpRewritePattern<hlfir::NoReassocOp> {
 public:

flang/test/Lower/HLFIR/substrings.f90

+! Test lowering of substrings to HLFIR
+! Note: cse is run to make the expected output more readable by sharing
+! the boilerplate between the different susbtring cases.
+! RUN: bbc -emit-fir -hlfir -o - %s | fir-opt -cse -o - | FileCheck %s
+
+! CHECK-LABEL:   func.func @_QPcst_len(
+subroutine cst_len(array, scalar)
+  character(10) :: array(100), scalar
+! CHECK:  %[[VAL_5:.*]] = arith.constant 100 : index
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %{{.*}}(%[[VAL_6:.*]]) typeparams %[[VAL_3:[^ ]*]] {{.*}}array"
+! CHECK:  %[[VAL_9:.*]]:2 = hlfir.declare %{{.*}} typeparams %[[VAL_3]] {{.*}}scalar"
+  print *, array(:)(2:5)
+! CHECK:  %[[VAL_15:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_16:.*]] = arith.constant 2 : index
+! CHECK:  %[[VAL_17:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_18:.*]] = arith.constant 4 : index
+! CHECK:  %[[VAL_19:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_15]]:%[[VAL_5]]:%[[VAL_15]]) substr %[[VAL_16]], %[[VAL_17]]  shape %[[VAL_6]] typeparams %[[VAL_18]] : (!fir.ref<!fir.array<100x!fir.char<1,10>>>, index, index, index, index, index, !fir.shape<1>, index) -> !fir.box<!fir.array<100x!fir.char<1,4>>>
+
+  print *, array(42)(2:5)
+! CHECK:  %[[VAL_25:.*]] = arith.constant 42 : index
+! CHECK:  %[[VAL_26:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_25]]) substr %[[VAL_16]], %[[VAL_17]]  typeparams %[[VAL_18]] : (!fir.ref<!fir.array<100x!fir.char<1,10>>>, index, index, index, index) -> !fir.ref<!fir.char<1,4>>
+  print *, array(:)(2:)
+! CHECK:  %[[VAL_33:.*]] = arith.constant 9 : index
+! CHECK:  %[[VAL_34:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_15]]:%[[VAL_5]]:%[[VAL_15]]) substr %[[VAL_16]], %[[VAL_3]]  shape %[[VAL_6]] typeparams %[[VAL_33]] : (!fir.ref<!fir.array<100x!fir.char<1,10>>>, index, index, index, index, index, !fir.shape<1>, index) -> !fir.box<!fir.array<100x!fir.char<1,9>>>
+
+  print *, scalar(2:5)
+! CHECK:  %[[VAL_40:.*]] = hlfir.designate %[[VAL_9]]#0  substr %[[VAL_16]], %[[VAL_17]]  typeparams %[[VAL_18]] : (!fir.boxchar<1>, index, index, index) -> !fir.ref<!fir.char<1,4>>
+end subroutine
+
+! CHECK-LABEL:   func.func @_QPdyn_len(
+subroutine dyn_len(array, scalar, l, n, m, k)
+  integer(8) :: n,m,k
+! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare {{.*}}k"
+! CHECK:  %[[VAL_8:.*]]:2 = hlfir.declare {{.*}}m"
+! CHECK:  %[[VAL_9:.*]]:2 = hlfir.declare {{.*}}n"
+  character(l) :: array(:), scalar
+! CHECK:  %[[VAL_14:.*]]:2 = hlfir.declare %{{.*}} typeparams %[[VAL_13:[^ ]*]] {{.*}}array"
+! CHECK:  %[[VAL_19:.*]]:2 = hlfir.declare %{{.*}} typeparams %[[VAL_18:[^ ]*]] {{.*}}scalar"
+
+  print *, array(:)(n:m)
+! CHECK:  %[[VAL_25:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_26:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_27:.*]]:3 = fir.box_dims %[[VAL_14]]#1, %[[VAL_26]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_28:.*]] = arith.subi %[[VAL_27]]#1, %[[VAL_25]] : index
+! CHECK:  %[[VAL_29:.*]] = arith.addi %[[VAL_28]], %[[VAL_25]] : index
+! CHECK:  %[[VAL_30:.*]] = arith.divsi %[[VAL_29]], %[[VAL_25]] : index
+! CHECK:  %[[VAL_31:.*]] = arith.cmpi sgt, %[[VAL_30]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_32:.*]] = arith.select %[[VAL_31]], %[[VAL_30]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_33:.*]] = fir.shape %[[VAL_32]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_34:.*]] = fir.load %[[VAL_9]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_35:.*]] = fir.load %[[VAL_8]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_36:.*]] = fir.convert %[[VAL_34]] : (i64) -> index
+! CHECK:  %[[VAL_37:.*]] = fir.convert %[[VAL_35]] : (i64) -> index
+! CHECK:  %[[VAL_38:.*]] = arith.subi %[[VAL_37]], %[[VAL_36]] : index
+! CHECK:  %[[VAL_39:.*]] = arith.addi %[[VAL_38]], %[[VAL_25]] : index
+! CHECK:  %[[VAL_40:.*]] = arith.cmpi sgt, %[[VAL_39]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_41:.*]] = arith.select %[[VAL_40]], %[[VAL_39]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_42:.*]] = hlfir.designate %[[VAL_14]]#0 (%[[VAL_25]]:%[[VAL_27]]#1:%[[VAL_25]]) substr %[[VAL_36]], %[[VAL_37]]  shape %[[VAL_33]] typeparams %[[VAL_41]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index, index, index, index, index, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+
+  print *, array(k)(n:m)
+! CHECK:  %[[VAL_48:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_49:.*]] = fir.load %[[VAL_9]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_50:.*]] = fir.load %[[VAL_8]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_51:.*]] = fir.convert %[[VAL_49]] : (i64) -> index
+! CHECK:  %[[VAL_52:.*]] = fir.convert %[[VAL_50]] : (i64) -> index
+! CHECK:  %[[VAL_53:.*]] = arith.subi %[[VAL_52]], %[[VAL_51]] : index
+! CHECK:  %[[VAL_54:.*]] = arith.addi %[[VAL_53]], %[[VAL_25]] : index
+! CHECK:  %[[VAL_55:.*]] = arith.cmpi sgt, %[[VAL_54]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_56:.*]] = arith.select %[[VAL_55]], %[[VAL_54]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_57:.*]] = hlfir.designate %[[VAL_14]]#0 (%[[VAL_48]]) substr %[[VAL_51]], %[[VAL_52]]  typeparams %[[VAL_56]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, i64, index, index, index) -> !fir.boxchar<1>
+
+  print *, array(:)(n:)
+! CHECK:  %[[VAL_65:.*]] = fir.load %[[VAL_9]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_66:.*]] = fir.convert %[[VAL_13]] : (i32) -> i64
+! CHECK:  %[[VAL_67:.*]] = fir.convert %[[VAL_65]] : (i64) -> index
+! CHECK:  %[[VAL_68:.*]] = fir.convert %[[VAL_66]] : (i64) -> index
+! CHECK:  %[[VAL_69:.*]] = arith.subi %[[VAL_68]], %[[VAL_67]] : index
+! CHECK:  %[[VAL_70:.*]] = arith.addi %[[VAL_69]], %[[VAL_25]] : index
+! CHECK:  %[[VAL_71:.*]] = arith.cmpi sgt, %[[VAL_70]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_72:.*]] = arith.select %[[VAL_71]], %[[VAL_70]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_73:.*]] = hlfir.designate %[[VAL_14]]#0 (%[[VAL_25]]:%[[VAL_27]]#1:%[[VAL_25]]) substr %[[VAL_67]], %[[VAL_68]]  shape %[[VAL_33]] typeparams %[[VAL_72]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index, index, index, index, index, !fir.shape<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+
+  print *, scalar(n:m)
+! CHECK:  %[[VAL_79:.*]] = fir.load %[[VAL_9]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_80:.*]] = fir.load %[[VAL_8]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_81:.*]] = fir.convert %[[VAL_79]] : (i64) -> index
+! CHECK:  %[[VAL_82:.*]] = fir.convert %[[VAL_80]] : (i64) -> index
+! CHECK:  %[[VAL_83:.*]] = arith.subi %[[VAL_82]], %[[VAL_81]] : index
+! CHECK:  %[[VAL_84:.*]] = arith.addi %[[VAL_83]], %[[VAL_25]] : index
+! CHECK:  %[[VAL_85:.*]] = arith.cmpi sgt, %[[VAL_84]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_86:.*]] = arith.select %[[VAL_85]], %[[VAL_84]], %[[VAL_26]] : index
+! CHECK:  %[[VAL_87:.*]] = hlfir.designate %[[VAL_19]]#0  substr %[[VAL_81]], %[[VAL_82]]  typeparams %[[VAL_86]] : (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1>
+end subroutine
+
+subroutine test_static_substring(i, j)
+  integer(8) :: i, j
+  print *, "hello"(i:j)
+end subroutine
+! CHECK-LABEL:   func.func @_QPtest_static_substring(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %{{.*}}i"
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %{{.*}}j"
+! CHECK:  %[[VAL_10:.*]] = arith.constant 5 : index
+! CHECK:  %[[VAL_11:.*]]:2 = hlfir.declare %{{.*}} typeparams %[[VAL_10]] {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = ".stringlit"} : (!fir.ref<!fir.char<1,5>>, index) -> (!fir.ref<!fir.char<1,5>>, !fir.ref<!fir.char<1,5>>)
+! CHECK:  %[[VAL_12:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_13:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<i64>
+! CHECK:  %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (i64) -> index
+! CHECK:  %[[VAL_15:.*]] = fir.convert %[[VAL_13]] : (i64) -> index
+! CHECK:  %[[VAL_16:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_17:.*]] = arith.subi %[[VAL_15]], %[[VAL_14]] : index
+! CHECK:  %[[VAL_18:.*]] = arith.addi %[[VAL_17]], %[[VAL_16]] : index
+! CHECK:  %[[VAL_19:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_20:.*]] = arith.cmpi sgt, %[[VAL_18]], %[[VAL_19]] : index
+! CHECK:  %[[VAL_21:.*]] = arith.select %[[VAL_20]], %[[VAL_18]], %[[VAL_19]] : index
+! CHECK:  %[[VAL_22:.*]] = hlfir.designate %[[VAL_11]]#0  substr %[[VAL_14]], %[[VAL_15]]  typeparams %[[VAL_21]] : (!fir.ref<!fir.char<1,5>>, index, index, index) -> !fir.boxchar<1>

flang/unittests/Optimizer/Builder/HLFIRToolsTest.cpp

void SetUp() override {
     mod.push_back(mod);
     builder.setInsertionPointToStart(entryBlock);
 
     firBuilder = std::make_unique<fir::FirOpBuilder>(mod, kindMap);
   }
 
   mlir::Value createDeclare(fir::ExtendedValue exv) {
     return hlfir::genDeclare(getLoc(), *firBuilder, exv,
-        "x" + std::to_string(varCounter++), fir::FortranVariableFlagsAttr{});
+        "x" + std::to_string(varCounter++), fir::FortranVariableFlagsAttr{})
+        .getBase();
   }
 
   mlir::Value createConstant(std::int64_t cst) {
     mlir::Type indexType = firBuilder->getIndexType();
     return firBuilder->create<mlir::arith::ConstantOp>(
         getLoc(), indexType, firBuilder->getIntegerAttr(indexType, cst));
   }