[flang][fir] Upstream FIR dialect changes.

[schweitz]

Summary

FIR dialect changes.

1. Use more of the newer tablegen support for dialects that's been arriving in the mlir/ tree. This reduces/eliminates some older hand-written code, etc.
2. Improves documentation on some FIR ops.
3. Adds new ops to support a generalization of Fortran "parallel" array expression semantics.
4. Adds new ops to support leveraging of the Affine dialect in MLIR. This will allow Fortran codes to make use of the polyhedral model being built for TensorFlow, etc.
5. Miscellaneous renaming of ops and types.
6. Adds an opaque attribute for passing on-the-side data.
7. Various bug fixes.
8. Updates tests.

A history of all these sources, including all contributors, previous reviews and revisions, etc., can be found at https://github.com/flang-compiler/f18-llvm-project/

These diffs depend upon D95630.

[mehdi_amini]

Thanks! It is exciting to start seeing the FIR change coming upstream!

The patch is not easy to review right now though (also it does not build), it seems like mixing a lot of unrelated things and it makes it not easy to understand what is tested and how. It would be much easier to review the canonicalization pattern change with its own test in isolation. Similarly for the addition of new ops, and the inliner interface for example. There is a non trivial amount of hand-written verifier diagnostics that don't seem tested either?

flang/include/flang/Optimizer/Dialect/FIRAttr.h

137

I'm not sure how it works? How is the context reconstructed on reparsing these?

Also I don't see any test using such attribute right now, can you provide one?

flang/include/flang/Optimizer/Dialect/FIRDialect.h

49

I don't find a definition for these methods right now?

68

Why is this needed? In general this indicates a misconfiguration of the pipeline and shouldn't be used.

(also this method is not used in this patch)

flang/include/flang/Optimizer/Dialect/FIROps.td

1107

It'd be nice to have at least one test that parses all the fields as an example, and have it in the description here in ODS as well.

1110–1111

That's quite some C++ code in ODS. In general for non trivial method please replace with a call to a function implemented in the .cpp file: it plays much nicer with IDEs and debuggers.
(same below for the new ops you're introducing)

1449

Is the "shape" keyword a valid syntax? I'm not sure I understand from the declarative syntax above

1833

Are there tests for all these diagnostics?

flang/lib/Optimizer/Dialect/FIROps.cpp

135

This method is a bit strange: it returns result here but I don't see it ever modified?

If you only ever returns ranges of Value held by an operation, then ValueRange seems appropriate instead of std::vector<Value>

609

It isn't clear why this is needed?

732

I'd rather read a comment that just describes what the pattern is doing on a high level / a snippet of the replacement.

[schweitz]

flang/include/flang/Optimizer/Dialect/FIRDialect.h

49

See https://reviews.llvm.org/D95401

68

The test tools call this to register the dialects they'll use. If there is some preferred way of forcing that to happen, can you provide a pointer? Thanks.

[mehdi_amini]

flang/include/flang/Optimizer/Dialect/FIRDialect.h

49

OK, but this patch can't be built / tested at the moment in this state I think.

68

The dialect registered don't need to be loaded in the context, just inserting them should be enough for parsing any input containing these dialects.

If there are passes converting a dialect into another one, the destination dialect can be declared through https://mlir.llvm.org/docs/PassManagement/#dependent-dialects

[schweitz]

flang/include/flang/Optimizer/Dialect/FIRDialect.h

49

Per the feedback received on the flang community calls regarding the upstreaming plan, these diffs are meant to follow the proposed plan. The FIR "chunk" being broken down into a small series of linked reviews. In aggregate, the diffs compose a buildable and testable merge.

68

Thanks for the reference. It's not part of these diffs, but it is probably worth mentioning that the flang front-end is not structured as an MLIR pass.

[mehdi_amini]

flang/include/flang/Optimizer/Dialect/FIRDialect.h

49

Ah that wasn't clear to me what you were trying to do here.

I'm still not on-board with not landing these incrementally though. Many pieces in this patch can easily be split, tested, and landed independently of a large blob.

68

Ah right of course, but the loading (and so this function) should be located with the frontend components that will emit these dialects, not with the dialect itself.

Is the frontend really directly emitting all of the dialects above?

[schweitz]

flang/include/flang/Optimizer/Dialect/FIRAttr.h

137

This attribute allows us to attach a dictionary of on-the-side data structures to a ModuleOp. These data structures do not change the meaning of the FIR/MLIR representation but may be convenient in other ways.

For the sake of roundtripping, the exact nature of the objects being referenced is washed out. They effectively are optional attributes that roundtrip as "None" values.

We can certainly add a test.

flang/include/flang/Optimizer/Dialect/FIRDialect.h

68

This was a convenient place to put this list, which is shared in common between the bridge test tools.

We do use all of the dialects in the list.

flang/include/flang/Optimizer/Dialect/FIROps.td

1107

Agreed. That was the case, but as FIR has been developing and changing, some of these new options and ops should be added.

1110–1111

No problem.

1449

No, it is not. Thanks for pointing this out. Looks like a typo or 3 here.

1833

We are working on a set of negative diagnostic tests and will add them.

flang/lib/Optimizer/Dialect/FIROps.cpp

732

Sure. We can clean this up, make it clearer.

[schweitz]

flang/lib/Optimizer/Dialect/FIROps.cpp

135

Good points. We'll see if we can tweak this one.

609

Not sure what "this" refers to, but I assume you mean the check/test. This is older code--it may have been here since before MLIR was merged into the mono repo--that predates some of the improvements made to the autogenerated verification code in the last year or so. It may not longer be needed.

[mehdi_amini]

flang/lib/Optimizer/Dialect/FIROps.cpp

609

I meant that the only diff here (and on other lines in this patch) is adding mlir:: namespace prefix, however many other mlir Types aren't prefixed, so this seems unnecessary here unless there is some sort of ambiguity?

[SouraVX]

flang/lib/Optimizer/Dialect/FIRDialect.cpp

63–68

Is this intended ? some Types containing the prefix fir:: and some not ?

[schweitz]

flang/lib/Optimizer/Dialect/FIRDialect.cpp

63–68

Ah, right. The ones prefixed with fir:: have duplicate classes in other namespaces. So this future-proofs this code to make sure the correct classes are used.

[mehdi_amini]

(please ping when you get test coverage)

flang/include/flang/Optimizer/Dialect/FIRDialect.h

68

The list is fine, I'm mostly looking at the loading aspect: you could decouple this by having this function take a registry, and the caller be in charge of pre-loading or not (the frontend should pre-load, the opt testing should should not).
(Basically, keep the existing method as is, loading is a caller problem)

flang/include/flang/Optimizer/Dialect/FIRType.h

451

Can this all be defined in TableGen?

flang/test/Fir/fir-ops.fir

4

You're disabling the test here, what's happening?

flang/tools/tco/tco.cpp

64

I'm surprised you don't need this, the call to parseSourceFile right below should rely on dialects being registered?

[schweitz]

flang/test/Fir/fir-ops.fir

4

It gets re-enabled here. https://reviews.llvm.org/D95402#change-2yxFjt5wBEUu

[mehdi_amini]

flang/test/Fir/fir-ops.fir

4

Please try to organize patches that are scoped and tested individually, otherwise it is impossible to review and understand how things are tested and play together.

[schweitz]

As explained previously, the original 4 reviews (now 5) were subparts of the same comprehensive change set. That comprehensive patch is a coherent, logical set of changes to upstream the code generation pass that converts FIR to LLVM IR. It is complete, buildable, testable, comes with a raft of new tests, etc. It is big. Very big. Upstreaming being blocked for months has consequences.

This large change set was broken into multiple reviews in response to the feedback on how to proceed with the upstreaming process. Somewhat smaller chunks were suggested as potentially helpful. Again, this set of changes was therefore broken into 4 (now 5) logical subgroups.

It was then pointed out here in phabricator that the mutual dependence (circular references) between these subsections/reviews meant that each review did not build because of its dependences on the other subparts of the change set. That was true.

To address this issue, it required that all circular references be eliminated and that each subpart of these changes be dependent only on itself and its ancestors (not anything in the descendant changes). That was accomplished by adding a minimal number of "noise" changes to kneecap and/or scaffold out the subparts in a way that they would build without circular dependences. Of course, these process directed changes are cosmetic and confusing, which is why this was not originally presented that way.

If the reviewers are inclined, these sub-reviews can be abandoned and a single very large review, squashing the process noise, can replace them.

In the end, this change set (the 5 linked reviews) is one big pie, whether it is reviewed as a whole pie or by the bite.

[mehdi_amini]

In D95399#2530820, @schweitz wrote:

As explained previously, the original 4 reviews (now 5) were subparts of the same comprehensive change set. That comprehensive patch is a coherent, logical set of changes to upstream the code generation pass that converts FIR to LLVM IR.

I see it differently here, I see a lot of independent changes that should be reviewed, restructured to be tested appropriately, and upstreamed independently in a sequence.
Each individual pass could be a single patch with its own test for example.

There is no other way to have a review of these changes right now.

flang/include/flang/Optimizer/Dialect/FIRAttr.h

 //===-- Optimizer/Dialect/FIRAttr.h -- FIR attributes -----------*- 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
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #ifndef OPTIMIZER_DIALECT_FIRATTR_H
 #define OPTIMIZER_DIALECT_FIRATTR_H
 
-#include "mlir/IR/Attributes.h"
+#include "mlir/IR/BuiltinAttributes.h"
 
 namespace mlir {
 class DialectAsmParser;
 class DialectAsmPrinter;
 } // namespace mlir
 
 namespace fir {
 
 class FIROpsDialect;
 
 namespace detail {
+struct OpaqueAttributeStorage;
 struct RealAttributeStorage;
 struct TypeAttributeStorage;
 } // namespace detail
 
 class ExactTypeAttr
     : public mlir::Attribute::AttrBase<ExactTypeAttr, mlir::Attribute,
                                        detail::TypeAttributeStorage> {
 public:
public:
 
   static constexpr llvm::StringRef getAttrName() { return "real"; }
   static RealAttr get(mlir::MLIRContext *ctxt, const ValueType &key);
 
   int getFKind() const;
   llvm::APFloat getValue() const;
 };
 
+/// An opaque attribute is used to provide dictionary lookups of pointers. The
+/// underlying type of the pointee object is left up to the client. Opaque
+/// attributes are always constructed as null pointers when parsing.
+class OpaqueAttr
+    : public mlir::Attribute::AttrBase<OpaqueAttr, mlir::Attribute,
+                                       detail::OpaqueAttributeStorage> {
+public:
+  using Base::Base;
+
+  static constexpr llvm::StringRef getAttrName() { return "opaque"; }
+  static OpaqueAttr get(mlir::MLIRContext *ctxt, void *pointer);
+
+  void *getPointer() const;
+};
+
 mlir::Attribute parseFirAttribute(FIROpsDialect *dialect,
                                   mlir::DialectAsmParser &parser,
                                   mlir::Type type);
 
 void printFirAttribute(FIROpsDialect *dialect, mlir::Attribute attr,
                        mlir::DialectAsmPrinter &p);
 
 } // namespace fir
 
 #endif // OPTIMIZER_DIALECT_FIRATTR_H

flang/include/flang/Optimizer/Dialect/FIRDialect.h

 //===-- Optimizer/Dialect/FIRDialect.h -- FIR dialect -----------*- 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
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #ifndef OPTIMIZER_DIALECT_FIRDIALECT_H
 #define OPTIMIZER_DIALECT_FIRDIALECT_H
 
+#include "mlir/Conversion/Passes.h"
+#include "mlir/Dialect/Affine/Passes.h"
 #include "mlir/IR/Dialect.h"
 #include "mlir/InitAllDialects.h"
-#include "mlir/InitAllPasses.h"
+#include "mlir/Pass/Pass.h"
+#include "mlir/Pass/PassRegistry.h"
+#include "mlir/Transforms/LocationSnapshot.h"
+#include "mlir/Transforms/Passes.h"
 
 namespace fir {
 
 /// FIR dialect
 class FIROpsDialect final : public mlir::Dialect {
 public:
   explicit FIROpsDialect(mlir::MLIRContext *ctx);
   virtual ~FIROpsDialect();
 
   static llvm::StringRef getDialectNamespace() { return "fir"; }
 
   mlir::Type parseType(mlir::DialectAsmParser &parser) const override;
   void printType(mlir::Type ty, mlir::DialectAsmPrinter &p) const override;
 
   mlir::Attribute parseAttribute(mlir::DialectAsmParser &parser,
                                  mlir::Type type) const override;
   void printAttribute(mlir::Attribute attr,
                       mlir::DialectAsmPrinter &p) const override;
 };
 
-/// Register the dialect with the provided registry.
-inline void registerFIRDialects(mlir::DialectRegistry &registry) {
+/// The FIR codegen dialect is a dialect containing a small set of transient
+/// operations used exclusively during code generation.
+class FIRCodeGenDialect final : public mlir::Dialect {
+public:
+  explicit FIRCodeGenDialect(mlir::MLIRContext *ctx);
+  virtual ~FIRCodeGenDialect();
+
+  static llvm::StringRef getDialectNamespace() { return "fircg"; }
+};
+
+/// Register and load all the dialects used by flang.
+inline void registerAndLoadDialects(mlir::MLIRContext &ctx) {
+  auto registry = ctx.getDialectRegistry();
   // clang-format off
   registry.insert<mlir::AffineDialect,
+                  FIROpsDialect,
+                  FIRCodeGenDialect,
                   mlir::LLVM::LLVMDialect,
                   mlir::acc::OpenACCDialect,
                   mlir::omp::OpenMPDialect,
                   mlir::scf::SCFDialect,
                   mlir::StandardOpsDialect,
-                  mlir::vector::VectorDialect,
-                  FIROpsDialect>();
+                  mlir::vector::VectorDialect>();
   // clang-format on
+  registry.loadAll(&ctx);
 }
 
 /// Register the standard passes we use. This comes from registerAllPasses(),
 /// but is a smaller set since we aren't using many of the passes found there.
 inline void registerGeneralPasses() {
-  mlir::createCanonicalizerPass();
-  mlir::createCSEPass();
-  mlir::createSuperVectorizePass({});
-  mlir::createLoopUnrollPass();
-  mlir::createLoopUnrollAndJamPass();
-  mlir::createSimplifyAffineStructuresPass();
-  mlir::createLoopFusionPass();
-  mlir::createLoopInvariantCodeMotionPass();
-  mlir::createAffineLoopInvariantCodeMotionPass();
-  mlir::createPipelineDataTransferPass();
-  mlir::createLowerAffinePass();
-  mlir::createLoopTilingPass(0);
-  mlir::createLoopCoalescingPass();
-  mlir::createAffineDataCopyGenerationPass(0, 0);
-  mlir::createMemRefDataFlowOptPass();
-  mlir::createStripDebugInfoPass();
-  mlir::createPrintOpStatsPass();
-  mlir::createInlinerPass();
-  mlir::createSymbolDCEPass();
-  mlir::createLocationSnapshotPass({});
+  mlir::registerCanonicalizerPass();
+  mlir::registerCSEPass();
+  mlir::registerAffineLoopFusionPass();
+  mlir::registerLoopInvariantCodeMotionPass();
+  mlir::registerLoopCoalescingPass();
+  mlir::registerStripDebugInfoPass();
+  mlir::registerPrintOpStatsPass();
+  mlir::registerInlinerPass();
+  mlir::registerSCCPPass();
+  mlir::registerMemRefDataFlowOptPass();
+  mlir::registerSymbolDCEPass();
+  mlir::registerLocationSnapshotPass();
+  mlir::registerAffinePipelineDataTransferPass();
+
+  mlir::registerAffineVectorizePass();
+  mlir::registerAffineLoopUnrollPass();
+  mlir::registerAffineLoopUnrollAndJamPass();
+  mlir::registerSimplifyAffineStructuresPass();
+  mlir::registerAffineLoopInvariantCodeMotionPass();
+  mlir::registerAffineLoopTilingPass();
+  mlir::registerAffineDataCopyGenerationPass();
+
+  mlir::registerConvertAffineToStandardPass();
 }
 
 inline void registerFIRPasses() { registerGeneralPasses(); }
 
 } // namespace fir
 
 #endif // OPTIMIZER_DIALECT_FIRDIALECT_H

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

 #include "mlir/Interfaces/LoopLikeInterface.h"
 #include "mlir/Interfaces/SideEffectInterfaces.h"
 
 using namespace mlir;
 
 namespace fir {
 
 class FirEndOp;
-class LoopOp;
+class DoLoopOp;
 class RealAttr;
 
 void buildCmpFOp(mlir::OpBuilder &builder, mlir::OperationState &result,
                  mlir::CmpFPredicate predicate, mlir::Value lhs,
                  mlir::Value rhs);
 void buildCmpCOp(mlir::OpBuilder &builder, mlir::OperationState &result,
                  mlir::CmpFPredicate predicate, mlir::Value lhs,
                  mlir::Value rhs);
 unsigned getCaseArgumentOffset(llvm::ArrayRef<mlir::Attribute> cases,
                                unsigned dest);
-LoopOp getForInductionVarOwner(mlir::Value val);
+DoLoopOp getForInductionVarOwner(mlir::Value val);
 bool isReferenceLike(mlir::Type type);
 mlir::ParseResult isValidCaseAttr(mlir::Attribute attr);
 mlir::ParseResult parseCmpfOp(mlir::OpAsmParser &parser,
                               mlir::OperationState &result);
 mlir::ParseResult parseCmpcOp(mlir::OpAsmParser &parser,
                               mlir::OperationState &result);
 mlir::ParseResult parseSelector(mlir::OpAsmParser &parser,
                                 mlir::OperationState &result,

flang/include/flang/Optimizer/Dialect/FIROps.td

 /// Definition of the FIR dialect operations
 ///
 //===----------------------------------------------------------------------===//
 
 #ifndef FIR_DIALECT_FIR_OPS
 #define FIR_DIALECT_FIR_OPS
 
 include "mlir/IR/SymbolInterfaces.td"
+include "mlir/Interfaces/CallInterfaces.td"
 include "mlir/Interfaces/ControlFlowInterfaces.td"
 include "mlir/Interfaces/LoopLikeInterface.td"
 include "mlir/Interfaces/SideEffectInterfaces.td"
+include "flang/Optimizer/TypePredicates.td"
 
 def fir_Dialect : Dialect {
   let name = "fir";
   let cppNamespace = "::fir";
 }
 
 // Types and predicates
 
 def fir_Type : Type<CPred<"fir::isa_fir_or_std_type($_self)">,
     "FIR dialect type">;
 
 // Fortran intrinsic types
 def fir_CharacterType : Type<CPred<"$_self.isa<fir::CharacterType>()">,
     "FIR character type">;
-def fir_ComplexType : Type<CPred<"$_self.isa<fir::CplxType>()">,
+def fir_ComplexType : Type<CPred<"$_self.isa<fir::ComplexType>()">,
     "FIR complex type">;
-def fir_IntegerType : Type<CPred<"$_self.isa<fir::IntType>()">,
-    "FIR integer type">;
 def fir_LogicalType : Type<CPred<"$_self.isa<fir::LogicalType>()">,
     "FIR logical type">;
 def fir_RealType : Type<CPred<"$_self.isa<fir::RealType>()">,
     "FIR real type">;
+def fir_VectorType : Type<CPred<"$_self.isa<fir::VectorType>()">,
+    "FIR vector type">;
 
 // Generalized FIR and standard dialect types representing intrinsic types
-def AnyIntegerLike : TypeConstraint<Or<[SignlessIntegerLike.predicate,
-    fir_IntegerType.predicate]>, "any integer">;
 def AnyLogicalLike : TypeConstraint<Or<[BoolLike.predicate,
     fir_LogicalType.predicate]>, "any logical">;
 def AnyRealLike : TypeConstraint<Or<[FloatLike.predicate,
     fir_RealType.predicate]>, "any real">;
-def AnyIntegerType : Type<AnyIntegerLike.predicate, "any integer">;
 
 // Fortran derived (user defined) type
 def fir_RecordType : Type<CPred<"$_self.isa<fir::RecordType>()">,
     "FIR derived type">;
 
 // Fortran array attribute
 def fir_SequenceType : Type<CPred<"$_self.isa<fir::SequenceType>()">,
     "array type">;
 
 // Composable types
 def AnyCompositeLike : TypeConstraint<Or<[fir_RecordType.predicate,
     fir_SequenceType.predicate, fir_ComplexType.predicate,
-    IsTupleTypePred]>, "any composite">;
+    fir_VectorType.predicate, IsTupleTypePred, fir_CharacterType.predicate]>,
+      "any composite">;
 
-// Reference to an entity type
-def fir_ReferenceType : Type<CPred<"$_self.isa<fir::ReferenceType>()">,
-    "reference type">;
-
-// Reference to an ALLOCATABLE attribute type
-def fir_HeapType : Type<CPred<"$_self.isa<fir::HeapType>()">,
-    "allocatable type">;
-
-// Reference to a POINTER attribute type
-def fir_PointerType : Type<CPred<"$_self.isa<fir::PointerType>()">,
-    "pointer type">;
-
-// Reference types
-def AnyReferenceLike : TypeConstraint<Or<[fir_ReferenceType.predicate,
-    fir_HeapType.predicate, fir_PointerType.predicate]>, "any reference">;
-
-// A descriptor tuple (captures a reference to an entity and other information)
-def fir_BoxType : Type<CPred<"$_self.isa<fir::BoxType>()">, "box type">;
+// The legal types of global symbols
+def AnyAddressableLike : TypeConstraint<Or<[fir_ReferenceType.predicate,
+    FunctionType.predicate]>, "any addressable">;
 
 // CHARACTER type descriptor. A pair of a data reference and a LEN value.
 def fir_BoxCharType : Type<CPred<"$_self.isa<fir::BoxCharType>()">,
     "box character type">;
 
 // PROCEDURE POINTER descriptor. A pair that can capture a host closure.
 def fir_BoxProcType : Type<CPred<"$_self.isa<fir::BoxProcType>()">,
     "box procedure type">;
 
 def AnyBoxLike : TypeConstraint<Or<[fir_BoxType.predicate,
     fir_BoxCharType.predicate, fir_BoxProcType.predicate]>, "any box">;
 
 def AnyRefOrBox : TypeConstraint<Or<[fir_ReferenceType.predicate,
     fir_HeapType.predicate, fir_PointerType.predicate, fir_BoxType.predicate]>,
     "any reference or box">;
 
 // A vector of Fortran triple notation describing a multidimensional array
-def fir_DimsType : Type<CPred<"$_self.isa<fir::DimsType>()">, "dim type">;
-def AnyEmboxLike : TypeConstraint<Or<[AnySignlessInteger.predicate,
-    Index.predicate, fir_IntegerType.predicate, fir_DimsType.predicate]>,
-    "any legal embox argument type">;
-def AnyEmboxArg : Type<AnyEmboxLike.predicate, "embox argument type">;
+def fir_ShapeType : Type<CPred<"$_self.isa<fir::ShapeType>()">, "shape type">;
+def fir_ShapeShiftType : Type<CPred<"$_self.isa<fir::ShapeShiftType>()">,
+    "shape shift type">;
+def AnyShapeLike : TypeConstraint<Or<[fir_ShapeType.predicate,
+    fir_ShapeShiftType.predicate]>, "any legal shape type">;
+def AnyShapeType : Type<AnyShapeLike.predicate, "any legal shape type">;
+def fir_SliceType : Type<CPred<"$_self.isa<fir::SliceType>()">, "slice type">;
 
 // A type descriptor's type
 def fir_TypeDescType : Type<CPred<"$_self.isa<fir::TypeDescType>()">,
     "type desc type">;
 
-// A field (in a RecordType) argument's type
-def fir_FieldType : Type<CPred<"$_self.isa<fir::FieldType>()">, "field type">;
-
-// A LEN parameter (in a RecordType) argument's type
-def fir_LenType : Type<CPred<"$_self.isa<fir::LenType>()">,
-    "LEN parameter type">;
-
 def AnyComponentLike : TypeConstraint<Or<[AnySignlessInteger.predicate,
     Index.predicate, fir_IntegerType.predicate, fir_FieldType.predicate]>,
     "any coordinate index">;
 def AnyComponentType : Type<AnyComponentLike.predicate, "coordinate type">;
 
-def AnyCoordinateLike : TypeConstraint<Or<[AnySignlessInteger.predicate,
-    Index.predicate, fir_IntegerType.predicate, fir_FieldType.predicate,
-    fir_LenType.predicate]>, "any coordinate index">;
-def AnyCoordinateType : Type<AnyCoordinateLike.predicate, "coordinate type">;
-
 // Base class for FIR operations.
 // All operations automatically get a prefix of "fir.".
 class fir_Op<string mnemonic, list<OpTrait> traits>
   : Op<fir_Dialect, mnemonic, traits>;
 
 // Base class for FIR operations that take a single argument
 class fir_SimpleOp<string mnemonic, list<OpTrait> traits>
   : fir_Op<mnemonic, traits> {
 
   let assemblyFormat = [{
     operands attr-dict `:` functional-type(operands, results)
   }];
 }
 
 // Base builder for allocate operations
-def fir_AllocateOpBuilder :
-  OpBuilderDAG<(ins "Type":$inType, CArg<"ValueRange", "{}">:$lenParams,
-    CArg<"ValueRange", "{}">:$sizes,
-    CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
+def fir_AllocateOpBuilder : OpBuilderDAG<(ins "mlir::Type":$inType,
+  CArg<"mlir::ValueRange", "{}">:$lenParams,
+  CArg<"mlir::ValueRange", "{}">:$sizes,
+  CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes),
   [{
     $_state.addTypes(getRefTy(inType));
     $_state.addAttribute("in_type", TypeAttr::get(inType));
     $_state.addOperands(sizes);
     $_state.addAttributes(attributes);
   }]>;
 
-def fir_NamedAllocateOpBuilder :
-  OpBuilderDAG<(ins "Type":$inType, "StringRef":$name,
-    CArg<"ValueRange", "{}">:$lenParams, CArg<"ValueRange", "{}">:$sizes,
-    CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
+def fir_NamedAllocateOpBuilder : OpBuilderDAG<(ins "mlir::Type":$inType,
+  "llvm::StringRef":$name, CArg<"mlir::ValueRange", "{}">:$lenParams,
+  CArg<"mlir::ValueRange","{}">:$sizes,
+  CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes),
   [{
     $_state.addTypes(getRefTy(inType));
     $_state.addAttribute("in_type", TypeAttr::get(inType));
+    if (!name.empty())
       $_state.addAttribute("name", $_builder.getStringAttr(name));
     $_state.addOperands(sizes);
     $_state.addAttributes(attributes);
   }]>;
 
-def fir_OneResultOpBuilder :
-  OpBuilderDAG<(ins "Type":$resultType, "ValueRange":$operands,
-    CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
+def fir_OneResultOpBuilder : OpBuilderDAG<(ins "mlir::Type":$resultType,
+    "mlir::ValueRange":$operands,
+    CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes),
   [{
     if (resultType)
       $_state.addTypes(resultType);
     $_state.addOperands(operands);
     $_state.addAttributes(attributes);
   }]>;
 
 // Base class of FIR operations that return 1 result

 class fir_AllocatableBaseOp<string mnemonic, list<OpTrait> traits = []> :
     fir_Op<mnemonic, traits>, Results<(outs fir_Type:$res)> {
   let arguments = (ins
     OptionalAttr<StrAttr>:$name,
     OptionalAttr<BoolAttr>:$target
   );
 }
 
-class fir_AllocatableOp<string mnemonic, list<OpTrait> traits = []> :
+class fir_AllocatableOp<string mnemonic, Resource resource,
+      list<OpTrait> traits = []> :
     fir_AllocatableBaseOp<mnemonic,
-  !listconcat(traits, [MemoryEffects<[MemAlloc]>])>,
+  !listconcat(traits, [MemoryEffects<[MemAlloc<resource>]>])>,
     fir_TwoBuilders<fir_AllocateOpBuilder, fir_NamedAllocateOpBuilder>,
     Arguments<(ins TypeAttr:$in_type, Variadic<AnyIntegerType>:$args)> {
 
   let parser = [{
     mlir::Type intype;
     if (parser.parseType(intype))
       return mlir::failure();
     auto &builder = parser.getBuilder();
string extraAllocClassDeclaration = [{
     
     bool hasLenParams() { return bool{(*this)->getAttr(lenpName())}; }
     
     unsigned numLenParams() {
       if (auto val = (*this)->getAttrOfType<mlir::IntegerAttr>(lenpName()))
         return val.getInt();
       return 0;
     }
-    
     operand_range getLenParams() {
       return {operand_begin(), operand_begin() + numLenParams()};
     }
-    
     unsigned numShapeOperands() {
       return operand_end() - operand_begin() + numLenParams();
     }
-    
     operand_range getShapeOperands() {
       return {operand_begin() + numLenParams(), operand_end()};
     }
-    
     static mlir::Type getRefTy(mlir::Type ty);
 
     /// Get the input type of the allocation
     mlir::Type getInType() {
       return (*this)->getAttrOfType<mlir::TypeAttr>(inType()).getValue();
     }
   }];
 
   // Verify checks common to all allocation operations
   string allocVerify = [{
     llvm::SmallVector<llvm::StringRef, 8> visited;
     if (verifyInType(getInType(), visited, numShapeOperands()))
       return emitOpError("invalid type for allocation");
     if (verifyRecordLenParams(getInType(), numLenParams()))
       return emitOpError("LEN params do not correspond to type");
   }];
 }
 
 //===----------------------------------------------------------------------===//
 // Memory SSA operations
 //===----------------------------------------------------------------------===//
 
-def fir_AllocaOp : fir_AllocatableOp<"alloca"> {
+def fir_AllocaOp :
+      fir_AllocatableOp<"alloca", AutomaticAllocationScopeResource> {
   let summary = "allocate storage for a temporary on the stack given a type";
   let description = [{
     This primitive operation is used to allocate an object on the stack.  A
     reference to the object of type `!fir.ref<T>` is returned.  The returned
     object has an undefined/uninitialized state.  The allocation can be given
     an optional name.  The allocation may have a dynamic repetition count
     for allocating a sequence of locations for the specified type.
 
let description = [{
 
     Note that in the case of `%z`, a contiguous block of memory is allocated
     and its size is a runtime multiple of a 32-bit REAL value.
 
     In the case of `%w`, the arguments `%i` and `%j` are LEN parameters
     (`len1`, `len2`) to the type `PT`.
 
     Finally, the operation is undefined if the ssa-value `%c` is negative.
+
+    Fortran Semantics:
+    There is no language mechanism in Fortran to allocate space on the stack
+    like C's `alloca()` function. Therefore fir.alloca is not control-flow
+    dependent. However, the lifetime of a stack allocation is often limited to
+    a small region and a legal implementation may reuse stack storage in other
+    regions when there is no conflict. For example, take the following code
+    fragment.
+
+    ```fortran
+      CALL foo(1)
+      CALL foo(2)
+      CALL foo(3)
+    ```
+
+    A legal implementation can allocate a stack slot and initialize it with the
+    constant `1`, then pass that by reference to foo. Likewise for the second
+    and third calls to foo, each stack slot being initialized accordingly. It is
+    also a conforming implementation to reuse the same stack slot for all three
+    calls, just initializing each in turn. This is possible  as the lifetime of
+    the copy of each constant need not exceed that of the CALL statement.
+    Indeed, a user would likely expect a good Fortran compiler to perform such
+    an optimization.
+
+    Until Fortran 2018, procedures defaulted to non-recursive. A legal
+    implementation could therefore convert stack allocations to global
+    allocations. Such a conversion effectively adds the SAVE attribute to all
+    variables.
+
+    Some temporary entities (large arrays) probably should not be stack
+    allocated as stack space can often be limited. A legal implementation can
+    convert these large stack allocations to heap allocations regardless of
+    whether the procedure is recursive or not.
   }];
 
   let results = (outs fir_ReferenceType);
 
   let verifier = allocVerify#[{
     mlir::Type outType = getType();
     if (!outType.isa<fir::ReferenceType>())
       return emitOpError("must be a !fir.ref type");
+    if (fir::isa_unknown_size_box(fir::dyn_cast_ptrEleTy(outType)))
+      return emitOpError("cannot allocate !fir.box of unknown rank or type");
     return mlir::success();
   }];
 
   let extraClassDeclaration = extraAllocClassDeclaration#[{
     static mlir::Type wrapResultType(mlir::Type intype);
   }];
 }
 
-def fir_LoadOp : fir_OneResultOp<"load", [MemoryEffects<[MemRead]>]> {
+def fir_LoadOp : fir_OneResultOp<"load"> {
   let summary = "load a value from a memory reference";
   let description = [{
     Load a value from a memory reference into an ssa-value (virtual register).
     Produces an immutable ssa-value of the referent type. A memory reference
     has type `!fir.ref<T>`, `!fir.heap<T>`, or `!fir.ptr<T>`.
 
     ```mlir
       %a = fir.alloca i32
       %l = fir.load %a : !fir.ref<i32>
     ```
 
     The ssa-value has an undefined value if the memory reference is undefined
     or null.
   }];
 
-  let arguments = (ins AnyReferenceLike:$memref);
+  let arguments = (ins Arg<AnyReferenceLike, "", [MemRead]>:$memref);
 
-  let builders = [
-    OpBuilderDAG<(ins "Value":$refVal),
+  let builders = [OpBuilderDAG<(ins "mlir::Value":$refVal),
     [{
       if (!refVal) {
         mlir::emitError($_state.location, "LoadOp has null argument");
         return;
       }
-      auto refTy = refVal.getType().cast<fir::ReferenceType>();
+      auto eleTy = fir::dyn_cast_ptrEleTy(refVal.getType());
+      if (!eleTy) {
+        mlir::emitError($_state.location, "not a memory reference type");
+        return;
+      }
       $_state.addOperands(refVal);
-      $_state.addTypes(refTy.getEleTy());
-    }]>];
+      $_state.addTypes(eleTy);
+    }]
+  >];
 
   let parser = [{
     mlir::Type type;
     mlir::OpAsmParser::OperandType oper;
     if (parser.parseOperand(oper) ||
         parser.parseOptionalAttrDict(result.attributes) ||
         parser.parseColonType(type) ||
         parser.resolveOperand(oper, type, result.operands))
let printer = [{
     p << " : " << memref().getType();
   }];
 
   let extraClassDeclaration = [{
     static mlir::ParseResult getElementOf(mlir::Type &ele, mlir::Type ref);
   }];
 }
 
-def fir_StoreOp : fir_Op<"store", [MemoryEffects<[MemWrite]>]> {
+def fir_StoreOp : fir_Op<"store", []> {
   let summary = "store an SSA-value to a memory location";
 
   let description = [{
     Store an ssa-value (virtual register) to a memory reference.  The stored
     value must be of the same type as the referent type of the memory
     reference.
 
     ```mlir
       %v = ... : f64
       %p = ... : !fir.ptr<f64>
       fir.store %v to %p : !fir.ptr<f64>
     ```
 
     The above store changes the value to which the pointer is pointing and not
     the pointer itself. The operation is undefined if the memory reference,
     `%p`, is undefined or null.
   }];
 
-  let arguments = (ins AnyType:$value, AnyReferenceLike:$memref);
+  let arguments = (ins AnyType:$value,
+                   Arg<AnyReferenceLike, "", [MemWrite]>:$memref);
 
   let parser = [{
     mlir::Type type;
     mlir::OpAsmParser::OperandType oper;
     mlir::OpAsmParser::OperandType store;
     if (parser.parseOperand(oper) ||
         parser.parseKeyword("to") ||
         parser.parseOperand(store) ||
let printer = [{
     p.printOperand(memref());
     p.printOptionalAttrDict(getAttrs(), {});
     p << " : " << memref().getType();
   }];
 
   let verifier = [{
     if (value().getType() != fir::dyn_cast_ptrEleTy(memref().getType()))
       return emitOpError("store value type must match memory reference type");
+    if (fir::isa_unknown_size_box(value().getType()))
+      return emitOpError("cannot store !fir.box of unknown rank or type");
     return mlir::success();
   }];
 
   let extraClassDeclaration = [{
     static mlir::Type elementType(mlir::Type refType);
   }];
 }
 
def fir_UndefOp : fir_OneResultOp<"undefined", [NoSideEffect]> {
   let assemblyFormat = "type($intype) attr-dict";
 
   let verifier = [{
     // allow `undef : ref<T>` since it is a possible from transformations
     return mlir::success();
   }];
 }
 
-def fir_AllocMemOp : fir_AllocatableOp<"allocmem"> {
+def fir_ZeroOp : fir_OneResultOp<"zero_bits", [NoSideEffect]> {
+  let summary = "explicit polymorphic zero value of some type";
+  let description = [{
+    Constructs an ssa-value of the specified type with a value of zero for all
+    bits.
+
+    ```mlir
+      %a = fir.zero_bits !fir.box<!fir.array<10 x !fir.type<T>>>
+    ```
+
+    The example creates a value of type box where all bits are zero.
+  }];
+
+  let results = (outs AnyType:$intype);
+
+  let assemblyFormat = "type($intype) attr-dict";
+}
+
+def fir_AllocMemOp : fir_AllocatableOp<"allocmem", DefaultResource> {
   let summary = "allocate storage on the heap for an object of a given type";
 
   let description = [{
     Creates a heap memory reference suitable for storing a value of the
     given type, T.  The heap refernce returned has type `!fir.heap<T>`.
     The memory object is in an undefined state.  `allocmem` operations must
     be paired with `freemem` operations to avoid memory leaks.
 
     ```mlir
       %0 = fir.allocmem !fir.array<10 x f32>
       fir.freemem %0 : !fir.heap<!fir.array<10 x f32>>
     ```
   }];
 
   let results = (outs fir_HeapType);
 
   let verifier = allocVerify#[{
     mlir::Type outType = getType();
     if (!outType.dyn_cast<fir::HeapType>())
       return emitOpError("must be a !fir.heap type");
+    if (fir::isa_unknown_size_box(fir::dyn_cast_ptrEleTy(outType)))
+      return emitOpError("cannot allocate !fir.box of unknown rank or type");
     return mlir::success();
   }];
 
   let extraClassDeclaration = extraAllocClassDeclaration#[{
     static mlir::Type wrapResultType(mlir::Type intype);
   }];
 }
 
let description = [{
 
     ```mlir
       %21 = fir.allocmem !fir.type<ZT(p:i32){field:i32}>
       ...
       fir.freemem %21 : !fir.heap<!fir.type<ZT>>
     ```
   }];
 
-  let arguments = (ins fir_HeapType:$heapref);
+  let arguments = (ins Arg<fir_HeapType, "", [MemFree]>:$heapref);
 
   let assemblyFormat = "$heapref attr-dict `:` type($heapref)";
 }
 
 //===----------------------------------------------------------------------===//
 // Terminator operations
 //===----------------------------------------------------------------------===//
 
string extraSwitchClassDeclaration = [{
     unsigned targetOffsetSize();
   }];
 }
 
 class fir_IntegralSwitchTerminatorOp<string mnemonic,
     list<OpTrait> traits = []> : fir_SwitchTerminatorOp<mnemonic, traits> {
 
   let skipDefaultBuilders = 1;
-  let builders = [
-    OpBuilderDAG<(ins "Value":$selector, "ArrayRef<int64_t>":$compareOperands,
-      "ArrayRef<Block *>":$destinations,
-      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
+  let builders = [OpBuilderDAG<(ins "mlir::Value":$selector,
+    "llvm::ArrayRef<int64_t>":$compareOperands,
+    "llvm::ArrayRef<mlir::Block *>":$destinations,
+    CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
+    CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes),
     [{
       $_state.addOperands(selector);
       llvm::SmallVector<mlir::Attribute, 8> ivalues;
       for (auto iv : compareOperands)
         ivalues.push_back($_builder.getI64IntegerAttr(iv));
       ivalues.push_back($_builder.getUnitAttr());
       $_state.addAttribute(getCasesAttr(), $_builder.getArrayAttr(ivalues));
       const auto count = destinations.size();
       for (auto d : destinations)
         $_state.addSuccessors(d);
       const auto opCount = destOperands.size();
       llvm::SmallVector<int32_t, 8> argOffs;
       int32_t sumArgs = 0;
       for (std::remove_const_t<decltype(count)> i = 0; i != count; ++i) {
         if (i < opCount) {
           $_state.addOperands(destOperands[i]);
           const auto argSz = destOperands[i].size();
           argOffs.push_back(argSz);
           sumArgs += argSz;
         } else {
           argOffs.push_back(0);
         }
       }
       $_state.addAttribute(getOperandSegmentSizeAttr(),
-                          $_builder.getI32VectorAttr({1, 0, sumArgs}));
       $_state.addAttribute(getTargetOffsetAttr(),
-                          $_builder.getI32VectorAttr(argOffs));
       $_state.addAttributes(attributes);
-    }]>];
+    }]
+  >];
 
   let parser = [{
     mlir::OpAsmParser::OperandType selector;
     mlir::Type type;
     if (parseSelector(parser, result, selector, type))
       return mlir::failure();
 
     llvm::SmallVector<mlir::Attribute, 8> ivalues;
let printer = [{
     p << ']';
     p.printOptionalAttrDict(getAttrs(), {getCasesAttr(), getCompareOffsetAttr(),
         getTargetOffsetAttr(), getOperandSegmentSizeAttr()});
   }];
 
   let verifier = [{
     if (!(getSelector().getType().isa<mlir::IntegerType>() ||
           getSelector().getType().isa<mlir::IndexType>() ||
-          getSelector().getType().isa<fir::IntType>()))
+          getSelector().getType().isa<fir::IntegerType>()))
       return emitOpError("must be an integer");
     auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
     auto count = getNumDest();
     if (count == 0)
       return emitOpError("must have at least one successor");
     if (getNumConditions() != count)
       return emitOpError("number of cases and targets don't match");
     if (targetOffsetSize() != count)
```mlir
             #fir.interval, %2, %3, ^bb3(%2,%arg2 : i32,i32),
             #fir.upper, %arg, ^bb4(%1 : i32),
             unit, ^bb5]
     ```
   }];
 
   let skipDefaultBuilders = 1;
   let builders = [
-    OpBuilderDAG<(ins "Value":$selector,
-      "ArrayRef<mlir::Attribute>":$compareAttrs,
-      "ArrayRef<ValueRange>":$cmpOperands, "ArrayRef<Block *>":$destinations,
-      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>,
-    OpBuilderDAG<(ins "Value":$selector,
-      "ArrayRef<mlir::Attribute>":$compareAttrs, "ArrayRef<Value>":$cmpOpList,
-      "ArrayRef<Block *>":$destinations,
-      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>];
+    OpBuilderDAG<(ins "mlir::Value":$selector,
+      "llvm::ArrayRef<mlir::Attribute>":$compareAttrs,
+      "llvm::ArrayRef<mlir::ValueRange>":$cmpOperands,
+      "llvm::ArrayRef<mlir::Block *>":$destinations,
+      CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
+    OpBuilderDAG<(ins "mlir::Value":$selector,
+      "llvm::ArrayRef<mlir::Attribute>":$compareAttrs,
+      "llvm::ArrayRef<mlir::Value>":$cmpOpList,
+      "llvm::ArrayRef<mlir::Block *>":$destinations,
+      CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>];
 
   let parser = "return parseSelectCase(parser, result);";
 
   let printer = [{
     p << getOperationName() << ' ';
     p.printOperand(getSelector());
     p << " : " << getSelector().getType() << " [";
     auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
let printer = [{
     p << ']';
     p.printOptionalAttrDict(getAttrs(), {getCasesAttr(), getCompareOffsetAttr(),
         getTargetOffsetAttr(), getOperandSegmentSizeAttr()});
   }];
 
   let verifier = [{
     if (!(getSelector().getType().isa<mlir::IntegerType>() ||
           getSelector().getType().isa<mlir::IndexType>() ||
-          getSelector().getType().isa<fir::IntType>() ||
+          getSelector().getType().isa<fir::IntegerType>() ||
           getSelector().getType().isa<fir::LogicalType>() ||
           getSelector().getType().isa<fir::CharacterType>()))
       return emitOpError("must be an integer, character, or logical");
     auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
     auto count = getNumDest();
     if (count == 0)
       return emitOpError("must have at least one successor");
     if (getNumConditions() != count)
```mlir
           #fir.instance<!fir.type<type2>>, ^bb2(%2 : i32),
           #fir.subsumed<!fir.type<type3>>, ^bb3(%2 : i32),
           #fir.instance<!fir.type<type4>>, ^bb4(%1,%3 : i32,f32),
           unit, ^bb5]
     ```
   }];
 
   let skipDefaultBuilders = 1;
-  let builders = [
-    OpBuilderDAG<(ins "Value":$selector,
-      "ArrayRef<mlir::Attribute>":$typeOperands,
-      "ArrayRef<Block *>":$destinations,
-      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
+  let builders = [OpBuilderDAG<(ins "mlir::Value":$selector,
+    "llvm::ArrayRef<mlir::Attribute>":$typeOperands,
+    "llvm::ArrayRef<mlir::Block *>":$destinations,
+    CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
+    CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes),
     [{
       $_state.addOperands(selector);
-      $_state.addAttribute(getCasesAttr(), $_builder.getArrayAttr(typeOperands));
+      $_state.addAttribute(getCasesAttr(),
+        $_builder.getArrayAttr(typeOperands));
       const auto count = destinations.size();
       for (auto d : destinations)
         $_state.addSuccessors(d);
       const auto opCount = destOperands.size();
       llvm::SmallVector<int32_t, 8> argOffs;
       int32_t sumArgs = 0;
       for (std::remove_const_t<decltype(count)> i = 0; i != count; ++i) {
         if (i < opCount) {
           $_state.addOperands(destOperands[i]);
           const auto argSz = destOperands[i].size();
           argOffs.push_back(argSz);
           sumArgs += argSz;
         } else {
           argOffs.push_back(0);
         }
       }
       $_state.addAttribute(getOperandSegmentSizeAttr(),
-                          $_builder.getI32VectorAttr({1, 0, sumArgs}));
       $_state.addAttribute(getTargetOffsetAttr(),
-                          $_builder.getI32VectorAttr(argOffs));
       $_state.addAttributes(attributes);
-    }]>];
+    }]
+  >];
 
   let parser = "return parseSelectType(parser, result);";
 
   let printer = [{
     p << getOperationName() << ' ';
     p.printOperand(getSelector());
     p << " : " << getSelector().getType() << " [";
     auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
let description = [{
     ```
   }];
 
   let arguments = (ins AnyType:$resval);
 
   let assemblyFormat = "$resval attr-dict `:` type($resval)";
 }
 
+//===------------------------------------------------------------------------===//
 // Operations on !fir.box<T> type objects
+//===------------------------------------------------------------------------===//
 
-def fir_EmboxOp : fir_Op<"embox", [NoSideEffect]> {
+def fir_EmboxOp : fir_Op<"embox", [NoSideEffect, AttrSizedOperandSegments]> {
   let summary = "boxes a given reference and (optional) dimension information";
 
   let description = [{
     Create a boxed reference value. In Fortran, the implementation can require
     extra information about an entity, such as its type, rank, etc.  This
     auxilliary information is packaged and abstracted as a value with box type
     by the calling routine. (In Fortran, these are called descriptors.)
 
     ```mlir
       %c1 = constant 1 : index
       %c10 = constant 10 : index
-      %4 = fir.dims(%c1, %c10, %c1) : (index, index, index) -> !fir.dims<1>
       %5 = ... : !fir.ref<!fir.array<10 x i32>>
-      %6 = fir.embox %5, %4 : (!fir.ref<!fir.array<10 x i32>>, !fir.dims<1>) -> !fir.box<!fir.array<10 x i32>>
+      %6 = fir.embox %5 : (!fir.ref<!fir.array<10 x i32>>) -> !fir.box<!fir.array<10 x i32>>
     ```
 
     The descriptor tuple may contain additional implementation-specific
     information through the use of additional attributes.
   }];
 
-  let arguments = (ins AnyReferenceLike:$memref, Variadic<AnyEmboxArg>:$args);
+  let arguments = (ins
+    AnyReferenceLike:$memref,
+    Optional<AnyShapeType>:$shape,
+    Optional<fir_SliceType>:$slice,
+    Variadic<AnyIntegerType>:$lenParams,
+    OptionalAttr<AffineMapAttr>:$accessMap
+  );
 
   let results = (outs fir_BoxType);
 
-  let parser = "return parseEmboxOp(parser, result);";
+  let builders = [
+    OpBuilderDAG<(ins "llvm::ArrayRef<mlir::Type>":$resultTypes,
+      "mlir::Value":$memref, CArg<"mlir::Value", "{}">:$shape,
+      CArg<"mlir::Value", "{}">:$slice,
+      CArg<"mlir::ValueRange", "{}">:$lenParams),
+    [{ return build($_builder, $_state, resultTypes, memref, shape, slice,
+                    lenParams, mlir::AffineMapAttr{}); }]>
+  ];
 
-  let printer = [{
-    p << getOperationName() << ' ';
-    p.printOperand(memref());
-    if (hasLenParams()) {
-      p << '(';
-      p.printOperands(getLenParams());
-      p << ')';
-    }
-    if (getNumOperands() == 2) {
-      p << ", ";
-      p.printOperands(dims());
-    } else if (auto map = (*this)->getAttr(layoutName())) {
-      p << " [" << map << ']';
-    }
-    p.printOptionalAttrDict(getAttrs(), {layoutName(), lenpName()});
-    p << " : ";
-    p.printFunctionalType(getOperation());
+  let assemblyFormat = [{
+    $memref (`(` $shape^ `)`)? (`[` $slice^ `]`)? (`typeparams` $lenParams^)?
+      (`map` $accessMap^)? attr-dict `:` functional-type(operands, results)
   }];
 
-  let verifier = [{
-    if (hasLenParams()) {
-      auto lenParams = numLenParams();
-      auto eleTy = fir::dyn_cast_ptrEleTy(memref().getType());
-      if (!eleTy)
-        return emitOpError("must embox a memory reference type");
-      if (auto rt = eleTy.dyn_cast<fir::RecordType>()) {
-        if (lenParams != rt.getNumLenParams())
-          return emitOpError("number of LEN params does not correspond"
-                             " to the !fir.type type");
-      } else {
-        return emitOpError("LEN parameters require !fir.type type");
-      }
-      for (auto lp : getLenParams())
-        if (lp.getType().isa<fir::DimsType>())
-          return emitOpError("LEN parameters must be integral type");
-    }
-    if (dims().size() == 0) {
-      // Ok. If there is no dims and no layout map, then emboxing a scalar.
-      // TODO: Should the type be enforced? It already must agree.
-    } else if (dims().size() == 1) {
-      auto d = *dims().begin();
-      if (!d.getType().isa<fir::DimsType>())
-        return emitOpError("dimension argument must have !fir.dims type");
-    } else {
-      return emitOpError("embox can only have one !fir.dim argument");
-    }
-    return mlir::success();
-  }];
+  let verifier = [{ return ::verify(*this); }];
 
   let extraClassDeclaration = [{
-    static constexpr llvm::StringRef layoutName() { return "layout_map"; }
-    static constexpr llvm::StringRef lenpName() { return "len_param_count"; }
-    bool hasLenParams() { return bool{(*this)->getAttr(lenpName())}; }
-    unsigned numLenParams() {
-      if (auto x = (*this)->getAttrOfType<mlir::IntegerAttr>(lenpName()))
-        return x.getInt();
-      return 0;
-    }
-    operand_range getLenParams() {
-      return {operand_begin(), operand_begin() + numLenParams()};
-    }
-    operand_range dims() {
-      return {operand_begin() + numLenParams() + 1, operand_end()};
-    }
+    mlir::Value getShape() { return shape(); }
+    mlir::Value getSlice() { return slice(); }
+    bool hasLenParams() { return !lenParams().empty(); }
+    unsigned numLenParams() { return lenParams().size(); }
   }];
 }
 
 def fir_EmboxCharOp : fir_Op<"emboxchar", [NoSideEffect]> {
   let summary = "boxes a given CHARACTER reference and its LEN parameter";
 
   let description = [{
     Create a boxed CHARACTER value. The CHARACTER type has the LEN type
```mlir
       %6 = fir.emboxchar %4, %5 : (!fir.ref<!fir.array<10 x !fir.char<1>>>, i32) -> !fir.boxchar<1>
     ```
 
     In the above `%4` is a memory reference to a buffer of 10 CHARACTER units.
     This buffer and its LEN value (10) are wrapped into a pair in `%6`.
   }];
 
   let arguments = (ins AnyReferenceLike:$memref, AnyIntegerLike:$len);
-  
   let results = (outs fir_BoxCharType);
 
   let assemblyFormat = [{
     $memref `,` $len attr-dict `:` functional-type(operands, results)
   }];
 
   let verifier = [{
     auto eleTy = elementTypeOf(memref().getType());
let description = [{
     Unbox a boxed value into a result of multiple values from the box's
     component data.  The values are, minimally, a reference to the data of the
     entity, the byte-size of one element, the rank, the type descriptor, a set
     of flags (packed in an integer, and an array of dimension information (of
     size rank).
 
     ```mlir
       %40   = ... : !fir.box<!fir.type<T>>
-      %41:6 = fir.unbox %40 : (!fir.box<!fir.type<T>>) -> (!fir.ref<!fir.type<T>>, i32, i32, !fir.tdesc<!fir.type<T>>, i32, !fir.dims<4>)
+      %41:6 = fir.unbox %40 : (!fir.box<!fir.type<T>>) -> (!fir.ref<!fir.type<T>>, i32, i32, !fir.tdesc<!fir.type<T>>, i32, !fir.array<? x index>)
     ```
   }];
 
   let arguments = (ins fir_BoxType:$box);
 
   let results = (outs
     fir_ReferenceType,  // pointer to data
     AnyIntegerLike,     // size of a data element
     AnyIntegerLike,     // rank of data
     fir_TypeDescType,   // abstract type descriptor
     AnyIntegerLike,     // attribute flags (bitfields)
-    fir_DimsType        // dimension information (if any)
+    fir_SequenceType    // dimension information (if any)
   );
 }
 
 def fir_UnboxCharOp : fir_SimpleOp<"unboxchar", [NoSideEffect]> {
   let summary = "unbox a boxchar value into a pair value";
 
   let description = [{
     Unboxes a value of `boxchar` type into a pair consisting of a memory
def fir_BoxDimsOp : fir_Op<"box_dims", [NoSideEffect]> {
   let description = [{
     Returns the triple of lower bound, extent, and stride for `dim` dimension
     of `val`, which must have a `box` type.  The dimensions are enumerated from
     left to right from 0 to rank-1. This operation has undefined behavior if
     `dim` is out of bounds.
 
     ```mlir
       %c1   = constant 0 : i32
-      %52:3 = fir.box_dims %40, %c1 : (!fir.box<!fir.array<*:f64>>, i32) -> (i32, i32, i32)
+      %52:3 = fir.box_dims %40, %c1 : (!fir.box<!fir.array<*:f64>>, i32) -> (index, index, index)
     ```
 
     The above is a request to return the left most row (at index 0) triple from
-    the box. The triple will be the lower bound, upper bound, and stride.
+    the box. The triple will be the lower bound, extent, and byte-stride, which
+    are the values encoded in a standard descriptor.
   }];
 
   let arguments = (ins fir_BoxType:$val, AnyIntegerLike:$dim);
 
-  let results = (outs AnyIntegerLike, AnyIntegerLike, AnyIntegerLike);
+  let results = (outs Index, Index, Index);
 
   let assemblyFormat = [{
     $val `,` $dim attr-dict `:` functional-type(operands, results)
   }];
 
   let extraClassDeclaration = [{
     mlir::Type getTupleType();
   }];

 }
 
 def fir_BoxIsArrayOp : fir_SimpleOp<"box_isarray", [NoSideEffect]> {
   let summary = "is the boxed value an array?";
 
   let description = [{
     Determine if the boxed value has a positive (> 0) rank. This will return
     true if the originating box value was from a fir.embox with a memory
-    reference value that had the type !fir.array<T> and/or a dims argument.
+    reference value that had the type !fir.array<T> and/or a shape argument.
 
     ```mlir
       %r = ... : !fir.ref<i64>
-      %d = fir.gendims(1, 100, 1) : (i32, i32, i32) -> !fir.dims<1>
-      %b = fir.embox %r, %d : (!fir.ref<i64>, !fir.dims<1>) -> !fir.box<i64>
+      %c_100 = constant 100 : index
+      %d = fir.shape %c_100 : (index) -> !fir.shape<1>
+      %b = fir.embox %r(%d) : (!fir.ref<i64>, !fir.shape<1>) -> !fir.box<i64>
       %a = fir.box_isarray %b : (!fir.box<i64>) -> i1  // true
     ```
   }];
 
   let arguments = (ins fir_BoxType:$val);
 
   let results = (outs BoolLike);
 }
let description = [{
     ```
   }];
 
   let arguments = (ins fir_BoxType:$val);
 
   let results = (outs fir_TypeDescType);
 }
 
+//===----------------------------------------------------------------------===//
+// Array value operations
+//===----------------------------------------------------------------------===//
+
+def fir_ArrayLoadOp : fir_Op<"array_load", [AttrSizedOperandSegments]> {
+
+  let summary = "Load an array as a value.";
+
+  let description = [{
+    Load an entire array as a single SSA value.
+
+    ```fortran
+      real :: a(o:n,p:m)
+      ...
+      ... = ... a ...
+    ```
+
+    One can use `fir.array_load` to produce an ssa-value that captures an
+    immutable value of the entire array `a`, as in the Fortran array expression
+    shown above. Subsequent changes to the memory containing the array do not
+    alter its composite value. This operation let's one load an array as a
+    value while applying a runtime shape, shift, or slice to the memory
+    reference, and its semantics guarantee immutability.
+    
+    ```mlir
+      %s = fir.shape_shift %o, %n, %p, %m : (index, index, index, index) -> !fir.shape<2>
+      // load the entire array 'a'
+      %v = fir.array_load %a(%s) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.array<?x?xf32>
+      // a fir.store here into array %a does not change %v
+    ```
+  }];
+
+  let arguments = (ins
+    Arg<AnyReferenceLike, "", [MemRead]>:$memref,
+    Optional<AnyShapeType>:$shape,
+    Optional<fir_SliceType>:$slice,
+    Variadic<AnyIntegerType>:$lenParams
+  );
+
+  let results = (outs fir_SequenceType);
+
+  let assemblyFormat = [{
+    $memref (`(`$shape^`)`)? (`[`$slice^`]`)? (`typeparams` $lenParams^)? attr-dict `:` functional-type(operands, results)
+  }];
+
+  let verifier = [{ return ::verify(*this); }];
+
+  let extraClassDeclaration = [{
+    std::vector<mlir::Value> getExtents();
+  }];
+}
+
+def fir_ArrayFetchOp : fir_Op<"array_fetch", [NoSideEffect]> {
+
+  let summary = "Fetch the value of an element of an array value";
+
+  let description = [{
+    Fetch the value of an element in an array value.
+
+    ```fortran
+      real :: a(n,m)
+      ...
+      ... a ...
+      ... a(r,s+1) ...
+    ```
+
+    One can use `fir.array_fetch` to fetch the (implied) value of `a(i,j)` in
+    an array expression as shown above. It can also be used to extract the
+    element `a(r,s+1)` in the second expression.
+
+    ```mlir
+      %s = fir.shape %n, %m : (index, index) -> !fir.shape<2>
+      // load the entire array 'a'
+      %v = fir.array_load %a(%s) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.array<?x?xf32>
+      // fetch the value of one of the array value's elements
+      %1 = fir.array_fetch %v, %i, %j : (!fir.array<?x?xf32>, index, index) -> f32
+    ```
+
+    It is only possible to use `array_fetch` on an `array_load` result value.
+  }];
+
+  let arguments = (ins
+    fir_SequenceType:$sequence,
+    Variadic<AnyCoordinateType>:$indices
+  );
+
+  let results = (outs AnyType:$element);
+
+  let assemblyFormat = [{
+    $sequence `,` $indices attr-dict `:` functional-type(operands, results)
+  }];
+
+  let verifier = [{
+    auto arrTy = sequence().getType().cast<fir::SequenceType>();
+    if (indices().size() != arrTy.getDimension())
+      return emitOpError("number of indices != dimension of array");
+    if (element().getType() != arrTy.getEleTy())
+      return emitOpError("return type does not match array");
+    if (!isa<fir::ArrayLoadOp>(sequence().getDefiningOp()))
+      return emitOpError("argument #0 must be result of fir.array_load");
+    return mlir::success();
+  }];
+}
+
+def fir_ArrayUpdateOp : fir_Op<"array_update", [NoSideEffect]> {
+
+  let summary = "Update the value of an element of an array value";
+
+  let description = [{
+    Updates the value of an element in an array value. A new array value is
+    returned where all element values of the input array are identical except
+    for the selected element which is the value passed in the update.
+
+    ```fortran
+      real :: a(n,m)
+      ...
+      a = ...
+    ```
+
+    One can use `fir.array_update` to update the (implied) value of `a(i,j)`
+    in an array expression as shown above.
+
+    ```mlir
+      %s = fir.shape %n, %m : (index, index) -> !fir.shape<2>
+      // load the entire array 'a'
+      %v = fir.array_load %a(%s) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.array<?x?xf32>
+      // update the value of one of the array value's elements
+      // %r_{ij} = %f  if (i,j) = (%i,%j),   %v_{ij} otherwise
+      %r = fir.array_update %v, %f, %i, %j : (!fir.array<?x?xf32>, f32, index, index) -> !fir.array<?x?xf32>
+      fir.array_merge_store %v, %r to %a : !fir.ref<!fir.array<?x?xf32>>
+    ```
+
+    An array value update behaves as if a mapping function from the indices
+    to the new value has been added, replacing the previous mapping. These
+    mappings can be added to the ssa-value, but will not be materialized in
+    memory until the `fir.array_merge_store` is performed.
+  }];
+
+  let arguments = (ins
+    fir_SequenceType:$sequence,
+    AnyType:$merge,
+    Variadic<AnyCoordinateType>:$indices
+  );
+
+  let results = (outs fir_SequenceType);
+
+  let assemblyFormat = [{
+    $sequence `,` $merge `,` $indices attr-dict `:` functional-type(operands, results)
+  }];
+
+  let verifier = [{
+    auto arrTy = sequence().getType().cast<fir::SequenceType>();
+    if (merge().getType() != arrTy.getEleTy())
+      return emitOpError("merged value does not have element type");
+    if (indices().size() != arrTy.getDimension())
+      return emitOpError("number of indices != dimension of array");
+    return mlir::success();
+  }];
+}
+
+def fir_ArrayMergeStoreOp : fir_Op<"array_merge_store", [
+    TypesMatchWith<"type of 'original' matches element type of 'memref'",
+                     "memref", "original",
+                     "fir::dyn_cast_ptrEleTy($_self)">,
+    TypesMatchWith<"type of 'sequence' matches element type of 'memref'",
+                     "memref", "sequence",
+                     "fir::dyn_cast_ptrEleTy($_self)">]> {
+
+  let summary = "Store merged array value to memory.";
+
+  let description = [{
+    Store a merged array value to memory.
+
+    ```fortran
+      real :: a(n,m)
+      ...
+      a = ...
+    ```
+
+    One can use `fir.array_merge_store` to merge/copy the value of `a` in an
+    array expression as shown above.
+    
+    ```mlir
+      %v = fir.array_load %a(%shape) : ...
+      %r = fir.array_update %v, %f, %i, %j : (!fir.array<?x?xf32>, f32, index, index) -> !fir.array<?x?xf32>
+      fir.array_merge_store %v, %r to %a : !fir.ref<!fir.array<?x?xf32>>
+    ```
+
+    This operation merges the original loaded array value, `%v`, with the
+    chained updates, `%r`, and stores the result to the array at address, `%a`.
+  }];
+
+  let arguments = (ins
+    fir_SequenceType:$original,
+    fir_SequenceType:$sequence,
+    Arg<AnyReferenceLike, "", [MemWrite]>:$memref
+  );
+
+  let assemblyFormat = "$original `,` $sequence `to` $memref attr-dict `:` type($memref)";
+
+  let verifier = [{
+    if (!isa<ArrayLoadOp>(original().getDefiningOp()))
+       return emitOpError("operand #0 must be result of a fir.array_load op");
+    return mlir::success();
+  }];
+}
+
+//===----------------------------------------------------------------------===//
 // Record and array type operations
+//===----------------------------------------------------------------------===//
+
+def fir_ArrayCoorOp : fir_Op<"array_coor",
+    [NoSideEffect, AttrSizedOperandSegments]> {
+
+  let summary = "Find the coordinate of an element of an array";
+
+  let description = [{
+    Compute the location of an element in an array when the shape of the
+    array is only known at runtime.
+
+    This operation is intended to capture all the runtime values needed to
+    compute the address of an array reference in a single high-level op. Given
+    the following Fortran input:
+
+    ```fortran
+      real :: a(n,m)
+      ...
+      ... a(i,j) ...
+    ```
+
+    One can use `fir.array_coor` to determine the address of `a(i,j)`.
+
+    ```mlir
+      %s = fir.shape %n, %m : (index, index) -> !fir.shape<2>
+      %1 = fir.array_coor %a(%s) %i, %j : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32>
+    ```
+  }];
+
+  let arguments = (ins
+    AnyReferenceLike:$memref,
+    Optional<AnyShapeType>:$shape,
+    Optional<fir_SliceType>:$slice,
+    Variadic<AnyCoordinateType>:$indices,
+    Variadic<AnyIntegerType>:$lenParams
+  );
+
+  let results = (outs fir_ReferenceType);
+
+  let assemblyFormat = [{
+    $memref (`(`$shape^`)`)? (`[`$slice^`]`)? $indices (`typeparams` $lenParams^)? attr-dict `:` functional-type(operands, results)
+  }];
+
+  let verifier = [{ return ::verify(*this); }];
+}
 
 def fir_CoordinateOp : fir_Op<"coordinate_of", [NoSideEffect]> {
   let summary = "Finds the coordinate (location) of a value in memory";
 
   let description = [{
     Compute the internal coordinate address starting from a boxed value or
     unboxed memory reference. Returns a memory reference. When computing the
     coordinate of an array element, the rank of the array must be known and
def fir_CoordinateOp : fir_Op<"coordinate_of", [NoSideEffect]> {
 
   let printer = [{
     p << getOperationName() << ' ' << (*this)->getOperands();
     p.printOptionalAttrDict(getAttrs(), /*elidedAttrs=*/{baseType()});
     p << " : ";
     p.printFunctionalType((*this)->getOperandTypes(),
         (*this)->getResultTypes());
   }];
-  
-  let verifier = [{
-    auto refTy = ref().getType();
-    if (fir::isa_ref_type(refTy)) {
-      auto eleTy = fir::dyn_cast_ptrEleTy(refTy);
-      if (auto arrTy = eleTy.dyn_cast<fir::SequenceType>()) {
-        if (arrTy.hasUnknownShape())
-          return emitOpError("cannot find coordinate in unknown shape");
-        if (arrTy.getConstantRows() < arrTy.getDimension() - 1)
-          return emitOpError("cannot find coordinate with unknown extents");
-      }
-    }
-    // Recovering a LEN type parameter only makes sense from a boxed value
-    for (auto co : coor())
-      if (dyn_cast_or_null<LenParamIndexOp>(co.getDefiningOp())) {
-        if (getNumOperands() != 2)
-          return emitOpError("len_param_index must be last argument");
-        if (!ref().getType().dyn_cast<BoxType>())
-          return emitOpError("len_param_index must be used on box type");
-      }
-    if (auto attr = (*this)->getAttr(CoordinateOp::baseType())) {
-      if (!attr.isa<mlir::TypeAttr>())
-        return emitOpError("improperly constructed");
-    } else {
-      return emitOpError("must have base type");
-    }
-    return mlir::success();
-  }];
+  let verifier = [{ return ::verify(*this); }];
 
   let skipDefaultBuilders = 1;
   let builders = [
-    OpBuilderDAG<(ins "Type":$type, "Value":$ref, "ValueRange":$coor,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
-    OpBuilderDAG<(ins "Type":$type, "ValueRange":$operands,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>];
-        
+    OpBuilderDAG<(ins "mlir::Type":$type, "mlir::Value":$ref,
+      "mlir::ValueRange":$coor,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
+    OpBuilderDAG<(ins "mlir::Type":$type, "mlir::ValueRange":$operands,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>];
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef baseType() { return "base_type"; }
     mlir::Type getBaseType();
   }];
 }
 
 def fir_ExtractValueOp : fir_OneResultOp<"extract_value", [NoSideEffect]> {
   let summary = "Extract a value from an aggregate SSA-value";
 
   let description = [{
     Extract a value from an entity with a type composed of tuples, arrays,
     and/or derived types. Returns the value from entity with the type of the
     specified component. Cannot be used on values of `!fir.box` type.
+    It can also be used to access complex parts and elements of a character
+    string.
 
     Note that the entity ssa-value must be of compile-time known size in order
     to use this operation.
 
     ```mlir
       %f = fir.field_index field, !fir.type<X{field:i32}>
       %s = ... : !fir.type<X>
       %v = fir.extract_value %s, %f : (!fir.type<X>, !fir.field) -> i32
if (getNumOperands()) {
           p.printType(op.getType());
         else
           p << "()";
         sep = ", ";
       }
     }
   }];
 
-  let builders = [
-    OpBuilderDAG<(ins "StringRef":$fieldName, "Type":$recTy,
-      CArg<"ValueRange", "{}">:$operands),
+  let builders = [OpBuilderDAG<(ins "llvm::StringRef":$fieldName,
+      "mlir::Type":$recTy, CArg<"mlir::ValueRange","{}">:$operands),
     [{
-      $_state.addAttribute(fieldAttrName(), $_builder.getStringAttr(fieldName));
+      $_state.addAttribute(fieldAttrName(),
+        $_builder.getStringAttr(fieldName));
       $_state.addAttribute(typeAttrName(), TypeAttr::get(recTy));
       $_state.addOperands(operands);
-    }]>];
+    }]
+  >];
 
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
     static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
+    llvm::StringRef getFieldName() { return field_id(); }
   }];
 }
 
-def fir_GenDimsOp : fir_OneResultOp<"gendims", [NoSideEffect]> {
+def fir_ShapeOp : fir_Op<"shape", [NoSideEffect]> {
 
-  let summary = "generate a value of type `!fir.dims`";
+  let summary = "generate an abstract shape vector of type `!fir.shape`";
 
   let description = [{
-    The arguments are an ordered list of integral type values that is a
-    multiple of 3 in length.  Each such triple is defined as: the lower
-    index, the extent, and the stride for that dimension. The dimension
-    information is given in the same row-to-column order as Fortran. This
-    abstract dimension value must describe a reified object, so all dimension
-    information must be specified.  The extent must be nonnegative and the
-    stride must not be zero.
+    The arguments are an ordered list of integral type values that define the
+    runtime extent of each dimension of an array. The shape information is
+    given in the same row-to-column order as Fortran. This abstract shape value
+    must be applied to a reified object, so all shape information must be
+    specified.  The extent must be nonnegative.
 
     ```mlir
-      %d = fir.gendims %lo, %ext, %str : (index, index, index) -> !fir.dims<1>
+      %d = fir.shape %row_sz, %col_sz : (index, index) -> !fir.shape<2>
     ```
   }];
 
-  let arguments = (ins Variadic<AnyIntegerType>:$triples);
+  let arguments = (ins Variadic<AnyIntegerType>:$extents);
 
-  let results = (outs fir_DimsType);
+  let results = (outs fir_ShapeType);
 
   let assemblyFormat = [{
     operands attr-dict `:` functional-type(operands, results)
   }];
 
   let verifier = [{
-    auto size = triples().size();
-    if (size < 1 || size > 16 * 3)
+    auto size = extents().size();
+    auto shapeTy = getType().dyn_cast<fir::ShapeType>();
+    assert(shapeTy && "must be a shape type");
+    if (shapeTy.getRank() != size)
+      return emitOpError("shape type rank mismatch");
+    return mlir::success();
+  }];
+
+  let extraClassDeclaration = [{
+    std::vector<mlir::Value> getExtents() {
+      return {extents().begin(), extents().end()};
+    }
+  }];
+}
+
+def fir_ShapeShiftOp : fir_Op<"shape_shift", [NoSideEffect]> {
+
+  let summary = [{
+    generate an abstract shape and shift vector of type `!fir.shapeshift`
+  }];
+
+  let description = [{
+    The arguments are an ordered list of integral type values that is a multiple
+    of 2 in length. Each such pair is defined as: the lower bound and the
+    extent for that dimension. The shifted shape information is given in the
+    same row-to-column order as Fortran. This abstract shifted shape value must
+    be applied to a reified object, so all shifted shape information must be
+    specified.  The extent must be nonnegative.
+
+    ```mlir
+      %d = fir.shape_shift %lo, %extent : (index, index) -> !fir.shapeshift<1>
+    ```
+  }];
+
+  let arguments = (ins Variadic<AnyIntegerType>:$pairs);
+
+  let results = (outs fir_ShapeShiftType);
+
+  let assemblyFormat = [{
+    operands attr-dict `:` functional-type(operands, results)
+  }];
+
+  let verifier = [{
+    auto size = pairs().size();
+    if (size < 2 || size > 16 * 2)
       return emitOpError("incorrect number of args");
+    if (size % 2 != 0)
+      return emitOpError("requires a multiple of 2 args");
+    auto shapeTy = getType().dyn_cast<fir::ShapeShiftType>();
+    assert(shapeTy && "must be a shape shift type");
+    if (shapeTy.getRank() * 2 != size)
+      return emitOpError("shape type rank mismatch");
+    return mlir::success();
+  }];
+
+  let extraClassDeclaration = [{
+    // Logically unzip the origins from the extent values.
+    std::vector<mlir::Value> getOrigins() {
+      std::vector<mlir::Value> result;
+      for (auto i : llvm::enumerate(pairs()))
+        if (!(i.index() & 1))
+          result.push_back(i.value());
+      return result;
+    }
+
+    // Logically unzip the extents from the origin values.
+    std::vector<mlir::Value> getExtents() {
+      std::vector<mlir::Value> result;
+      for (auto i : llvm::enumerate(pairs()))
+        if (i.index() & 1)
+          result.push_back(i.value());
+      return result;
+    }
+  }];
+}
+
+def fir_SliceOp : fir_Op<"slice", [NoSideEffect, AttrSizedOperandSegments]> {
+
+  let summary = "generate an abstract slice vector of type `!fir.slice`";
+
+  let description = [{
+    The array slicing arguments are an ordered list of integral type values
+    that must be a multiple of 3 in length.  Each such triple is defined as:
+    the lower bound, the upper bound, and the stride for that dimension, as in
+    Fortran syntax. Both bounds are inclusive. The array slice information is
+    given in the same row-to-column order as Fortran. This abstract slice value
+    must be applied to a reified object, so all slice information must be
+    specified.  The extent must be nonnegative and the stride must not be zero.
+
+    ```mlir
+      %d = fir.slice %lo, %hi, %step : (index, index, index) -> !fir.slice<1>
+    ```
+
+    To support generalized slicing of Fortran's dynamic derived types, a slice
+    op can be given a component path (narrowing from the product type of the
+    original array to the specific elemental type of the sliced projection).
+    
+    ```mlir
+      %fld = fir.field_index component, !fir.type<t{...component:ct...}>
+      %d = fir.slice %lo, %hi, %step path %fld : (index, index, index, !fir.field) -> !fir.slice<1>
+    ```
+  }];
+
+  let arguments = (ins
+    Variadic<AnyIntegerType>:$triples,
+    Variadic<AnyComponentType>:$fields
+  );
+
+  let results = (outs fir_SliceType);
+
+  let assemblyFormat = [{
+    $triples (`path` $fields^)? attr-dict `:` functional-type(operands, results)
+  }];
+
+  let verifier = [{
+    auto size = triples().size();
+    if (size < 3 || size > 16 * 3)
+      return emitOpError("incorrect number of args for triple");
     if (size % 3 != 0)
       return emitOpError("requires a multiple of 3 args");
+    auto sliceTy = getType().dyn_cast<fir::SliceType>();
+    assert(sliceTy && "must be a slice type");
+    if (sliceTy.getRank() * 3 != size)
+      return emitOpError("slice type rank mismatch");
     return mlir::success();
   }];
 }
 
 def fir_InsertValueOp : fir_OneResultOp<"insert_value", [NoSideEffect]> {
   let summary = "insert a new sub-value into a copy of an existing aggregate";
 
   let description = [{
-    Insert a value from an entity with a type composed of tuples, arrays,
+    Insert a value into an entity with a type composed of tuples, arrays,
     and/or derived types. Returns a new ssa value with the same type as the
     original entity. Cannot be used on values of `!fir.box` type.
+    It can also be used to set complex parts and elements of a character
+    string.
 
     Note that the entity ssa-value must be of compile-time known size in order
     to use this operation.
 
     ```mlir
       %a = ... : !fir.array<10xtuple<i32, f32>>
       %f = ... : f32
       %o = ... : i32
       %c = constant 1 : i32
       %b = fir.insert_value %a, %f, %o, %c : (!fir.array<10x20xtuple<i32, f32>>, f32, i32, i32) -> !fir.array<10x20xtuple<i32, f32>>
     ```
   }];
 
   let arguments = (ins AnyCompositeLike:$adt, AnyType:$val,
                        Variadic<AnyComponentType>:$coor);
   let results = (outs AnyCompositeLike);
 
   let assemblyFormat = [{
     operands attr-dict `:` functional-type(operands, results)
   }];
+
+  let hasCanonicalizer = 1;
+}
+
+def fir_InsertOnRangeOp : fir_OneResultOp<"insert_on_range", [NoSideEffect]> {
+  let summary = "insert sub-value into a range on an existing sequence";
+
+  let description = [{
+    Insert a constant value into an entity with an array type. Returns a
+    new ssa value where the range of offsets from the original array have been
+    replaced with the constant. The result is an array type entity.
+  }];
+
+  let arguments = (ins fir_SequenceType:$seq, AnyType:$val,
+                       Variadic<Index>:$coor);
+  let results = (outs fir_SequenceType);
+
+  let assemblyFormat = [{
+    operands attr-dict `:` functional-type(operands, results)
+  }];
 }
 
 def fir_LenParamIndexOp : fir_OneResultOp<"len_param_index", [NoSideEffect]> {
   let summary =
     "create a field index value from a LEN type parameter identifier";
 
   let description = [{
     Generate a LEN parameter (offset) value from an LEN parameter identifier.
def fir_LenParamIndexOp : fir_OneResultOp<"len_param_index", [NoSideEffect]> {
   }];
 
   let printer = [{
     p << getOperationName() << ' '
       << (*this)->getAttrOfType<mlir::StringAttr>(fieldAttrName()).getValue()
       << ", " << (*this)->getAttr(typeAttrName());
   }];
 
-  let builders = [
-    OpBuilderDAG<(ins "StringRef":$fieldName, "Type":$recTy),
+  let builders = [OpBuilderDAG<(ins "llvm::StringRef":$fieldName,
+      "mlir::Type":$recTy),
     [{
       $_state.addAttribute(fieldAttrName(), $_builder.getStringAttr(fieldName));
       $_state.addAttribute(typeAttrName(), TypeAttr::get(recTy));
-    }]>];
+    }]
+  >];
 
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
     static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
     mlir::Type getOnType() {
       return (*this)->getAttrOfType<TypeAttr>(typeAttrName()).getValue();
     }
   }];
 }
 
 //===----------------------------------------------------------------------===//
 // Fortran loops
 //===----------------------------------------------------------------------===//
 
 def fir_ResultOp : fir_Op<"result",
     [NoSideEffect, ReturnLike, Terminator,
-     ParentOneOf<["WhereOp", "LoopOp", "IterWhileOp"]>]> {
+     ParentOneOf<["IfOp", "DoLoopOp", "IterWhileOp"]>]> {
   let summary = "special terminator for use in fir region operations";
 
   let description = [{
     Result takes a list of ssa-values produced in the block and forwards them
     as a result to the operation that owns the region of the block. The
     operation can retain the values or return them to its parent block
     depending upon its semantics.
   }];
 
   let arguments = (ins Variadic<AnyType>:$results);
-  let builders = [
-    OpBuilderDAG<(ins),
-    [{/* do nothing */}]>
-  ];
+  let builders = [OpBuilderDAG<(ins), [{ /* do nothing */ }]>];
 
   let assemblyFormat = "($results^ `:` type($results))? attr-dict";
 
   let verifier = [{ return ::verify(*this); }];
 }
 
 def FirRegionTerminator : SingleBlockImplicitTerminator<"ResultOp">;
 
 class region_Op<string mnemonic, list<OpTrait> traits = []> :
     fir_Op<mnemonic,
     !listconcat(traits, [FirRegionTerminator, RecursiveSideEffects])> {
   let printer = [{ return ::print(p, *this); }];
   let verifier = [{ return ::verify(*this); }];
   let parser = [{ return ::parse$cppClass(parser, result); }];
 }
 
-def fir_LoopOp : region_Op<"do_loop",
+def fir_DoLoopOp : region_Op<"do_loop",
     [DeclareOpInterfaceMethods<LoopLikeOpInterface>]> {
   let summary = "generalized loop operation";
   let description = [{
     Generalized high-level looping construct. This operation is similar to
     MLIR's `loop.for`.
 
     ```mlir
       %l = constant 0 : index
       %u = constant 9 : index
       %s = constant 1 : index
       fir.do_loop %i = %l to %u step %s unordered {
         %x = fir.convert %i : (index) -> i32
         %v = fir.call @compute(%x) : (i32) -> f32
-        %p = fir.coordinate_of %A, %i : (!fir.ref<f32>, index) -> !fir.ref<f32>
+        %p = fir.coordinate_of %A, %i : (!fir.ref<!fir.array<?xf32>>, index) -> !fir.ref<f32>
         fir.store %v to %p : !fir.ref<f32>
       }
     ```
 
     The above example iterates over the interval `[%l, %u]`. The unordered
     keyword indicates that the iterations can be executed in any order.
   }];
 
   let arguments = (ins
     Index:$lowerBound,
     Index:$upperBound,
     Index:$step,
     Variadic<AnyType>:$initArgs,
-    OptionalAttr<UnitAttr>:$unordered
-  );
-  let results = (outs
-    Variadic<AnyType>:$results
+    OptionalAttr<UnitAttr>:$unordered,
+    OptionalAttr<UnitAttr>:$finalValue
   );
+  let results = (outs Variadic<AnyType>:$results);
   let regions = (region SizedRegion<1>:$region);
 
   let skipDefaultBuilders = 1;
   let builders = [
     OpBuilderDAG<(ins "mlir::Value":$lowerBound, "mlir::Value":$upperBound,
       "mlir::Value":$step, CArg<"bool", "false">:$unordered,
-      CArg<"ValueRange", "llvm::None">:$iterArgs,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>
+      CArg<"bool", "false">:$finalCountValue,
+      CArg<"mlir::ValueRange", "llvm::None">:$iterArgs,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>
   ];
 
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef unorderedAttrName() { return "unordered"; }
+    static constexpr llvm::StringRef finalValueAttrName() {
+      return "finalValue";
+    }
 
     mlir::Value getInductionVar() { return getBody()->getArgument(0); }
     mlir::OpBuilder getBodyBuilder() {
       return OpBuilder(getBody(), std::prev(getBody()->end()));
     }
     mlir::Block::BlockArgListType getRegionIterArgs() {
       return getBody()->getArguments().drop_front();
     }
let extraClassDeclaration = [{
 
     /// Get the body of the loop
     mlir::Block *getBody() { return &region().front(); }
 
     void setUnordered() {
       (*this)->setAttr(unorderedAttrName(),
                               mlir::UnitAttr::get(getContext()));
     }
+    
+    mlir::BlockArgument iterArgToBlockArg(mlir::Value iterArg);
+    void resultToSourceOps(llvm::SmallVectorImpl<mlir::Value> &results,
+                           unsigned resultNum);
+    mlir::Value blockArgToSourceOp(unsigned blockArgNum);
   }];
 }
 
-def fir_WhereOp : region_Op<"if", [NoRegionArguments]> {
+def fir_IfOp : region_Op<"if", [NoRegionArguments]> {
   let summary = "if-then-else conditional operation";
   let description = [{
     Used to conditionally execute operations. This operation is the FIR
     dialect's version of `loop.if`.
 
     ```mlir
       %56 = ... : i1
       %78 = ... : !fir.ref<!T>
       fir.if %56 {
         fir.store %76 to %78 : !fir.ref<!T>
       } else {
         fir.store %77 to %78 : !fir.ref<!T>
       }
     ```
   }];
 
   let arguments = (ins I1:$condition);
   let results = (outs Variadic<AnyType>:$results);
 
   let regions = (region
-    SizedRegion<1>:$whereRegion,
-    AnyRegion:$otherRegion
+    SizedRegion<1>:$thenRegion,
+    AnyRegion:$elseRegion
   );
 
   let skipDefaultBuilders = 1;
   let builders = [
-    OpBuilderDAG<(ins "Value":$cond, "bool":$withOtherRegion)>,
-    OpBuilderDAG<(ins "TypeRange":$resultTypes, "Value":$cond,
-      "bool":$withOtherRegion)>
+    OpBuilderDAG<(ins "mlir::Value":$cond, "bool":$withElseRegion)>,
+    OpBuilderDAG<(ins "mlir::TypeRange":$resultTypes, "mlir::Value":$cond,
+        "bool":$withElseRegion)>
   ];
 
   let extraClassDeclaration = [{
-    mlir::OpBuilder getWhereBodyBuilder() {
-      assert(!whereRegion().empty() && "Unexpected empty 'where' region.");
-      mlir::Block &body = whereRegion().front();
+    mlir::OpBuilder getThenBodyBuilder() {
+      assert(!thenRegion().empty() && "Unexpected empty 'where' region.");
+      mlir::Block &body = thenRegion().front();
       return mlir::OpBuilder(&body, std::prev(body.end()));
     }
-    mlir::OpBuilder getOtherBodyBuilder() {
-      assert(!otherRegion().empty() && "Unexpected empty 'other' region.");
-      mlir::Block &body = otherRegion().front();
+    mlir::OpBuilder getElseBodyBuilder() {
+      assert(!elseRegion().empty() && "Unexpected empty 'other' region.");
+      mlir::Block &body = elseRegion().front();
       return mlir::OpBuilder(&body, std::prev(body.end()));
     }
+    
+    void resultToSourceOps(llvm::SmallVectorImpl<mlir::Value> &results,
+                           unsigned resultNum);
   }];
 }
 
 def fir_IterWhileOp : region_Op<"iterate_while",
     [DeclareOpInterfaceMethods<LoopLikeOpInterface>]> {
   let summary = "DO loop with early exit condition";
   let description = [{
-    This construct is useful for lowering implied-DO loops. It is very similar
-    to `fir::LoopOp` with the addition that it requires a single loop-carried
-    bool value that signals an early exit condition to the operation. A `true`
-    disposition means the next loop iteration should proceed. A `false`
-    indicates that the `fir.iterate_while` operation should terminate and
-    return its iteration arguments.
+    This single-entry, single-exit looping construct is useful for lowering
+    counted loops that can exit early such as, for instance, implied-DO loops.
+    It is very similar to `fir::DoLoopOp` with the addition that it requires
+    a single loop-carried bool value that signals an early exit condition to
+    the operation. A `true` disposition means the next loop iteration should
+    proceed. A `false` indicates that the `fir.iterate_while` operation should
+    terminate and return its iteration arguments. This is a degenerate counted
+    loop in that the loop is not guaranteed to execute all iterations.
+
+    An example iterate_while that returns the counter value, the early
+    termination condition, and an extra loop-carried value is shown here. This
+    loop counts from %lo to %up (inclusive), stepping by %c1, so long as the
+    early exit (%ok) is true. The iter_args %sh value is also carried by the
+    loop. The result triple is the values of %i=phi(%lo,%i+%c1),
+    %ok=phi(%okIn,%okNew), and %sh=phi(%shIn,%shNew) from the last executed
+    iteration.
+    
+    ```mlir
+      %v:3 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok = %okIn) iter_args(%sh = %shIn) -> (index, i1, i16) {
+        %shNew = fir.call @bar(%sh) : (i16) -> i16
+        %okNew = fir.call @foo(%sh) : (i16) -> i1
+        fir.result %i, %okNew, %shNew : index, i1, i16
+      }
+    ```
   }];
 
   let arguments = (ins
     Index:$lowerBound,
     Index:$upperBound,
     Index:$step,
     I1:$iterateIn,
-    Variadic<AnyType>:$initArgs
-  );
-  let results = (outs
-    I1:$iterateResult,
-    Variadic<AnyType>:$results
+    Variadic<AnyType>:$initArgs,
+    OptionalAttr<UnitAttr>:$finalValue
   );
+  let results = (outs Variadic<AnyType>:$results);
   let regions = (region SizedRegion<1>:$region);
 
   let skipDefaultBuilders = 1;
   let builders = [
     OpBuilderDAG<(ins "mlir::Value":$lowerBound, "mlir::Value":$upperBound,
       "mlir::Value":$step, "mlir::Value":$iterate,
-      CArg<"ValueRange", "llvm::None">:$iterArgs,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>
+      CArg<"bool", "false">:$finalCountValue,
+      CArg<"mlir::ValueRange", "llvm::None">:$iterArgs,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>
   ];
-  
   let extraClassDeclaration = [{
+    static constexpr llvm::StringRef finalValueAttrName() {
+      return "finalValue";
+    }
     mlir::Block *getBody() { return &region().front(); }
     mlir::Value getIterateVar() { return getBody()->getArgument(1); }
     mlir::Value getInductionVar() { return getBody()->getArgument(0); }
     mlir::OpBuilder getBodyBuilder() {
       return mlir::OpBuilder(getBody(), std::prev(getBody()->end()));
     }
     mlir::Block::BlockArgListType getRegionIterArgs() {
       return getBody()->getArguments().drop_front();
let extraClassDeclaration = [{
     /// Does the operation hold operands for loop-carried values
     bool hasIterOperands() {
       return (*this)->getNumOperands() > getNumControlOperands();
     }
     /// Get Number of loop-carried values
     unsigned getNumIterOperands() {
       return (*this)->getNumOperands() - getNumControlOperands();
     }
+
+    mlir::BlockArgument iterArgToBlockArg(mlir::Value iterArg);
+    void resultToSourceOps(llvm::SmallVectorImpl<mlir::Value> &results,
+                           unsigned resultNum);
+    mlir::Value blockArgToSourceOp(unsigned blockArgNum);
   }];
 }
 
 //===----------------------------------------------------------------------===//
 // Procedure call operations
 //===----------------------------------------------------------------------===//
 
-def fir_CallOp : fir_Op<"call",
-    [MemoryEffects<[MemAlloc, MemFree, MemRead, MemWrite]>]> {
+def fir_CallOp : fir_Op<"call", [CallOpInterface]> {
   let summary = "call a procedure";
 
   let description = [{
     Call the specified function or function reference.
 
     Provides a custom parser and pretty printer to allow a more readable syntax
     in the FIR dialect, e.g. `fir.call @sub(%12)` or `fir.call %20(%22,%23)`.
 
     ```mlir
       %a = fir.call %funcref(%arg0) : (!fir.ref<f32>) -> f32
       %b = fir.call @function(%arg1, %arg2) : (!fir.ref<f32>, !fir.ref<f32>) -> f32
     ```
   }];
 
   let arguments = (ins
     OptionalAttr<SymbolRefAttr>:$callee,
     Variadic<AnyType>:$args
   );
-
   let results = (outs Variadic<AnyType>);
 
   let parser = "return parseCallOp(parser, result);";
   let printer = "printCallOp(p, *this);";
 
+  let builders = [
+    OpBuilderDAG<(ins "mlir::FuncOp":$callee,
+        CArg<"mlir::ValueRange", "{}">:$operands),
+    [{
+      $_state.addOperands(operands);
+      $_state.addAttribute(calleeAttrName(),
+        $_builder.getSymbolRefAttr(callee));
+      $_state.addTypes(callee.getType().getResults());
+    }]>,
+    OpBuilderDAG<(ins "mlir::SymbolRefAttr":$callee,
+        "llvm::ArrayRef<mlir::Type>":$results,
+        CArg<"mlir::ValueRange", "{}">:$operands),
+    [{
+      $_state.addOperands(operands);
+      $_state.addAttribute(calleeAttrName(), callee);
+      $_state.addTypes(results);
+    }]>,
+    OpBuilderDAG<(ins "llvm::StringRef":$callee,
+        "llvm::ArrayRef<mlir::Type>":$results,
+        CArg<"mlir::ValueRange", "{}">:$operands),
+    [{
+      build($_builder, $_state, $_builder.getSymbolRefAttr(callee), results,
+            operands);
+    }]>];
+
   let extraClassDeclaration = [{
     static constexpr StringRef calleeAttrName() { return "callee"; }
+
+    mlir::FunctionType getFunctionType();
+
+    /// Get the argument operands to the called function.
+    operand_range getArgOperands() {
+      if (auto calling =
+          (*this)->getAttrOfType<SymbolRefAttr>(calleeAttrName()))
+        return {arg_operand_begin(), arg_operand_end()};
+      return {arg_operand_begin() + 1, arg_operand_end()};
+    }
+
+    operand_iterator arg_operand_begin() { return operand_begin(); }
+    operand_iterator arg_operand_end() { return operand_end(); }
+
+    /// Return the callee of this operation.
+    CallInterfaceCallable getCallableForCallee() {
+      if (auto calling =
+          (*this)->getAttrOfType<SymbolRefAttr>(calleeAttrName()))
+        return calling;
+      return getOperand(0);
+    }
   }];
 }
 
-def fir_DispatchOp : fir_Op<"dispatch",
-    [MemoryEffects<[MemAlloc, MemFree, MemRead, MemWrite]>]> {
+def fir_DispatchOp : fir_Op<"dispatch", []> {
   let summary = "call a type-bound procedure";
 
   let description = [{
     Perform a dynamic dispatch on the method name via the dispatch table
     associated with the first argument.  The attribute 'pass_arg_pos' can be
     used to select a dispatch argument other than the first one.
 
     ```mlir
def fir_DispatchOp : fir_Op<"dispatch", []> {
 
   let parser = [{
     mlir::FunctionType calleeType;
     llvm::SmallVector<mlir::OpAsmParser::OperandType, 4> operands;
     auto calleeLoc = parser.getNameLoc();
     llvm::StringRef calleeName;
     if (failed(parser.parseOptionalKeyword(&calleeName))) {
       mlir::StringAttr calleeAttr;
-      if (parser.parseAttribute(calleeAttr, "method", result.attributes))
+      if (parser.parseAttribute(calleeAttr, methodAttrName(),
+                                result.attributes))
         return mlir::failure();
     } else {
-      result.addAttribute("method",
+      result.addAttribute(methodAttrName(),
           parser.getBuilder().getStringAttr(calleeName));
     }
     if (parser.parseOperandList(operands,
                                 mlir::OpAsmParser::Delimiter::Paren) ||
         parser.parseOptionalAttrDict(result.attributes) ||
         parser.parseColonType(calleeType) ||
         parser.addTypesToList(calleeType.getResults(), result.types) ||
         parser.resolveOperands(
             operands, calleeType.getInputs(), calleeLoc, result.operands))
       return mlir::failure();
-    result.addAttribute("fn_type", mlir::TypeAttr::get(calleeType));
     return mlir::success();
   }];
 
   let printer = [{
-    p << getOperationName() << ' ' << (*this)->getAttr("method") << '(';
+    p << getOperationName() << ' ' << (*this)->getAttr(methodAttrName()) << '(';
     p.printOperand(object());
-    if (arg_operand_begin() != arg_operand_end()) {
+    if (!args().empty()) {
       p << ", ";
       p.printOperands(args());
     }
-    p << ')';
-    p.printOptionalAttrDict(getAttrs(), {"fn_type", "method"});
-    auto resTy{getResultTypes()};
-    llvm::SmallVector<mlir::Type, 8> argTy(getOperandTypes());
-    p << " : " << mlir::FunctionType::get(getContext(), argTy, resTy);
+    p << ") : ";
+    p.printFunctionalType((*this)->getOperandTypes(),
+        (*this)->getResultTypes());
   }];
 
   let extraClassDeclaration = [{
     mlir::FunctionType getFunctionType();
     operand_range getArgOperands() {
       return {arg_operand_begin(), arg_operand_end()};
     }
+    // operand[0] is the object (of box type)
     operand_iterator arg_operand_begin() { return operand_begin() + 1; }
     operand_iterator arg_operand_end() { return operand_end(); }
-    llvm::StringRef passArgAttrName() { return "pass_arg_pos"; }
+    static constexpr llvm::StringRef passArgAttrName() {
+      return "pass_arg_pos";
+    }
+    static constexpr llvm::StringRef methodAttrName() { return "method"; }
     unsigned passArgPos();
   }];
 }
 
 // Constant operations that support Fortran
 
 def fir_StringLitOp : fir_Op<"string_lit", [NoSideEffect]> {
   let summary = "create a string literal constant";
 
   let description = [{
     An FIR constant that represents a sequence of characters that correspond
     to Fortran's CHARACTER type, including a LEN.  We support CHARACTER values
     of different KINDs (different constant sizes).
 
     ```mlir
       %1 = fir.string_lit "Hello, World!"(13) : !fir.char<1> // ASCII
       %2 = fir.string_lit [158, 2345](2) : !fir.char<2>      // Wide chars
     ```
   }];
 
-  let results = (outs fir_SequenceType);
+  let results = (outs fir_CharacterType);
 
   let parser = [{
     auto &builder = parser.getBuilder();
     mlir::Attribute val;
     mlir::NamedAttrList attrs;
     if (parser.parseAttribute(val, "fake", attrs))
       return mlir::failure();
     if (auto v = val.dyn_cast<mlir::StringAttr>())
       result.attributes.push_back(builder.getNamedAttr(value(), v));
     else if (auto v = val.dyn_cast<mlir::ArrayAttr>())
       result.attributes.push_back(builder.getNamedAttr(xlist(), v));
     else
       return parser.emitError(parser.getCurrentLocation(),
                               "found an invalid constant");
     mlir::IntegerAttr sz;
     mlir::Type type;
     if (parser.parseLParen() ||
         parser.parseAttribute(sz, size(), result.attributes) ||
         parser.parseRParen() ||
         parser.parseColonType(type))
       return mlir::failure();
-    if (!(type.isa<fir::CharacterType>() || type.isa<mlir::IntegerType>()))
+    auto charTy = type.dyn_cast<fir::CharacterType>();
+    if (!charTy)
       return parser.emitError(parser.getCurrentLocation(),
                               "must have character type");
-    type = fir::SequenceType::get({sz.getInt()}, type);
+    type = fir::CharacterType::get(builder.getContext(), charTy.getFKind(),
+                                   sz.getInt());
     if (!type || parser.addTypesToList(type, result.types))
       return mlir::failure();
     return mlir::success();
   }];
 
   let printer = [{
     p << getOperationName() << ' ' << getValue() << '(';
     p << getSize().cast<mlir::IntegerAttr>().getValue() << ") : ";
-    p.printType(getType().cast<fir::SequenceType>().getEleTy());
+    p.printType(getType());
   }];
 
   let verifier = [{
     if (getSize().cast<mlir::IntegerAttr>().getValue().isNegative())
       return emitOpError("size must be non-negative");
-    auto eleTy = getType().cast<fir::SequenceType>().getEleTy();
-    if (!eleTy.isa<fir::CharacterType>())
-      return emitOpError("must have !fir.char type");
     if (auto xl = (*this)->getAttr(xlist())) {
       auto xList = xl.cast<mlir::ArrayAttr>();
       for (auto a : xList)
         if (!a.isa<mlir::IntegerAttr>())
     return emitOpError("values in list must be integers");
     }
     return mlir::success();
   }];
def fir_ConstfOp : fir_Op<"constf", [NoSideEffect]> {
   let summary = "create a floating point constant";
 
   let description = [{
     A floating-point constant. This operation is to augment MLIR to be able
     to represent APFloat values that are not supported in the standard dialect.
   }];
 
   let arguments = (ins FirRealAttr:$constant);
-  
   let results = (outs fir_RealType:$res);
 
   let assemblyFormat = "`(` $constant `)` attr-dict `:` type($res)";
-  
   let verifier = [{
     if (!getType().isa<fir::RealType>())
       return emitOpError("must be a !fir.real type");
     return mlir::success();
   }];
 }
 
 class RealUnaryArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
let description = [{
     Extends the standard floating-point comparison to handle the extended
     floating-point types found in FIR.
   }];
 
   let arguments = (ins AnyRealLike:$lhs, AnyRealLike:$rhs);
 
   let results = (outs AnyLogicalLike);
 
-  let builders = [
-    OpBuilderDAG<(ins "CmpFPredicate":$predicate, "Value":$lhs, "Value":$rhs),
-    [{
+  let builders = [OpBuilderDAG<(ins "mlir::CmpFPredicate":$predicate,
+    "mlir::Value":$lhs, "mlir::Value":$rhs), [{
       buildCmpFOp($_builder, $_state, predicate, lhs, rhs);
   }]>];
 
   let parser = [{ return parseCmpfOp(parser, result); }];
 
   let printer = [{ printCmpfOp(p, *this); }];
 
   let extraClassDeclaration = [{
def fir_ConstcOp : fir_Op<"constc", [NoSideEffect]> {
 
   let description = [{
     A complex constant. Similar to the standard dialect complex type, but this
     extension allows constants with APFloat values that are not supported in
     the standard dialect.
   }];
 
   let results = (outs fir_ComplexType);
-  
   let parser = [{
     fir::RealAttr realp;
     fir::RealAttr imagp;
     mlir::Type type;
     if (parser.parseLParen() ||
         parser.parseAttribute(realp, realAttrName(), result.attributes) ||
         parser.parseComma() ||
         parser.parseAttribute(imagp, imagAttrName(), result.attributes) ||
let printer = [{
     auto f2 = (*this)->getAttr(imagAttrName()).cast<mlir::FloatAttr>();
     auto i2 = f2.getValue().bitcastToAPInt();
     p.getStream().write_hex(i2.getZExtValue());
     p << ") : ";
     p.printType(getType());
   }];
 
   let verifier = [{
-    if (!getType().isa<fir::CplxType>())
+    if (!getType().isa<fir::ComplexType>())
       return emitOpError("must be a !fir.complex type");
     return mlir::success();
   }];
 
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef realAttrName() { return "real"; }
     static constexpr llvm::StringRef imagAttrName() { return "imaginary"; }
 
def fir_CmpcOp : fir_Op<"cmpc",
   let arguments = (ins fir_ComplexType:$lhs, fir_ComplexType:$rhs);
 
   let results = (outs AnyLogicalLike);
 
   let parser = "return parseCmpcOp(parser, result);";
 
   let printer = "printCmpcOp(p, *this);";
 
-  let builders = [
-    OpBuilderDAG<(ins "CmpFPredicate":$predicate, "Value":$lhs, "Value":$rhs),
-    [{
+  let builders = [OpBuilderDAG<(ins "mlir::CmpFPredicate":$predicate,
+    "mlir::Value":$lhs, "mlir::Value":$rhs), [{
       buildCmpCOp($_builder, $_state, predicate, lhs, rhs);
   }]>];
 
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef getPredicateAttrName() {
       return "predicate";
     }
 
     CmpFPredicate getPredicate() {
       return (CmpFPredicate)(*this)->getAttrOfType<mlir::IntegerAttr>(
           getPredicateAttrName()).getInt();
     }
   }];
 }
 
 // Other misc. operations
 
 def fir_AddrOfOp : fir_OneResultOp<"address_of", [NoSideEffect]> {
   let summary = "convert a symbol to an SSA value";
-  
   let description = [{
     Convert a symbol (a function or global reference) to an SSA-value to be
-    used in other Operations.
+    used in other Operations. References to Fortran symbols are distinguished
+    via this operation from other arbitrary constant values.
 
     ```mlir
       %p = fir.address_of(@symbol) : !fir.ref<f64>
     ```
   }];
 
   let arguments = (ins SymbolRefAttr:$symbol);
 
-  let results = (outs fir_ReferenceType:$resTy);
+  let results = (outs AnyAddressableLike:$resTy);
 
   let assemblyFormat = "`(` $symbol `)` attr-dict `:` type($resTy)";
 }
 
 def fir_ConvertOp : fir_OneResultOp<"convert", [NoSideEffect]> {
   let summary = "encapsulates all Fortran scalar type conversions";
-  
   let description = [{
     Generalized type conversion. Convert the ssa value from type T to type U.
     Not all pairs of types have conversions. When types T and U are the same
     type, this instruction is a NOP and may be folded away.
 
     ```mlir
       %v = ... : i64
       %w = fir.convert %v : (i64) -> i32
let verifier = [{
     return emitOpError("invalid type conversion");
   }];
 
   let extraClassDeclaration = [{
     static bool isIntegerCompatible(mlir::Type ty);
     static bool isFloatCompatible(mlir::Type ty);
     static bool isPointerCompatible(mlir::Type ty);
   }];
+  let hasCanonicalizer = 1;
 }
 
 def FortranTypeAttr : Attr<And<[CPred<"$_self.isa<TypeAttr>()">,
     Or<[CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::CharacterType>()">,
-        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::CplxType>()">,
-        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::IntType>()">,
+        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::ComplexType>()">,
+        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::IntegerType>()">,
         CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::LogicalType>()">,
         CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::RealType>()">,
         CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::RecordType>()">]>]>,
     "Fortran surface type"> {
   let storageType = [{ TypeAttr }];
   let returnType = "Type";
   let convertFromStorage = "$_self.getValue().cast<Type>()";
 }
let parser = [{
     return mlir::success();
   }];
 
   let printer = [{
     p << getOperationName() << ' ' << (*this)->getAttr("in_type");
     p.printOptionalAttrDict(getAttrs(), {"in_type"});
   }];
 
-  let builders = [
-    OpBuilderDAG<(ins "mlir::TypeAttr":$inty)>
-  ];
+  let builders = [OpBuilderDAG<(ins "mlir::TypeAttr":$inty)>];
 
   let verifier = [{
     mlir::Type resultTy = getType();
     if (auto tdesc = resultTy.dyn_cast<TypeDescType>()) {
       if (tdesc.getOfTy() != getInType())
         return emitOpError("wrapped type mismatched");
     } else {
       return emitOpError("must be !fir.tdesc type");
let printer = [{
     p.printType(getType());
     if (hasInitializationBody())
       p.printRegion((*this)->getRegion(0), /*printEntryBlockArgs=*/false,
                     /*printBlockTerminators=*/true);
   }];
 
   let skipDefaultBuilders = 1;
   let builders = [
-    OpBuilderDAG<(ins "StringRef":$name, "Type":$type,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
-    OpBuilderDAG<(ins "StringRef":$name, "bool":$isConstant, "Type":$type,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
-    OpBuilderDAG<(ins "StringRef":$name, "Type":$type,
-      CArg<"StringAttr", "{}">:$linkage,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
-    OpBuilderDAG<(ins "StringRef":$name, "bool":$isConstant, "Type":$type,
-      CArg<"StringAttr", "{}">:$linkage,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
-    OpBuilderDAG<(ins "StringRef":$name, "Type":$type, "Attribute":$initVal,
-      CArg<"StringAttr", "{}">:$linkage,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
-    OpBuilderDAG<(ins "StringRef":$name, "bool":$isConstant, "Type":$type,
-      "Attribute":$initVal, CArg<"StringAttr", "{}">:$linkage,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
+    OpBuilderDAG<(ins "llvm::StringRef":$name, "mlir::Type":$type,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
+    OpBuilderDAG<(ins "llvm::StringRef":$name, "bool":$isConstant,
+      "mlir::Type":$type,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
+    OpBuilderDAG<(ins "llvm::StringRef":$name, "mlir::Type":$type,
+      CArg<"mlir::StringAttr", "{}">:$linkage,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
+    OpBuilderDAG<(ins "llvm::StringRef":$name, "bool":$isConstant,
+      "mlir::Type":$type, CArg<"mlir::StringAttr", "{}">:$linkage,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
+    OpBuilderDAG<(ins "llvm::StringRef":$name, "mlir::Type":$type,
+      "mlir::Attribute":$initVal, CArg<"mlir::StringAttr", "{}">:$linkage,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
+    OpBuilderDAG<(ins "llvm::StringRef":$name, "bool":$isConstant,
+      "mlir::Type":$type, "mlir::Attribute":$initVal,
+      CArg<"mlir::StringAttr", "{}">:$linkage,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
   ];
 
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef symbolAttrName() { return "symref"; }
     static constexpr llvm::StringRef constantAttrName() { return "constant"; }
     static constexpr llvm::StringRef initValAttrName() { return "initVal"; }
     static constexpr llvm::StringRef linkageAttrName() { return "linkName"; }
     static constexpr llvm::StringRef typeAttrName() { return "type"; }
 
     /// The printable type of the global
     mlir::Type getType() {
       return (*this)->getAttrOfType<TypeAttr>(typeAttrName()).getValue();
     }
 
     /// The semantic type of the global
     mlir::Type resultType() {
       return fir::AllocaOp::wrapResultType(getType());
     }
-    
     /// Return the initializer attribute if it exists, or a null attribute.
     Attribute getValueOrNull() { return initVal().getValueOr(Attribute()); }
 
     /// Append the next initializer value to the `GlobalOp` to construct
     /// the variable's initial value.
     void appendInitialValue(mlir::Operation *op);
 
     /// A GlobalOp has one region.
for (auto &op : getBlock())
         return emitOpError("dispatch table must contain dt_entry");
     return mlir::success();
   }];
 
   let regions = (region SizedRegion<1>:$region);
 
   let skipDefaultBuilders = 1;
   let builders = [
-    OpBuilderDAG<(ins "StringRef":$name, "Type":$type,
-      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs),
+    OpBuilderDAG<(ins "llvm::StringRef":$name, "mlir::Type":$type,
+      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs),
     [{
       $_state.addAttribute(mlir::SymbolTable::getSymbolAttrName(),
                            $_builder.getStringAttr(name));
       $_state.addAttributes(attrs);
     }]>
   ];
 
   let extraClassDeclaration = [{

flang/include/flang/Optimizer/Dialect/FIRType.h

 //===-- Optimizer/Dialect/FIRType.h -- FIR types ----------------*- 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
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #ifndef OPTIMIZER_DIALECT_FIRTYPE_H
 #define OPTIMIZER_DIALECT_FIRTYPE_H
 
 #include "mlir/IR/BuiltinAttributes.h"
 #include "mlir/IR/BuiltinTypes.h"
 #include "llvm/ADT/SmallVector.h"
 

 class ComplexType;
 class FloatType;
 } // namespace mlir
 
 namespace fir {
 
 class FIROpsDialect;
 
-using KindTy = int;
+using KindTy = unsigned;
 
 namespace detail {
 struct BoxTypeStorage;
 struct BoxCharTypeStorage;
 struct BoxProcTypeStorage;
 struct CharacterTypeStorage;
-struct CplxTypeStorage;
-struct DimsTypeStorage;
+struct ComplexTypeStorage;
 struct FieldTypeStorage;
 struct HeapTypeStorage;
-struct IntTypeStorage;
+struct IntegerTypeStorage;
 struct LenTypeStorage;
 struct LogicalTypeStorage;
 struct PointerTypeStorage;
 struct RealTypeStorage;
 struct RecordTypeStorage;
 struct ReferenceTypeStorage;
 struct SequenceTypeStorage;
+struct ShapeTypeStorage;
+struct ShapeShiftTypeStorage;
+struct SliceTypeStorage;
 struct TypeDescTypeStorage;
+struct VectorTypeStorage;
 } // namespace detail
 
 // These isa_ routines follow the precedent of llvm::isa_or_null<>
 
 /// Is `t` any of the FIR dialect types?
 bool isa_fir_type(mlir::Type t);
 
 /// Is `t` any of the Standard dialect types?
 bool isa_std_type(mlir::Type t);
 
 /// Is `t` any of the FIR dialect or Standard dialect types?
 bool isa_fir_or_std_type(mlir::Type t);
 
 /// Is `t` a FIR dialect type that implies a memory (de)reference?
 bool isa_ref_type(mlir::Type t);
 
-/// Is `t` a type that is always trivially pass-by-reference?
+/// Is `t` a type that is always trivially pass-by-reference? Specifically, this
+/// is testing if `t` is a ReferenceType or any box type. Compare this to
+/// conformsWithPassByRef(), which includes pointers and allocatables.
 bool isa_passbyref_type(mlir::Type t);
 
 /// Is `t` a boxed type?
 bool isa_box_type(mlir::Type t);
 
 /// Is `t` a type that can conform to be pass-by-reference? Depending on the
 /// context, these types may simply demote to pass-by-reference or a reference
 /// to them may have to be passed instead.
 inline bool conformsWithPassByRef(mlir::Type t) {
   return isa_ref_type(t) || isa_box_type(t);
 }
 
 /// Is `t` a FIR dialect aggregate type?
 bool isa_aggregate(mlir::Type t);
 
 /// Extract the `Type` pointed to from a FIR memory reference type. If `t` is
 /// not a memory reference type, then returns a null `Type`.
 mlir::Type dyn_cast_ptrEleTy(mlir::Type t);
 
 // Intrinsic types
 
 /// Model of the Fortran CHARACTER intrinsic type, including the KIND type
-/// parameter. The model does not include a LEN type parameter. A CharacterType
-/// is thus the type of a single character value.
+/// parameter. The model optionally includes a LEN type parameter. A
+/// CharacterType is thus the type of both a single character value and a
+/// character with a LEN parameter.
 class CharacterType
     : public mlir::Type::TypeBase<CharacterType, mlir::Type,
                                   detail::CharacterTypeStorage> {
 public:
   using Base::Base;
-  static CharacterType get(mlir::MLIRContext *ctxt, KindTy kind);
+  using LenType = std::int64_t;
+
+  static CharacterType get(mlir::MLIRContext *ctxt, KindTy kind, LenType len);
+  /// Return unknown length CHARACTER type.
+  static CharacterType getUnknownLen(mlir::MLIRContext *ctxt, KindTy kind) {
+    return get(ctxt, kind, unknownLen());
+  }
+  /// Return length 1 CHARACTER type.
+  static CharacterType getSingleton(mlir::MLIRContext *ctxt, KindTy kind) {
+    return get(ctxt, kind, singleton());
+  }
   KindTy getFKind() const;
+
+  /// CHARACTER is a singleton and has a LEN of 1.
+  static constexpr LenType singleton() { return 1; }
+  /// CHARACTER has an unknown LEN property.
+  static constexpr LenType unknownLen() { return -1; }
+
+  /// Access to a CHARACTER's LEN property. Defaults to 1.
+  LenType getLen() const;
 };
 
 /// Model of a Fortran COMPLEX intrinsic type, including the KIND type
 /// parameter. COMPLEX is a floating point type with a real and imaginary
 /// member.
-class CplxType : public mlir::Type::TypeBase<CplxType, mlir::Type,
-                                             detail::CplxTypeStorage> {
+class ComplexType : public mlir::Type::TypeBase<fir::ComplexType, mlir::Type,
+                                                detail::ComplexTypeStorage> {
 public:
   using Base::Base;
-  static CplxType get(mlir::MLIRContext *ctxt, KindTy kind);
+  static fir::ComplexType get(mlir::MLIRContext *ctxt, KindTy kind);
 
   /// Get the corresponding fir.real<k> type.
   mlir::Type getElementType() const;
 
   KindTy getFKind() const;
 };
 
 /// Model of a Fortran INTEGER intrinsic type, including the KIND type
 /// parameter.
-class IntType
-    : public mlir::Type::TypeBase<IntType, mlir::Type, detail::IntTypeStorage> {
+class IntegerType : public mlir::Type::TypeBase<fir::IntegerType, mlir::Type,
+                                                detail::IntegerTypeStorage> {
 public:
   using Base::Base;
-  static IntType get(mlir::MLIRContext *ctxt, KindTy kind);
+  static fir::IntegerType get(mlir::MLIRContext *ctxt, KindTy kind);
   KindTy getFKind() const;
 };
 
 /// Model of a Fortran LOGICAL intrinsic type, including the KIND type
 /// parameter.
-class LogicalType
-    : public mlir::Type::TypeBase<LogicalType, mlir::Type,
+class LogicalType : public mlir::Type::TypeBase<LogicalType, mlir::Type,
                                                 detail::LogicalTypeStorage> {
 public:
   using Base::Base;
   static LogicalType get(mlir::MLIRContext *ctxt, KindTy kind);
   KindTy getFKind() const;
 };
 
 /// Model of a Fortran REAL (and DOUBLE PRECISION) intrinsic type, including the
 /// KIND type parameter.
public:
   using Base::Base;
   static BoxProcType get(mlir::Type eleTy);
   mlir::Type getEleTy() const;
 
   static mlir::LogicalResult verifyConstructionInvariants(mlir::Location,
                                                           mlir::Type eleTy);
 };
 
-/// The type of a runtime vector that describes triples of array dimension
-/// information. A triple consists of a lower bound, upper bound, and
-/// stride. Each dimension of an array entity may have an associated triple that
-/// maps how elements of the array are accessed.
-class DimsType : public mlir::Type::TypeBase<DimsType, mlir::Type,
-                                             detail::DimsTypeStorage> {
+/// Type of a vector of runtime values that define the shape of a
+/// multidimensional array object. The vector is the extents of each array
+/// dimension. The rank of a ShapeType must be at least 1.
+class ShapeType : public mlir::Type::TypeBase<ShapeType, mlir::Type,
+                                              detail::ShapeTypeStorage> {
 public:
   using Base::Base;
-  static DimsType get(mlir::MLIRContext *ctx, unsigned rank);
+  static ShapeType get(mlir::MLIRContext *ctx, unsigned rank);
+  unsigned getRank() const;
+};
 
-  /// returns -1 if the rank is unknown
+/// Type of a vector of runtime values that define the shape and the origin of a
+/// multidimensional array object. The vector is of pairs, origin offset and
+/// extent, of each array dimension. The rank of a ShapeShiftType must be at
+/// least 1.
+class ShapeShiftType
+    : public mlir::Type::TypeBase<ShapeShiftType, mlir::Type,
+                                  detail::ShapeShiftTypeStorage> {
+public:
+  using Base::Base;
+  static ShapeShiftType get(mlir::MLIRContext *ctx, unsigned rank);
+  unsigned getRank() const;
+};
+
+/// Type of a vector that represents an array slice operation on an array.
+/// Fortran slices are triples of lower bound, upper bound, and stride. The rank
+/// of a SliceType must be at least 1.
+class SliceType : public mlir::Type::TypeBase<SliceType, mlir::Type,
+                                              detail::SliceTypeStorage> {
+public:
+  using Base::Base;
+  static SliceType get(mlir::MLIRContext *ctx, unsigned rank);
   unsigned getRank() const;
 };
 
 /// The type of a field name. Implementations may defer the layout of a Fortran
 /// derived type until runtime. This implies that the runtime must be able to
 /// determine the offset of fields within the entity.
 class FieldType : public mlir::Type::TypeBase<FieldType, mlir::Type,
                                               detail::FieldTypeStorage> {
void finalize(llvm::ArrayRef<TypePair> lenPList,
                 llvm::ArrayRef<TypePair> typeList);
 
   detail::RecordTypeStorage const *uniqueKey() const;
 
   static mlir::LogicalResult verifyConstructionInvariants(mlir::Location,
                                                           llvm::StringRef name);
 };
 
-mlir::Type parseFirType(FIROpsDialect *, mlir::DialectAsmParser &parser);
-
-void printFirType(FIROpsDialect *, mlir::Type ty, mlir::DialectAsmPrinter &p);
-
-/// Guarantee `type` is a scalar integral type (standard Integer, standard
-/// Index, or FIR Int). Aborts execution if condition is false.
-void verifyIntegralType(mlir::Type type);
-
 /// Is `t` a FIR Real or MLIR Float type?
 inline bool isa_real(mlir::Type t) {
   return t.isa<fir::RealType>() || t.isa<mlir::FloatType>();
 }
 
 /// Is `t` an integral type?
 inline bool isa_integer(mlir::Type t) {
   return t.isa<mlir::IndexType>() || t.isa<mlir::IntegerType>() ||
-         t.isa<fir::IntType>();
+         t.isa<fir::IntegerType>();
 }
 
+/// Replacement for the standard dialect's vector type. Relaxes some of the
+/// constraints and imposes some new ones.
+class VectorType : public mlir::Type::TypeBase<fir::VectorType, mlir::Type,
+                                               detail::VectorTypeStorage> {
+public:
+  using Base::Base;
+
+  static fir::VectorType get(uint64_t len, mlir::Type eleTy);
+  mlir::Type getEleTy() const;
+  uint64_t getLen() const;
+
+  static mlir::LogicalResult
+  verifyConstructionInvariants(mlir::Location, uint64_t len, mlir::Type eleTy);
+  static bool isValidElementType(mlir::Type t) {
+    return isa_real(t) || isa_integer(t);
+  }
+};
+
+mlir::Type parseFirType(FIROpsDialect *, mlir::DialectAsmParser &parser);
+
+void printFirType(FIROpsDialect *, mlir::Type ty, mlir::DialectAsmPrinter &p);
+
+/// Guarantee `type` is a scalar integral type (standard Integer, standard
+/// Index, or FIR Int). Aborts execution if condition is false.
+void verifyIntegralType(mlir::Type type);
+
 /// Is `t` a FIR or MLIR Complex type?
 inline bool isa_complex(mlir::Type t) {
-  return t.isa<fir::CplxType>() || t.isa<mlir::ComplexType>();
+  return t.isa<fir::ComplexType>() || t.isa<mlir::ComplexType>();
 }
 
+inline bool isa_char_string(mlir::Type t) {
+  if (auto ct = t.dyn_cast_or_null<fir::CharacterType>())
+    return ct.getLen() != fir::CharacterType::singleton();
+  return false;
+}
+
+/// Is `t` a box type for which it is not possible to deduce the box size.
+/// It is not possible to deduce the size of a box that describes an entity
+/// of unknown rank or type.
+bool isa_unknown_size_box(mlir::Type t);
+
 } // namespace fir
 
 #endif // OPTIMIZER_DIALECT_FIRTYPE_H

flang/include/flang/Optimizer/TypePredicates.td

+//===-- TypePredicates.td ----------------------------------*- tablegen -*-===//
+//
+// 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 FIR_OPTIMIZER_TYPEPREDICATES
+#define FIR_OPTIMIZER_TYPEPREDICATES
+
+def fir_IntegerType : Type<CPred<"$_self.isa<fir::IntegerType>()">,
+    "FIR integer type">;
+
+def AnyIntegerLike : TypeConstraint<Or<[SignlessIntegerLike.predicate,
+    AnySignedInteger.predicate, fir_IntegerType.predicate]>, "any integer">;
+
+def AnyIntegerType : Type<AnyIntegerLike.predicate, "any integer">;
+
+// Reference to an entity type
+def fir_ReferenceType : Type<CPred<"$_self.isa<fir::ReferenceType>()">,
+    "reference type">;
+
+// Reference to an ALLOCATABLE attribute type
+def fir_HeapType : Type<CPred<"$_self.isa<fir::HeapType>()">,
+    "allocatable type">;
+
+// Reference to a POINTER attribute type
+def fir_PointerType : Type<CPred<"$_self.isa<fir::PointerType>()">,
+    "pointer type">;
+
+// Reference types
+def AnyReferenceLike : TypeConstraint<Or<[fir_ReferenceType.predicate,
+    fir_HeapType.predicate, fir_PointerType.predicate]>, "any reference">;
+
+// A field (in a RecordType) argument's type
+def fir_FieldType : Type<CPred<"$_self.isa<fir::FieldType>()">, "field type">;
+
+// A LEN parameter (in a RecordType) argument's type
+def fir_LenType : Type<CPred<"$_self.isa<fir::LenType>()">,
+    "LEN parameter type">;
+
+// A descriptor tuple (captures a reference to an entity and other information)
+def fir_BoxType : Type<CPred<"$_self.isa<fir::BoxType>()">, "box type">;
+
+def AnyCoordinateLike : TypeConstraint<Or<[AnySignlessInteger.predicate,
+    Index.predicate, fir_IntegerType.predicate, fir_FieldType.predicate,
+    fir_LenType.predicate]>, "any coordinate index">;
+
+def AnyCoordinateType : Type<AnyCoordinateLike.predicate, "coordinate type">;
+
+#endif

flang/lib/Lower/ComplexExpr.cpp

 #include "flang/Lower/ConvertType.h"
 
 //===----------------------------------------------------------------------===//
 // ComplexExprHelper implementation
 //===----------------------------------------------------------------------===//
 
 mlir::Type
 Fortran::lower::ComplexExprHelper::getComplexPartType(mlir::Type complexType) {
-  return {};
+  return Fortran::lower::convertReal(
+      builder.getContext(), complexType.cast<fir::ComplexType>().getFKind());
 }
 
 mlir::Type
 Fortran::lower::ComplexExprHelper::getComplexPartType(mlir::Value cplx) {
   return getComplexPartType(cplx.getType());
 }
 
 mlir::Value Fortran::lower::ComplexExprHelper::createComplex(fir::KindTy kind,
                                                              mlir::Value real,
                                                              mlir::Value imag) {
-  return {};
+  auto complexTy = fir::ComplexType::get(builder.getContext(), kind);
+  mlir::Value und = builder.create<fir::UndefOp>(loc, complexTy);
+  return insert<Part::Imag>(insert<Part::Real>(und, real), imag);
 }
 
 mlir::Value Fortran::lower::ComplexExprHelper::createComplex(mlir::Type cplxTy,
                                                              mlir::Value real,
                                                              mlir::Value imag) {
   mlir::Value und = builder.create<fir::UndefOp>(loc, cplxTy);
   return insert<Part::Imag>(insert<Part::Real>(und, real), imag);
 }

flang/lib/Lower/ConvertType.cpp

genFIRType<Fortran::common::TypeCategory::Character>(mlir::MLIRContext *context,
                                                      int KIND) {
   return {};
 }
 
 template <>
 mlir::Type
 genFIRType<Fortran::common::TypeCategory::Complex>(mlir::MLIRContext *context,
                                                    int KIND) {
+  if (Fortran::evaluate::IsValidKindOfIntrinsicType(
+          Fortran::common::TypeCategory::Complex, KIND))
+    return fir::ComplexType::get(context, KIND);
   return {};
 }
 
 namespace {
 
 /// 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 {

flang/lib/Lower/DoLoopHelper.cpp

 
 //===----------------------------------------------------------------------===//
 // DoLoopHelper implementation
 //===----------------------------------------------------------------------===//
 
 void Fortran::lower::DoLoopHelper::createLoop(
     mlir::Value lb, mlir::Value ub, mlir::Value step,
     const BodyGenerator &bodyGenerator) {
+  auto lbi = builder.convertToIndexType(loc, lb);
+  auto ubi = builder.convertToIndexType(loc, ub);
+  assert(step && "step must be an actual Value");
+  auto inc = builder.convertToIndexType(loc, step);
+  fir::DoLoopOp loop;
+  auto insertPt = builder.saveInsertionPoint();
+  builder.setInsertionPointToStart(loop.getBody());
+  auto index = loop.getInductionVar();
+  bodyGenerator(builder, index);
+  builder.restoreInsertionPoint(insertPt);
 }
 
 void Fortran::lower::DoLoopHelper::createLoop(
     mlir::Value lb, mlir::Value ub, const BodyGenerator &bodyGenerator) {
   createLoop(lb, ub,
              builder.createIntegerConstant(loc, builder.getIndexType(), 1),
              bodyGenerator);
 }

flang/lib/Lower/FIRBuilder.cpp

mlir::Value Fortran::lower::FirOpBuilder::convertWithSemantics(
   auto fromTy = val.getType();
   if (fromTy == toTy)
     return val;
   // FIXME: add a fir::is_integer() test
   ComplexExprHelper helper{*this, loc};
   if ((fir::isa_real(fromTy) || fromTy.isSignlessInteger()) &&
       fir::isa_complex(toTy)) {
     // imaginary part is zero
+    auto eleTy = helper.getComplexPartType(toTy);
+    auto cast = createConvert(loc, eleTy, val);
+    llvm::APFloat zero{
+        kindMap.getFloatSemantics(toTy.cast<fir::ComplexType>().getFKind()), 0};
+    auto imag = createRealConstant(loc, eleTy, zero);
+    return helper.createComplex(toTy, cast, imag);
   }
   // FIXME: add a fir::is_integer() test
   if (fir::isa_complex(fromTy) &&
       (toTy.isSignlessInteger() || fir::isa_real(toTy))) {
     // drop the imaginary part
     auto rp = helper.extractComplexPart(val, /*isImagPart=*/false);
     return createConvert(loc, toTy, rp);
   }

flang/lib/Lower/IO.cpp

static void makeNextConditionalOn(Fortran::lower::FirOpBuilder &builder,
                                   bool inIterWhileLoop = false) {
   if (!checkResult || !ok)
     // Either I/O calls do not need to be checked, or the next I/O call is the
     // first potentially fallable call.
     return;
   // A previous I/O call for a statement returned the bool `ok`.  If this call
   // is in a fir.iterate_while loop, the result must be propagated up to the
   // loop scope.  That is done in genIoLoop, but it is enabled here.
+  auto whereOp =
+      inIterWhileLoop
+          ? builder.create<fir::IfOp>(loc, builder.getI1Type(), ok, true)
+          : builder.create<fir::IfOp>(loc, ok, /*withOtherwise=*/false);
+  if (!insertPt.isSet())
+    insertPt = builder.saveInsertionPoint();
+  builder.setInsertionPointToStart(&whereOp.thenRegion().front());
 }
 
 template <typename D>
 static void genIoLoop(Fortran::lower::AbstractConverter &converter,
                       mlir::Value cookie, const D &ioImpliedDo,
                       bool checkResult, mlir::Value &ok, bool inIterWhileLoop);
 
 /// Get the OutputXyz routine to output a value of the given type.
 static mlir::FuncOp getOutputFunc(mlir::Location loc,
                                   Fortran::lower::FirOpBuilder &builder,
                                   mlir::Type type) {
   if (auto ty = type.dyn_cast<mlir::IntegerType>())
     return ty.getWidth() == 1
                ? getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder)
                : getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
   if (auto ty = type.dyn_cast<mlir::FloatType>())
     return ty.getWidth() <= 32
                ? getIORuntimeFunc<mkIOKey(OutputReal32)>(loc, builder)
                : getIORuntimeFunc<mkIOKey(OutputReal64)>(loc, builder);
+  if (auto ty = type.dyn_cast<fir::ComplexType>())
+    return ty.getFKind() <= 4
+               ? getIORuntimeFunc<mkIOKey(OutputComplex32)>(loc, builder)
+               : getIORuntimeFunc<mkIOKey(OutputComplex64)>(loc, builder);
   if (type.isa<fir::LogicalType>())
     return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
   if (type.isa<fir::BoxType>())
     return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
   if (Fortran::lower::CharacterExprHelper::isCharacter(type))
     return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder);
   // TODO: handle arrays
   mlir::emitError(loc, "output for entity type ") << type << " not implemented";
static mlir::FuncOp getInputFunc(mlir::Location loc,
   if (auto ty = type.dyn_cast<mlir::IntegerType>())
     return ty.getWidth() == 1
                ? getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder)
                : getIORuntimeFunc<mkIOKey(InputInteger)>(loc, builder);
   if (auto ty = type.dyn_cast<mlir::FloatType>())
     return ty.getWidth() <= 32
                ? getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder)
                : getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder);
+  if (auto ty = type.dyn_cast<fir::ComplexType>())
+    return ty.getFKind() <= 4
+               ? getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder)
+               : getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder);
   if (type.isa<fir::LogicalType>())
     return getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder);
   if (type.isa<fir::BoxType>())
     return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
   if (Fortran::lower::CharacterExprHelper::isCharacter(type))
     return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder);
   // TODO: handle arrays
   mlir::emitError(loc, "input for entity type ") << type << " not implemented";
makeNextConditionalOn(builder, loc, insertPt, checkResult, ok,
                           inIterWhileLoop);
     auto itemAddr =
         converter.genExprAddr(Fortran::semantics::GetExpr(pVar), loc);
     auto itemType = itemAddr.getType().cast<fir::ReferenceType>().getEleTy();
     auto inputFunc = getInputFunc(loc, builder, itemType);
     auto argType = inputFunc.getType().getInput(1);
     auto originalItemAddr = itemAddr;
     mlir::Type complexPartType;
+    if (itemType.isa<fir::ComplexType>())
+      complexPartType = builder.getRefType(
+          Fortran::lower::ComplexExprHelper{builder, loc}.getComplexPartType(
+              itemType));
     auto complexPartAddr = [&](int index) {
       return builder.create<fir::CoordinateOp>(
           loc, complexPartType, originalItemAddr,
           llvm::SmallVector<mlir::Value, 1>{builder.create<mlir::ConstantOp>(
               loc, builder.getI32IntegerAttr(index))});
     };
     if (complexPartType)
       itemAddr = complexPartAddr(0); // real part
if constexpr (std::is_same_v<D, Fortran::parser::InputImpliedDo>)
       genInputItemList(converter, cookie, itemList, insertPt, checkResult, ok,
                        true);
     else
       genOutputItemList(converter, cookie, itemList, insertPt, checkResult, ok,
                         true);
   };
   if (!checkResult) {
     // No I/O call result checks - the loop is a fir.do_loop op.
+    fir::DoLoopOp loopOp;
+    builder.setInsertionPointToStart(loopOp.getBody());
+    auto lcv = builder.createConvert(loc, converter.genType(loopSym),
+                                     loopOp.getInductionVar());
+    builder.create<fir::StoreOp>(loc, lcv, loopVar);
+    insertPt = builder.saveInsertionPoint();
+    genItemList(ioImpliedDo, false);
+    builder.restoreInsertionPoint(parentInsertPt);
     return;
   }
   // Check I/O call results - the loop is a fir.iterate_while op.
   if (!ok)
     ok = builder.createIntegerConstant(loc, builder.getI1Type(), 1);
   fir::IterWhileOp iterWhileOp = builder.create<fir::IterWhileOp>(
       loc, lowerValue, upperValue, stepValue, ok);
   builder.setInsertionPointToStart(iterWhileOp.getBody());
   auto lcv = builder.createConvert(loc, converter.genType(loopSym),
                                    iterWhileOp.getInductionVar());
   builder.create<fir::StoreOp>(loc, lcv, loopVar);
   insertPt = builder.saveInsertionPoint();
   ok = iterWhileOp.getIterateVar();
   auto falseValue = builder.createIntegerConstant(loc, builder.getI1Type(), 0);
   genItemList(ioImpliedDo, true);
   // Unwind nested I/O call scopes, filling in true and false ResultOp's.
+  for (auto *op = builder.getBlock()->getParentOp(); isa<fir::IfOp>(op);
+       op = op->getBlock()->getParentOp()) {
+    auto whereOp = dyn_cast<fir::IfOp>(op);
+    auto *lastOp = &whereOp.thenRegion().front().back();
+    builder.setInsertionPointAfter(lastOp);
+    builder.create<fir::ResultOp>(loc, lastOp->getResult(0)); // runtime result
+    builder.setInsertionPointToStart(&whereOp.elseRegion().front());
+    builder.create<fir::ResultOp>(loc, falseValue); // known false result
+  }
   builder.restoreInsertionPoint(insertPt);
   builder.create<fir::ResultOp>(loc, builder.getBlock()->back().getResult(0));
   ok = iterWhileOp.getResult(0);
   builder.restoreInsertionPoint(parentInsertPt);
 }
 
 //===----------------------------------------------------------------------===//
 // Default argument generation.

flang/lib/Lower/IntrinsicCall.cpp

private:
   static unsigned getFloatingPointWidth(mlir::Type t) {
     if (auto f{t.dyn_cast<mlir::FloatType>()})
       return f.getWidth();
     // FIXME: Get width another way for fir.real/complex
     // - use fir/KindMapping.h and llvm::Type
     // - or use evaluate/type.h
     if (auto r{t.dyn_cast<fir::RealType>()})
       return r.getFKind() * 4;
+    if (auto cplx{t.dyn_cast<fir::ComplexType>()})
+      return cplx.getFKind() * 4;
     llvm_unreachable("not a floating-point type");
   }
 
   static Conversion conversionBetweenTypes(mlir::Type from, mlir::Type to) {
     if (from == to) {
       return Conversion::None;
     }
     if (auto fromIntTy{from.dyn_cast<mlir::IntegerType>()}) {
       if (auto toIntTy{to.dyn_cast<mlir::IntegerType>()}) {
         return fromIntTy.getWidth() > toIntTy.getWidth() ? Conversion::Narrow
                                                          : Conversion::Extend;
       }
     }
     if (fir::isa_real(from) && fir::isa_real(to)) {
       return getFloatingPointWidth(from) > getFloatingPointWidth(to)
                  ? Conversion::Narrow
                  : Conversion::Extend;
     }
+    if (auto fromCplxTy{from.dyn_cast<fir::ComplexType>()}) {
+      if (auto toCplxTy{to.dyn_cast<fir::ComplexType>()}) {
+        return getFloatingPointWidth(fromCplxTy) >
+                       getFloatingPointWidth(toCplxTy)
+                   ? Conversion::Narrow
+                   : Conversion::Extend;
+      }
+    }
     // Notes:
     // - No conversion between character types, specialization of runtime
     // functions should be made instead.
     // - It is not clear there is a use case for automatic conversions
     // around Logical and it may damage hidden information in the physical
     // storage so do not do it.
     return Conversion::Forbidden;
   }

flang/lib/Lower/Mangler.cpp

 /// Note: mlir has Type::dump(ostream) methods but it may add "!" that is not
 /// suitable for function names.
 static std::string typeToString(mlir::Type t) {
   if (auto refT{t.dyn_cast<fir::ReferenceType>()})
     return "ref_" + typeToString(refT.getEleTy());
   if (auto i{t.dyn_cast<mlir::IntegerType>()}) {
     return "i" + std::to_string(i.getWidth());
   }
+  if (auto cplx{t.dyn_cast<fir::ComplexType>()}) {
+    return "z" + std::to_string(cplx.getFKind());
+  }
   if (auto real{t.dyn_cast<fir::RealType>()}) {
     return "r" + std::to_string(real.getFKind());
   }
   if (auto f{t.dyn_cast<mlir::FloatType>()}) {
     return "f" + std::to_string(f.getWidth());
   }
   if (auto logical{t.dyn_cast<fir::LogicalType>()}) {
     return "l" + std::to_string(logical.getFKind());

flang/lib/Optimizer/Dialect/FIRAttr.cpp

 //===-- FIRAttr.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
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Support/KindMapping.h"
 #include "mlir/IR/AttributeSupport.h"
 #include "mlir/IR/DialectImplementation.h"
-#include "mlir/IR/Types.h"
+#include "mlir/IR/BuiltinTypes.h"
 #include "llvm/ADT/SmallString.h"
 
 using namespace fir;
 
-namespace fir {
-namespace detail {
+namespace fir::detail {
 
 struct RealAttributeStorage : public mlir::AttributeStorage {
   using KeyTy = std::pair<int, llvm::APFloat>;
 
   RealAttributeStorage(int kind, const llvm::APFloat &value)
       : kind(kind), value(value) {}
   RealAttributeStorage(const KeyTy &key)
       : RealAttributeStorage(key.first, key.second) {}
return new (allocator.allocate<TypeAttributeStorage>())
         TypeAttributeStorage(key);
   }
 
   mlir::Type getType() const { return value; }
 
 private:
   mlir::Type value;
 };
-} // namespace detail
 
-ExactTypeAttr ExactTypeAttr::get(mlir::Type value) {
+/// An attribute representing a raw pointer.
+struct OpaqueAttributeStorage : public mlir::AttributeStorage {
+  using KeyTy = void *;
+
+  OpaqueAttributeStorage(void *value) : value(value) {}
+
+  /// Key equality function.
+  bool operator==(const KeyTy &key) const { return key == value; }
+
+  /// Construct a new storage instance.
+  static OpaqueAttributeStorage *
+  construct(mlir::AttributeStorageAllocator &allocator, KeyTy key) {
+    return new (allocator.allocate<OpaqueAttributeStorage>())
+        OpaqueAttributeStorage(key);
+  }
+
+  void *getPointer() const { return value; }
+
+private:
+  void *value;
+};
+} // namespace fir::detail
+
+//===----------------------------------------------------------------------===//
+// Attributes for SELECT TYPE
+//===----------------------------------------------------------------------===//
+
+ExactTypeAttr fir::ExactTypeAttr::get(mlir::Type value) {
   return Base::get(value.getContext(), value);
 }
 
-mlir::Type ExactTypeAttr::getType() const { return getImpl()->getType(); }
+mlir::Type fir::ExactTypeAttr::getType() const { return getImpl()->getType(); }
 
-SubclassAttr SubclassAttr::get(mlir::Type value) {
+SubclassAttr fir::SubclassAttr::get(mlir::Type value) {
   return Base::get(value.getContext(), value);
 }
 
-mlir::Type SubclassAttr::getType() const { return getImpl()->getType(); }
+mlir::Type fir::SubclassAttr::getType() const { return getImpl()->getType(); }
+
+//===----------------------------------------------------------------------===//
+// Attributes for SELECT CASE
+//===----------------------------------------------------------------------===//
 
 using AttributeUniquer = mlir::detail::AttributeUniquer;
 
-ClosedIntervalAttr ClosedIntervalAttr::get(mlir::MLIRContext *ctxt) {
+ClosedIntervalAttr fir::ClosedIntervalAttr::get(mlir::MLIRContext *ctxt) {
   return AttributeUniquer::get<ClosedIntervalAttr>(ctxt);
 }
 
-UpperBoundAttr UpperBoundAttr::get(mlir::MLIRContext *ctxt) {
+UpperBoundAttr fir::UpperBoundAttr::get(mlir::MLIRContext *ctxt) {
   return AttributeUniquer::get<UpperBoundAttr>(ctxt);
 }
 
-LowerBoundAttr LowerBoundAttr::get(mlir::MLIRContext *ctxt) {
+LowerBoundAttr fir::LowerBoundAttr::get(mlir::MLIRContext *ctxt) {
   return AttributeUniquer::get<LowerBoundAttr>(ctxt);
 }
 
-PointIntervalAttr PointIntervalAttr::get(mlir::MLIRContext *ctxt) {
+PointIntervalAttr fir::PointIntervalAttr::get(mlir::MLIRContext *ctxt) {
   return AttributeUniquer::get<PointIntervalAttr>(ctxt);
 }
 
+//===----------------------------------------------------------------------===//
 // RealAttr
+//===----------------------------------------------------------------------===//
 
-RealAttr RealAttr::get(mlir::MLIRContext *ctxt,
+RealAttr fir::RealAttr::get(mlir::MLIRContext *ctxt,
                             const RealAttr::ValueType &key) {
   return Base::get(ctxt, key);
 }
 
-int RealAttr::getFKind() const { return getImpl()->getFKind(); }
+int fir::RealAttr::getFKind() const { return getImpl()->getFKind(); }
+
+llvm::APFloat fir::RealAttr::getValue() const { return getImpl()->getValue(); }
 
-llvm::APFloat RealAttr::getValue() const { return getImpl()->getValue(); }
+//===----------------------------------------------------------------------===//
+// OpaqueAttr
+//===----------------------------------------------------------------------===//
+
+OpaqueAttr fir::OpaqueAttr::get(mlir::MLIRContext *ctxt, void *key) {
+  return Base::get(ctxt, key);
+}
 
+void *fir::OpaqueAttr::getPointer() const { return getImpl()->getPointer(); }
+
+//===----------------------------------------------------------------------===//
 // FIR attribute parsing
+//===----------------------------------------------------------------------===//
 
-namespace {
-mlir::Attribute parseFirRealAttr(FIROpsDialect *dialect,
+static mlir::Attribute parseFirRealAttr(FIROpsDialect *dialect,
                                         mlir::DialectAsmParser &parser,
                                         mlir::Type type) {
   int kind = 0;
   if (parser.parseLess() || parser.parseInteger(kind) || parser.parseComma()) {
     parser.emitError(parser.getNameLoc(), "expected '<' kind ','");
     return {};
   }
   KindMapping kindMap(dialect->getContext());
   llvm::APFloat value(0.);
   if (parser.parseOptionalKeyword("i")) {
if (parser.parseKeyword(&hex) || parser.parseGreater()) {
       parser.emitError(parser.getNameLoc(), "expected real constant '>'");
       return {};
     }
     auto bits = llvm::APInt(kind * 8, hex.drop_front(), 16);
     value = llvm::APFloat(kindMap.getFloatSemantics(kind), bits);
   }
   return RealAttr::get(dialect->getContext(), {kind, value});
 }
-} // namespace
 
-mlir::Attribute parseFirAttribute(FIROpsDialect *dialect,
+mlir::Attribute fir::parseFirAttribute(FIROpsDialect *dialect,
                                        mlir::DialectAsmParser &parser,
                                        mlir::Type type) {
   auto loc = parser.getNameLoc();
   llvm::StringRef attrName;
   if (parser.parseKeyword(&attrName)) {
     parser.emitError(loc, "expected an attribute name");
     return {};
   }
 
   if (attrName == ExactTypeAttr::getAttrName()) {
     mlir::Type type;
     if (parser.parseLess() || parser.parseType(type) || parser.parseGreater()) {
       parser.emitError(loc, "expected a type");
       return {};
     }
     return ExactTypeAttr::get(type);
   }
   if (attrName == SubclassAttr::getAttrName()) {
     mlir::Type type;
     if (parser.parseLess() || parser.parseType(type) || parser.parseGreater()) {
       parser.emitError(loc, "expected a subtype");
       return {};
     }
     return SubclassAttr::get(type);
   }
+  if (attrName == OpaqueAttr::getAttrName()) {
+    if (parser.parseLess() || parser.parseGreater()) {
+      parser.emitError(loc, "expected <>");
+      return {};
+    }
+    // NB: opaque pointers are always parsed in as nullptrs. The tool must
+    // rebuild the context.
+    return OpaqueAttr::get(dialect->getContext(), nullptr);
+  }
   if (attrName == PointIntervalAttr::getAttrName())
     return PointIntervalAttr::get(dialect->getContext());
   if (attrName == LowerBoundAttr::getAttrName())
     return LowerBoundAttr::get(dialect->getContext());
   if (attrName == UpperBoundAttr::getAttrName())
     return UpperBoundAttr::get(dialect->getContext());
   if (attrName == ClosedIntervalAttr::getAttrName())
     return ClosedIntervalAttr::get(dialect->getContext());
   if (attrName == RealAttr::getAttrName())
     return parseFirRealAttr(dialect, parser, type);
 
   parser.emitError(loc, "unknown FIR attribute: ") << attrName;
   return {};
 }
 
+//===----------------------------------------------------------------------===//
 // FIR attribute pretty printer
+//===----------------------------------------------------------------------===//
 
-void printFirAttribute(FIROpsDialect *dialect, mlir::Attribute attr,
+void fir::printFirAttribute(FIROpsDialect *dialect, mlir::Attribute attr,
                             mlir::DialectAsmPrinter &p) {
   auto &os = p.getStream();
   if (auto exact = attr.dyn_cast<fir::ExactTypeAttr>()) {
     os << fir::ExactTypeAttr::getAttrName() << '<';
     p.printType(exact.getType());
     os << '>';
   } else if (auto sub = attr.dyn_cast<fir::SubclassAttr>()) {
     os << fir::SubclassAttr::getAttrName() << '<';
     p.printType(sub.getType());
     os << '>';
   } else if (attr.dyn_cast_or_null<fir::PointIntervalAttr>()) {
     os << fir::PointIntervalAttr::getAttrName();
   } else if (attr.dyn_cast_or_null<fir::ClosedIntervalAttr>()) {
     os << fir::ClosedIntervalAttr::getAttrName();
   } else if (attr.dyn_cast_or_null<fir::LowerBoundAttr>()) {
     os << fir::LowerBoundAttr::getAttrName();
   } else if (attr.dyn_cast_or_null<fir::UpperBoundAttr>()) {
     os << fir::UpperBoundAttr::getAttrName();
   } else if (auto a = attr.dyn_cast_or_null<fir::RealAttr>()) {
     os << fir::RealAttr::getAttrName() << '<' << a.getFKind() << ", i x";
     llvm::SmallString<40> ss;
     a.getValue().bitcastToAPInt().toStringUnsigned(ss, 16);
     os << ss << '>';
+  } else if (attr.isa<fir::OpaqueAttr>()) {
+    os << fir::OpaqueAttr::getAttrName() << "<>";
   } else {
-    llvm_unreachable("attribute pretty-printer is not implemented");
+    // don't know how to print the attribute, so use a default
+    os << "<(unknown attribute)>";
   }
 }
-
-} // namespace fir

flang/lib/Optimizer/Dialect/FIRDialect.cpp

 //===-- FIRDialect.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
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/Transforms/Passes.h"
+#include "mlir/Transforms/InliningUtils.h"
 
 using namespace fir;
 
+namespace {
+/// This class defines the interface for handling inlining of FIR calls.
+struct FIRInlinerInterface : public mlir::DialectInlinerInterface {
+  using DialectInlinerInterface::DialectInlinerInterface;
+
+  bool isLegalToInline(mlir::Operation *call, mlir::Operation *callable,
+                       bool wouldBeCloned) const final {
+    return false; //fir::canLegallyInline(call, callable, wouldBeCloned);
+  }
+
+  /// This hook checks to see if the operation `op` is legal to inline into the
+  /// given region `reg`.
+  bool isLegalToInline(mlir::Operation *op, mlir::Region *reg,
+                       bool wouldBeCloned,
+                       mlir::BlockAndValueMapping &map) const final {
+    return false; //fir::canLegallyInline(op, reg, wouldBeCloned, map);
+  }
+
+  /// This hook is called when a terminator operation has been inlined.
+  /// We handle the return (a Fortran FUNCTION) by replacing the values
+  /// previously returned by the call operation with the operands of the
+  /// return.
+  void handleTerminator(mlir::Operation *op,
+                        llvm::ArrayRef<mlir::Value> valuesToRepl) const final {
+    auto returnOp = cast<mlir::ReturnOp>(op);
+    assert(returnOp.getNumOperands() == valuesToRepl.size());
+    for (const auto &it : llvm::enumerate(returnOp.getOperands()))
+      valuesToRepl[it.index()].replaceAllUsesWith(it.value());
+  }
+
+  mlir::Operation *materializeCallConversion(mlir::OpBuilder &builder,
+                                             mlir::Value input,
+                                             mlir::Type resultType,
+                                             mlir::Location loc) const {
+    return builder.create<fir::ConvertOp>(loc, resultType, input);
+  }
+};
+} // namespace
+
 fir::FIROpsDialect::FIROpsDialect(mlir::MLIRContext *ctx)
     : mlir::Dialect("fir", ctx, mlir::TypeID::get<FIROpsDialect>()) {
-  addTypes<BoxType, BoxCharType, BoxProcType, CharacterType, CplxType, DimsType,
-           FieldType, HeapType, IntType, LenType, LogicalType, PointerType,
-           RealType, RecordType, ReferenceType, SequenceType, TypeDescType>();
-  addAttributes<ClosedIntervalAttr, ExactTypeAttr, LowerBoundAttr,
+  addTypes<BoxType, BoxCharType, BoxProcType, CharacterType, fir::ComplexType,
+           FieldType, HeapType, fir::IntegerType, LenType, LogicalType,
+           PointerType, RealType, RecordType, ReferenceType, SequenceType,
+           ShapeType, ShapeShiftType, SliceType, TypeDescType,
+           fir::VectorType>();
+  addAttributes<ClosedIntervalAttr, ExactTypeAttr, LowerBoundAttr, OpaqueAttr,
                 PointIntervalAttr, RealAttr, SubclassAttr, UpperBoundAttr>();
   addOperations<
 #define GET_OP_LIST
 #include "flang/Optimizer/Dialect/FIROps.cpp.inc"
       >();
+  addInterfaces<FIRInlinerInterface>();
 }
 
 // anchor the class vtable to this compilation unit
 fir::FIROpsDialect::~FIROpsDialect() {
   // do nothing
 }
 
 mlir::Type fir::FIROpsDialect::parseType(mlir::DialectAsmParser &parser) const {

flang/lib/Optimizer/Dialect/FIROps.cpp

 //===-- FIROps.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
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "mlir/Dialect/CommonFolders.h"
 #include "mlir/Dialect/StandardOps/IR/Ops.h"
 #include "mlir/IR/BuiltinOps.h"
 #include "mlir/IR/Diagnostics.h"
 #include "mlir/IR/Matchers.h"
+#include "mlir/IR/PatternMatch.h"
 #include "llvm/ADT/StringSwitch.h"
 #include "llvm/ADT/TypeSwitch.h"
 
 using namespace fir;
 
 /// Return true if a sequence type is of some incomplete size or a record type
 /// is malformed or contains an incomplete sequence type. An incomplete sequence
 /// type is one with more unknown extents in the type than have been provided
mlir::Type fir::AllocMemOp::wrapResultType(mlir::Type intype) {
   // FIR semantics: one may not allocate a memory reference value
   if (intype.isa<ReferenceType>() || intype.isa<HeapType>() ||
       intype.isa<PointerType>() || intype.isa<FunctionType>())
     return {};
   return HeapType::get(intype);
 }
 
 //===----------------------------------------------------------------------===//
+// ArrayCoorOp
+//===----------------------------------------------------------------------===//
+
+static mlir::LogicalResult verify(fir::ArrayCoorOp op) {
+  auto eleTy = fir::dyn_cast_ptrEleTy(op.memref().getType());
+  if (!eleTy)
+    return op.emitOpError("must be a reference type");
+  auto arrTy = eleTy.dyn_cast<fir::SequenceType>();
+  if (!arrTy)
+    return op.emitOpError("must be a reference to an array");
+  auto arrDim = arrTy.getDimension();
+
+  if (auto shapeOp = op.shape()) {
+    auto shapeTy = shapeOp.getType();
+    unsigned shapeTyRank = 0;
+    if (auto s = shapeTy.dyn_cast<fir::ShapeType>()) {
+      shapeTyRank = s.getRank();
+    } else {
+      auto ss = shapeTy.cast<fir::ShapeShiftType>();
+      shapeTyRank = ss.getRank();
+    }
+    if (arrDim && arrDim != shapeTyRank)
+      return op.emitOpError("rank of dimension mismatched");
+    if (shapeTyRank != op.indices().size())
+      return op.emitOpError("number of indices do not match dim rank");
+  }
+
+  if (auto sliceOp = op.slice())
+    if (auto sliceTy = sliceOp.getType().dyn_cast<fir::SliceType>())
+      if (sliceTy.getRank() != arrDim)
+        return op.emitOpError("rank of dimension in slice mismatched");
+
+  return mlir::success();
+}
+
+//===----------------------------------------------------------------------===//
+// ArrayLoadOp
+//===----------------------------------------------------------------------===//
+
+std::vector<mlir::Value> fir::ArrayLoadOp::getExtents() {
+  if (auto sh = shape())
+    if (auto *op = sh.getDefiningOp()) {
+      if (auto shOp = dyn_cast<fir::ShapeOp>(op))
+        return shOp.getExtents();
+      return cast<fir::ShapeShiftOp>(op).getExtents();
+    }
+  return {};
+}
+
+static mlir::LogicalResult verify(fir::ArrayLoadOp op) {
+  auto eleTy = fir::dyn_cast_ptrEleTy(op.memref().getType());
+  if (!eleTy)
+    return op.emitOpError("must be a reference type");
+  auto arrTy = eleTy.dyn_cast<fir::SequenceType>();
+  if (!arrTy)
+    return op.emitOpError("must be a reference to an array");
+  auto arrDim = arrTy.getDimension();
+
+  if (auto shapeOp = op.shape()) {
+    auto shapeTy = shapeOp.getType();
+    unsigned shapeTyRank = 0;
+    if (auto s = shapeTy.dyn_cast<fir::ShapeType>()) {
+      shapeTyRank = s.getRank();
+    } else {
+      auto ss = shapeTy.cast<fir::ShapeShiftType>();
+      shapeTyRank = ss.getRank();
+    }
+    if (arrDim && arrDim != shapeTyRank)
+      return op.emitOpError("rank of dimension mismatched");
+  }
+
+  if (auto sliceOp = op.slice())
+    if (auto sliceTy = sliceOp.getType().dyn_cast<fir::SliceType>())
+      if (sliceTy.getRank() != arrDim)
+        return op.emitOpError("rank of dimension in slice mismatched");
+
+  return mlir::success();
+}
+
+//===----------------------------------------------------------------------===//
 // BoxAddrOp
 //===----------------------------------------------------------------------===//
 
 mlir::OpFoldResult fir::BoxAddrOp::fold(llvm::ArrayRef<mlir::Attribute> opnds) {
   if (auto v = val().getDefiningOp()) {
     if (auto box = dyn_cast<fir::EmboxOp>(v))
       return box.memref();
     if (auto box = dyn_cast<fir::EmboxCharOp>(v))
llvm::SmallVector<mlir::Type, 4> triple{
       getResult(0).getType(), getResult(1).getType(), getResult(2).getType()};
   return mlir::TupleType::get(getContext(), triple);
 }
 
 //===----------------------------------------------------------------------===//
 // CallOp
 //===----------------------------------------------------------------------===//
 
+mlir::FunctionType fir::CallOp::getFunctionType() {
+  return mlir::FunctionType::get(getContext(), getOperandTypes(),
+                                 getResultTypes());
+}
+
 static void printCallOp(mlir::OpAsmPrinter &p, fir::CallOp &op) {
   auto callee = op.callee();
   bool isDirect = callee.hasValue();
   p << op.getOperationName() << ' ';
   if (isDirect)
     p << callee.getValue();
   else
     p << op.getOperand(0);
if (!funcType)
     return parser.emitError(parser.getNameLoc(), "expected function type");
   if (isDirect) {
     if (parser.resolveOperands(operands, funcType.getInputs(),
                                parser.getNameLoc(), result.operands))
       return mlir::failure();
   } else {
     auto funcArgs =
         llvm::ArrayRef<mlir::OpAsmParser::OperandType>(operands).drop_front();
-    llvm::SmallVector<mlir::Value, 8> resultArgs(
-        result.operands.begin() + (result.operands.empty() ? 0 : 1),
-        result.operands.end());
     if (parser.resolveOperand(operands[0], funcType, result.operands) ||
         parser.resolveOperands(funcArgs, funcType.getInputs(),
-                               parser.getNameLoc(), resultArgs))
+                               parser.getNameLoc(), result.operands))
       return mlir::failure();
   }
   result.addTypes(funcType.getResults());
   result.attributes = attrs;
   return mlir::success();
 }
 
 //===----------------------------------------------------------------------===//
mlir::ParseResult fir::parseCmpcOp(mlir::OpAsmParser &parser,
                                    mlir::OperationState &result) {
   return parseCmpOp<fir::CmpcOp>(parser, result);
 }
 
 //===----------------------------------------------------------------------===//
 // ConvertOp
 //===----------------------------------------------------------------------===//
 
+void fir::ConvertOp::getCanonicalizationPatterns(
+    OwningRewritePatternList &results, MLIRContext *context) {
+}
+
 mlir::OpFoldResult fir::ConvertOp::fold(llvm::ArrayRef<mlir::Attribute> opnds) {
   if (value().getType() == getType())
     return value();
   if (matchPattern(value(), m_Op<fir::ConvertOp>())) {
     auto inner = cast<fir::ConvertOp>(value().getDefiningOp());
     // (convert (convert 'a : logical -> i1) : i1 -> logical) ==> forward 'a
     if (auto toTy = getType().dyn_cast<fir::LogicalType>())
       if (auto fromTy = inner.value().getType().dyn_cast<fir::LogicalType>())
         if (inner.getType().isa<mlir::IntegerType>() && (toTy == fromTy))
           return inner.value();
     // (convert (convert 'a : i1 -> logical) : logical -> i1) ==> forward 'a
     if (auto toTy = getType().dyn_cast<mlir::IntegerType>())
       if (auto fromTy = inner.value().getType().dyn_cast<mlir::IntegerType>())
         if (inner.getType().isa<fir::LogicalType>() && (toTy == fromTy) &&
             (fromTy.getWidth() == 1))
           return inner.value();
   }
   return {};
 }
 
 bool fir::ConvertOp::isIntegerCompatible(mlir::Type ty) {
   return ty.isa<mlir::IntegerType>() || ty.isa<mlir::IndexType>() ||
-         ty.isa<fir::IntType>() || ty.isa<fir::LogicalType>() ||
+         ty.isa<fir::IntegerType>() || ty.isa<fir::LogicalType>() ||
          ty.isa<fir::CharacterType>();
 }
 
 bool fir::ConvertOp::isFloatCompatible(mlir::Type ty) {
   return ty.isa<mlir::FloatType>() || ty.isa<fir::RealType>();
 }
 
 bool fir::ConvertOp::isPointerCompatible(mlir::Type ty) {
   return ty.isa<fir::ReferenceType>() || ty.isa<fir::PointerType>() ||
          ty.isa<fir::HeapType>() || ty.isa<mlir::MemRefType>() ||
-         ty.isa<fir::TypeDescType>();
+         ty.isa<mlir::FunctionType>() || ty.isa<fir::TypeDescType>();
 }
 
 //===----------------------------------------------------------------------===//
 // CoordinateOp
 //===----------------------------------------------------------------------===//
 
 static mlir::ParseResult parseCoordinateOp(mlir::OpAsmParser &parser,
                                            mlir::OperationState &result) {
-  llvm::ArrayRef<mlir::Type> allOperandTypes;
-  llvm::ArrayRef<mlir::Type> allResultTypes;
-  llvm::SMLoc allOperandLoc = parser.getCurrentLocation();
+  auto loc = parser.getCurrentLocation();
   llvm::SmallVector<mlir::OpAsmParser::OperandType, 4> allOperands;
-  if (parser.parseOperandList(allOperands))
-    return failure();
-  if (parser.parseOptionalAttrDict(result.attributes))
-    return failure();
-  if (parser.parseColon())
-    return failure();
-
   mlir::FunctionType funcTy;
-  if (parser.parseType(funcTy))
-    return failure();
-  allOperandTypes = funcTy.getInputs();
-  allResultTypes = funcTy.getResults();
-  result.addTypes(allResultTypes);
-  if (parser.resolveOperands(allOperands, allOperandTypes, allOperandLoc,
+  if (parser.parseOperandList(allOperands) ||
+      parser.parseOptionalAttrDict(result.attributes) ||
+      parser.parseColonType(funcTy) ||
+      parser.resolveOperands(allOperands, funcTy.getInputs(), loc,
                              result.operands))
     return failure();
-  if (funcTy.getNumInputs()) {
-    // No inputs handled by verify
+  parser.addTypesToList(funcTy.getResults(), result.types);
+  if (funcTy.getNumInputs())
     result.addAttribute(fir::CoordinateOp::baseType(),
                         mlir::TypeAttr::get(funcTy.getInput(0)));
-  }
   return success();
 }
 
 mlir::Type fir::CoordinateOp::getBaseType() {
   return (*this)
       ->getAttr(CoordinateOp::baseType())
       .cast<mlir::TypeAttr>()
       .getValue();

 void fir::CoordinateOp::build(OpBuilder &builder, OperationState &result,
                               mlir::Type resType, mlir::Value ref,
                               ValueRange coor, ArrayRef<NamedAttribute> attrs) {
   llvm::SmallVector<mlir::Value, 16> operands{ref};
   operands.append(coor.begin(), coor.end());
   build(builder, result, resType, operands, attrs);
 }
 
+static mlir::LogicalResult verify(fir::CoordinateOp op) {
+  auto refTy = op.ref().getType();
+  if (fir::isa_ref_type(refTy)) {
+    auto eleTy = fir::dyn_cast_ptrEleTy(refTy);
+    if (auto arrTy = eleTy.dyn_cast<fir::SequenceType>()) {
+      if (arrTy.hasUnknownShape())
+        return op.emitOpError("cannot find coordinate in unknown shape");
+      if (arrTy.getConstantRows() < arrTy.getDimension() - 1)
+        return op.emitOpError("cannot find coordinate with unknown extents");
+    }
+    if (!(fir::isa_aggregate(eleTy) || fir::isa_complex(eleTy) ||
+          fir::isa_char_string(eleTy)))
+      return op.emitOpError("cannot apply coordinate_of to this type");
+  }
+  // Recovering a LEN type parameter only makes sense from a boxed value
+  for (auto co : op.coor())
+    if (dyn_cast_or_null<fir::LenParamIndexOp>(co.getDefiningOp())) {
+      if (op.getNumOperands() != 2)
+        return op.emitOpError("len_param_index must be last argument");
+      if (!op.ref().getType().isa<BoxType>())
+        return op.emitOpError("len_param_index must be used on box type");
+    }
+  if (auto attr = op->getAttr(CoordinateOp::baseType())) {
+    if (!attr.isa<mlir::TypeAttr>())
+      return op.emitOpError("improperly constructed");
+  } else {
+    return op.emitOpError("must have base type");
+  }
+  return mlir::success();
+}
+
 //===----------------------------------------------------------------------===//
 // DispatchOp
 //===----------------------------------------------------------------------===//
 
 mlir::FunctionType fir::DispatchOp::getFunctionType() {
-  auto attr = (*this)->getAttr("fn_type").cast<mlir::TypeAttr>();
-  return attr.getValue().cast<mlir::FunctionType>();
+  return mlir::FunctionType::get(getContext(), getOperandTypes(),
+                                 getResultTypes());
 }
 
 //===----------------------------------------------------------------------===//
 // DispatchTableOp
 //===----------------------------------------------------------------------===//
 
 void fir::DispatchTableOp::appendTableEntry(mlir::Operation *op) {
   assert(mlir::isa<fir::DTEntryOp>(*op) && "operation must be a DTEntryOp");
   auto &block = getBlock();
   block.getOperations().insert(block.end(), op);
 }
 
 //===----------------------------------------------------------------------===//
 // EmboxOp
 //===----------------------------------------------------------------------===//
 
-static mlir::ParseResult parseEmboxOp(mlir::OpAsmParser &parser,
-                                      mlir::OperationState &result) {
-  mlir::FunctionType type;
-  llvm::SmallVector<mlir::OpAsmParser::OperandType, 8> operands;
-  mlir::OpAsmParser::OperandType memref;
-  if (parser.parseOperand(memref))
-    return mlir::failure();
-  operands.push_back(memref);
-  auto &builder = parser.getBuilder();
-  if (!parser.parseOptionalLParen()) {
-    if (parser.parseOperandList(operands, mlir::OpAsmParser::Delimiter::None) ||
-        parser.parseRParen())
-      return mlir::failure();
-    auto lens = builder.getI32IntegerAttr(operands.size());
-    result.addAttribute(fir::EmboxOp::lenpName(), lens);
+static mlir::LogicalResult verify(fir::EmboxOp op) {
+  auto eleTy = fir::dyn_cast_ptrEleTy(op.memref().getType());
+  if (!eleTy)
+    return op.emitOpError("must embox a memory reference type");
+  bool isArray = false;
+  if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>()) {
+    eleTy = seqTy.getEleTy();
+    isArray = true;
+  }
+  if (op.hasLenParams()) {
+    auto lenPs = op.numLenParams();
+    if (auto rt = eleTy.dyn_cast<fir::RecordType>()) {
+      if (lenPs != rt.getNumLenParams())
+        return op.emitOpError("number of LEN params does not correspond"
+                              " to the !fir.type type");
+    } else if (auto strTy = eleTy.dyn_cast<fir::CharacterType>()) {
+      if (strTy.getLen() != fir::CharacterType::unknownLen())
+        return op.emitOpError("CHARACTER already has static LEN");
+    } else {
+      return op.emitOpError("LEN parameters require CHARACTER or derived type");
     }
-  if (!parser.parseOptionalComma()) {
-    mlir::OpAsmParser::OperandType dims;
-    if (parser.parseOperand(dims))
-      return mlir::failure();
-    operands.push_back(dims);
-  } else if (!parser.parseOptionalLSquare()) {
-    mlir::AffineMapAttr map;
-    if (parser.parseAttribute(map, fir::EmboxOp::layoutName(),
-                              result.attributes) ||
-        parser.parseRSquare())
-      return mlir::failure();
+    for (auto lp : op.lenParams())
+      if (!fir::isa_integer(lp.getType()))
+        return op.emitOpError("LEN parameters must be integral type");
+  }
+  if (op.getShape()) {
+    auto shapeTy = op.getShape().getType();
+    if (!(shapeTy.isa<fir::ShapeType>() || shapeTy.isa<ShapeShiftType>()))
+      return op.emitOpError("must be shape or shapeshift type");
+    if (!isArray)
+      return op.emitOpError("shape must not be provided for a scalar");
+  }
+  if (op.getSlice()) {
+    auto sliceTy = op.getSlice().getType();
+    if (!sliceTy.isa<fir::SliceType>())
+      return op.emitOpError("must be a slice type");
+    if (!isArray)
+      return op.emitOpError("slice must not be provided for a scalar");
   }
-  if (parser.parseOptionalAttrDict(result.attributes) ||
-      parser.parseColonType(type) ||
-      parser.resolveOperands(operands, type.getInputs(), parser.getNameLoc(),
-                             result.operands) ||
-      parser.addTypesToList(type.getResults(), result.types))
-    return mlir::failure();
   return mlir::success();
 }
 
 //===----------------------------------------------------------------------===//
 // GenTypeDescOp
 //===----------------------------------------------------------------------===//
 
 void fir::GenTypeDescOp::build(OpBuilder &, OperationState &result,
                                mlir::TypeAttr inty) {
   result.addAttribute("in_type", inty);
   result.addTypes(TypeDescType::get(inty.getValue()));
 }
 
 //===----------------------------------------------------------------------===//
 // GlobalOp
 //===----------------------------------------------------------------------===//
 
 static ParseResult parseGlobalOp(OpAsmParser &parser, OperationState &result) {
   // Parse the optional linkage
   llvm::StringRef linkage;
   auto &builder = parser.getBuilder();
   if (mlir::succeeded(parser.parseOptionalKeyword(&linkage))) {
     if (fir::GlobalOp::verifyValidLinkage(linkage))
-      return failure();
+      return mlir::failure();
     mlir::StringAttr linkAttr = builder.getStringAttr(linkage);
     result.addAttribute(fir::GlobalOp::linkageAttrName(), linkAttr);
   }
 
   // Parse the name as a symbol reference attribute.
   mlir::SymbolRefAttr nameAttr;
   if (parser.parseAttribute(nameAttr, fir::GlobalOp::symbolAttrName(),
                             result.attributes))
-    return failure();
+    return mlir::failure();
   result.addAttribute(mlir::SymbolTable::getSymbolAttrName(),
                       builder.getStringAttr(nameAttr.getRootReference()));
 
   bool simpleInitializer = false;
   if (mlir::succeeded(parser.parseOptionalLParen())) {
     Attribute attr;
     if (parser.parseAttribute(attr, fir::GlobalOp::initValAttrName(),
                               result.attributes) ||
         parser.parseRParen())
-      return failure();
+      return mlir::failure();
     simpleInitializer = true;
   }
 
   if (succeeded(parser.parseOptionalKeyword("constant"))) {
     // if "constant" keyword then mark this as a constant, not a variable
     result.addAttribute(fir::GlobalOp::constantAttrName(),
                         builder.getUnitAttr());
   }
 
   mlir::Type globalType;
   if (parser.parseColonType(globalType))
-    return failure();
+    return mlir::failure();
 
   result.addAttribute(fir::GlobalOp::typeAttrName(),
                       mlir::TypeAttr::get(globalType));
 
   if (simpleInitializer) {
     result.addRegion();
   } else {
     // Parse the optional initializer body.
-    if (parser.parseRegion(*result.addRegion(), llvm::None, llvm::None))
-      return failure();
+    auto parseResult = parser.parseOptionalRegion(
+        *result.addRegion(), /*arguments=*/llvm::None, /*argTypes=*/llvm::None);
+    if (parseResult.hasValue() && mlir::failed(*parseResult))
+      return mlir::failure();
   }
 
-  return success();
+  return mlir::success();
 }
 
 void fir::GlobalOp::appendInitialValue(mlir::Operation *op) {
   getBlock().getOperations().push_back(op);
 }
 
 void fir::GlobalOp::build(mlir::OpBuilder &builder, OperationState &result,
                           StringRef name, bool isConstant, Type type,

 void fir::GlobalOp::build(mlir::OpBuilder &builder, OperationState &result,
                           StringRef name, Type type,
                           ArrayRef<NamedAttribute> attrs) {
   build(builder, result, name, /*isConstant=*/false, type, attrs);
 }
 
 mlir::ParseResult fir::GlobalOp::verifyValidLinkage(StringRef linkage) {
   // Supporting only a subset of the LLVM linkage types for now
-  static const llvm::SmallVector<const char *, 3> validNames = {
-      "internal", "common", "weak"};
+  static const char *validNames[] = {"common", "internal", "linkonce", "weak"};
   return mlir::success(llvm::is_contained(validNames, linkage));
 }
 
 //===----------------------------------------------------------------------===//
+// InsertValueOp
+//===----------------------------------------------------------------------===//
+
+static bool checkIsIntegerConstant(mlir::Value v, int64_t conVal) {
+  if (auto c = dyn_cast_or_null<mlir::ConstantOp>(v.getDefiningOp())) {
+    auto attr = c.getValue();
+    if (auto iattr = attr.dyn_cast<mlir::IntegerAttr>())
+      return iattr.getInt() == conVal;
+  }
+  return false;
+}
+static bool isZero(mlir::Value v) { return checkIsIntegerConstant(v, 0); }
+static bool isOne(mlir::Value v) { return checkIsIntegerConstant(v, 1); }
+
+// Undo some complex patterns created in the front-end and turn them back into
+// complex ops.
+template <typename FltOp, typename CpxOp>
+struct UndoComplexPattern : public mlir::RewritePattern {
+  UndoComplexPattern(mlir::MLIRContext *ctx)
+      : mlir::RewritePattern("fir.insert_value", {}, 2, ctx) {}
+
+  mlir::LogicalResult
+  matchAndRewrite(mlir::Operation *op,
+                  mlir::PatternRewriter &rewriter) const override {
+    auto insval = dyn_cast_or_null<fir::InsertValueOp>(op);
+    if (!insval || !insval.getType().isa<fir::ComplexType>())
+      return mlir::failure();
+    auto insval2 =
+        dyn_cast_or_null<fir::InsertValueOp>(insval.adt().getDefiningOp());
+    if (!insval2 || !isa<fir::UndefOp>(insval2.adt().getDefiningOp()))
+      return mlir::failure();
+    auto binf = dyn_cast_or_null<FltOp>(insval.val().getDefiningOp());
+    auto binf2 = dyn_cast_or_null<FltOp>(insval2.val().getDefiningOp());
+    if (!binf || !binf2 || insval.coor().size() != 1 ||
+        !isOne(insval.coor()[0]) || insval2.coor().size() != 1 ||
+        !isZero(insval2.coor()[0]))
+      return mlir::failure();
+    auto eai =
+        dyn_cast_or_null<fir::ExtractValueOp>(binf.lhs().getDefiningOp());
+    auto ebi =
+        dyn_cast_or_null<fir::ExtractValueOp>(binf.rhs().getDefiningOp());
+    auto ear =
+        dyn_cast_or_null<fir::ExtractValueOp>(binf2.lhs().getDefiningOp());
+    auto ebr =
+        dyn_cast_or_null<fir::ExtractValueOp>(binf2.rhs().getDefiningOp());
+    if (!eai || !ebi || !ear || !ebr || ear.adt() != eai.adt() ||
+        ebr.adt() != ebi.adt() || eai.coor().size() != 1 ||
+        !isOne(eai.coor()[0]) || ebi.coor().size() != 1 ||
+        !isOne(ebi.coor()[0]) || ear.coor().size() != 1 ||
+        !isZero(ear.coor()[0]) || ebr.coor().size() != 1 ||
+        !isZero(ebr.coor()[0]))
+      return mlir::failure();
+    rewriter.replaceOpWithNewOp<CpxOp>(op, ear.adt(), ebr.adt());
+    return mlir::success();
+  }
+};
+
+void fir::InsertValueOp::getCanonicalizationPatterns(
+    mlir::OwningRewritePatternList &results, mlir::MLIRContext *context) {
+  results.insert<UndoComplexPattern<fir::AddfOp, fir::AddcOp>,
+                 UndoComplexPattern<fir::SubfOp, fir::SubcOp>>(context);
+}
+
+//===----------------------------------------------------------------------===//
 // IterWhileOp
 //===----------------------------------------------------------------------===//
 
 void fir::IterWhileOp::build(mlir::OpBuilder &builder,
                              mlir::OperationState &result, mlir::Value lb,
                              mlir::Value ub, mlir::Value step,
-                             mlir::Value iterate, mlir::ValueRange iterArgs,
+                             mlir::Value iterate, bool finalCountValue,
+                             mlir::ValueRange iterArgs,
                              llvm::ArrayRef<mlir::NamedAttribute> attributes) {
   result.addOperands({lb, ub, step, iterate});
+  if (finalCountValue) {
+    result.addTypes(builder.getIndexType());
+    result.addAttribute(finalValueAttrName(), builder.getUnitAttr());
+  }
   result.addTypes(iterate.getType());
   result.addOperands(iterArgs);
   for (auto v : iterArgs)
     result.addTypes(v.getType());
   mlir::Region *bodyRegion = result.addRegion();
   bodyRegion->push_back(new Block{});
   bodyRegion->front().addArgument(builder.getIndexType());
   bodyRegion->front().addArgument(iterate.getType());
static mlir::ParseResult parseIterWhileOp(mlir::OpAsmParser &parser,
   if (parser.parseKeyword("and") || parser.parseLParen() ||
       parser.parseRegionArgument(iterateVar) || parser.parseEqual() ||
       parser.parseOperand(iterateInput) || parser.parseRParen() ||
       parser.resolveOperand(iterateInput, i1Type, result.operands))
     return mlir::failure();
 
   // Parse the initial iteration arguments.
   llvm::SmallVector<mlir::OpAsmParser::OperandType, 4> regionArgs;
+  auto prependCount = false;
+
   // Induction variable.
   regionArgs.push_back(inductionVariable);
   regionArgs.push_back(iterateVar);
-  result.addTypes(i1Type);
 
-  if (mlir::succeeded(parser.parseOptionalKeyword("iter_args"))) {
+  if (succeeded(parser.parseOptionalKeyword("iter_args"))) {
     llvm::SmallVector<mlir::OpAsmParser::OperandType, 4> operands;
     llvm::SmallVector<mlir::Type, 4> regionTypes;
     // Parse assignment list and results type list.
     if (parser.parseAssignmentList(regionArgs, operands) ||
         parser.parseArrowTypeList(regionTypes))
-      return mlir::failure();
+      return failure();
+    if (regionTypes.size() == operands.size() + 2)
+      prependCount = true;
+    llvm::ArrayRef<mlir::Type> resTypes = regionTypes;
+    resTypes = prependCount ? resTypes.drop_front(2) : resTypes;
     // Resolve input operands.
-    for (auto operand_type : llvm::zip(operands, regionTypes))
+    for (auto operand_type : llvm::zip(operands, resTypes))
       if (parser.resolveOperand(std::get<0>(operand_type),
                                 std::get<1>(operand_type), result.operands))
-        return mlir::failure();
+        return failure();
+    if (prependCount) {
+      // This is an assert here, because these types are verified.
+      assert(regionTypes[0].isa<mlir::IndexType>() &&
+             regionTypes[1].isSignlessInteger(1));
       result.addTypes(regionTypes);
+    } else {
+      result.addTypes(i1Type);
+      result.addTypes(resTypes);
+    }
+  } else if (succeeded(parser.parseOptionalArrow())) {
+    llvm::SmallVector<mlir::Type, 4> typeList;
+    if (parser.parseLParen() || parser.parseTypeList(typeList) ||
+        parser.parseRParen())
+      return failure();
+    // Type list must be "(index, i1)".
+    if (typeList.size() != 2 || !typeList[0].isa<mlir::IndexType>() ||
+        !typeList[1].isSignlessInteger(1))
+      return failure();
+    result.addTypes(typeList);
+    prependCount = true;
+  } else {
+    result.addTypes(i1Type);
   }
 
   if (parser.parseOptionalAttrDictWithKeyword(result.attributes))
     return mlir::failure();
 
   llvm::SmallVector<mlir::Type, 4> argTypes;
   // Induction variable (hidden)
+  if (prependCount)
+    result.addAttribute(IterWhileOp::finalValueAttrName(),
+                        builder.getUnitAttr());
+  else
     argTypes.push_back(indexType);
   // Loop carried variables (including iterate)
   argTypes.append(result.types.begin(), result.types.end());
   // Parse the body region.
   auto *body = result.addRegion();
   if (regionArgs.size() != argTypes.size())
     return parser.emitError(
         parser.getNameLoc(),
         "mismatch in number of loop-carried values and defined values");
 
   if (parser.parseRegion(*body, regionArgs, argTypes))
     return failure();
 
   fir::IterWhileOp::ensureTerminator(*body, builder, result.location);
 
   return mlir::success();
 }
 
 static mlir::LogicalResult verify(fir::IterWhileOp op) {
-  if (auto cst = dyn_cast_or_null<ConstantIndexOp>(op.step().getDefiningOp()))
-    if (cst.getValue() <= 0)
-      return op.emitOpError("constant step operand must be positive");
-
   // Check that the body defines as single block argument for the induction
   // variable.
   auto *body = op.getBody();
   if (!body->getArgument(1).getType().isInteger(1))
     return op.emitOpError(
         "expected body second argument to be an index argument for "
         "the induction variable");
   if (!body->getArgument(0).getType().isIndex())
     return op.emitOpError(
         "expected body first argument to be an index argument for "
         "the induction variable");
 
   auto opNumResults = op.getNumResults();
+  if (op.finalValue()) {
+    // Result type must be "(index, i1, ...)".
+    if (!op.getResult(0).getType().isa<mlir::IndexType>())
+      return op.emitOpError("result #0 expected to be index");
+    if (!op.getResult(1).getType().isSignlessInteger(1))
+      return op.emitOpError("result #1 expected to be i1");
+    opNumResults--;
+  } else {
+    // iterate_while always returns the early exit induction value.
+    // Result type must be "(i1, ...)"
+    if (!op.getResult(0).getType().isSignlessInteger(1))
+      return op.emitOpError("result #0 expected to be i1");
+  }
   if (opNumResults == 0)
     return mlir::failure();
   if (op.getNumIterOperands() != opNumResults)
     return op.emitOpError(
         "mismatch in number of loop-carried values and defined values");
   if (op.getNumRegionIterArgs() != opNumResults)
     return op.emitOpError(
         "mismatch in number of basic block args and defined values");
   auto iterOperands = op.getIterOperands();
   auto iterArgs = op.getRegionIterArgs();
-  auto opResults = op.getResults();
+  auto opResults =
+      op.finalValue() ? op.getResults().drop_front() : op.getResults();
   unsigned i = 0;
   for (auto e : llvm::zip(iterOperands, iterArgs, opResults)) {
     if (std::get<0>(e).getType() != std::get<2>(e).getType())
       return op.emitOpError() << "types mismatch between " << i
                               << "th iter operand and defined value";
     if (std::get<1>(e).getType() != std::get<2>(e).getType())
       return op.emitOpError() << "types mismatch between " << i
                               << "th iter region arg and defined value";
static void print(mlir::OpAsmPrinter &p, fir::IterWhileOp op) {
   auto regionArgs = op.getRegionIterArgs();
   auto operands = op.getIterOperands();
   p << regionArgs.front() << " = " << *operands.begin() << ")";
   if (regionArgs.size() > 1) {
     p << " iter_args(";
     llvm::interleaveComma(
         llvm::zip(regionArgs.drop_front(), operands.drop_front()), p,
         [&](auto it) { p << std::get<0>(it) << " = " << std::get<1>(it); });
-    p << ") -> (" << op.getResultTypes().drop_front() << ')';
+    auto resTypes = op.finalValue() ? op.getResultTypes()
+                                    : op.getResultTypes().drop_front();
+    p << ") -> (" << resTypes << ')';
+  } else if (op.finalValue()) {
+    p << " -> (" << op.getResultTypes() << ')';
   }
-  p.printOptionalAttrDictWithKeyword(op->getAttrs(), {});
+  p.printOptionalAttrDictWithKeyword(op->getAttrs(),
+                                     {IterWhileOp::finalValueAttrName()});
   p.printRegion(op.region(), /*printEntryBlockArgs=*/false,
                 /*printBlockTerminators=*/true);
 }
 
 mlir::Region &fir::IterWhileOp::getLoopBody() { return region(); }
 
 bool fir::IterWhileOp::isDefinedOutsideOfLoop(mlir::Value value) {
   return !region().isAncestor(value.getParentRegion());
 }
 
 mlir::LogicalResult
 fir::IterWhileOp::moveOutOfLoop(llvm::ArrayRef<mlir::Operation *> ops) {
   for (auto op : ops)
     op->moveBefore(*this);
   return success();
 }
 
+mlir::BlockArgument fir::IterWhileOp::iterArgToBlockArg(mlir::Value iterArg) {
+  for (auto i : llvm::enumerate(initArgs()))
+    if (iterArg == i.value())
+      return region().front().getArgument(i.index() + 1);
+  return {};
+}
+
+void fir::IterWhileOp::resultToSourceOps(
+    llvm::SmallVectorImpl<mlir::Value> &results, unsigned resultNum) {
+  auto oper = finalValue() ? resultNum : resultNum + 1;
+  auto *term = region().front().getTerminator();
+  if (oper < term->getNumOperands())
+    results.push_back(term->getOperand(oper));
+}
+
+mlir::Value fir::IterWhileOp::blockArgToSourceOp(unsigned blockArgNum) {
+  if (blockArgNum > 0 && blockArgNum <= initArgs().size())
+    return initArgs()[blockArgNum - 1];
+  return {};
+}
+
 //===----------------------------------------------------------------------===//
 // LoadOp
 //===----------------------------------------------------------------------===//
 
 /// Get the element type of a reference like type; otherwise null
 static mlir::Type elementTypeOf(mlir::Type ref) {
   return llvm::TypeSwitch<mlir::Type, mlir::Type>(ref)
       .Case<ReferenceType, PointerType, HeapType>(
           [](auto type) { return type.getEleTy(); })
       .Default([](mlir::Type) { return mlir::Type{}; });
 }
 
 mlir::ParseResult fir::LoadOp::getElementOf(mlir::Type &ele, mlir::Type ref) {
   if ((ele = elementTypeOf(ref)))
     return mlir::success();
   return mlir::failure();
 }
 
 //===----------------------------------------------------------------------===//
-// LoopOp
+// DoLoopOp
 //===----------------------------------------------------------------------===//
 
-void fir::LoopOp::build(mlir::OpBuilder &builder, mlir::OperationState &result,
-                        mlir::Value lb, mlir::Value ub, mlir::Value step,
-                        bool unordered, mlir::ValueRange iterArgs,
+void fir::DoLoopOp::build(mlir::OpBuilder &builder,
+                          mlir::OperationState &result, mlir::Value lb,
+                          mlir::Value ub, mlir::Value step, bool unordered,
+                          bool finalCountValue, mlir::ValueRange iterArgs,
                           llvm::ArrayRef<mlir::NamedAttribute> attributes) {
   result.addOperands({lb, ub, step});
   result.addOperands(iterArgs);
+  if (finalCountValue) {
+    result.addTypes(builder.getIndexType());
+    result.addAttribute(finalValueAttrName(), builder.getUnitAttr());
+  }
   for (auto v : iterArgs)
     result.addTypes(v.getType());
   mlir::Region *bodyRegion = result.addRegion();
   bodyRegion->push_back(new Block{});
-  if (iterArgs.empty())
-    LoopOp::ensureTerminator(*bodyRegion, builder, result.location);
+  if (iterArgs.empty() && !finalCountValue)
+    DoLoopOp::ensureTerminator(*bodyRegion, builder, result.location);
   bodyRegion->front().addArgument(builder.getIndexType());
   bodyRegion->front().addArguments(iterArgs.getTypes());
   if (unordered)
     result.addAttribute(unorderedAttrName(), builder.getUnitAttr());
   result.addAttributes(attributes);
 }
 
-static mlir::ParseResult parseLoopOp(mlir::OpAsmParser &parser,
+static mlir::ParseResult parseDoLoopOp(mlir::OpAsmParser &parser,
                                        mlir::OperationState &result) {
   auto &builder = parser.getBuilder();
   mlir::OpAsmParser::OperandType inductionVariable, lb, ub, step;
   // Parse the induction variable followed by '='.
   if (parser.parseRegionArgument(inductionVariable) || parser.parseEqual())
     return mlir::failure();
 
   // Parse loop bounds.
   auto indexType = builder.getIndexType();
   if (parser.parseOperand(lb) ||
       parser.resolveOperand(lb, indexType, result.operands) ||
       parser.parseKeyword("to") || parser.parseOperand(ub) ||
       parser.resolveOperand(ub, indexType, result.operands) ||
       parser.parseKeyword("step") || parser.parseOperand(step) ||
       parser.resolveOperand(step, indexType, result.operands))
     return failure();
 
   if (mlir::succeeded(parser.parseOptionalKeyword("unordered")))
-    result.addAttribute(fir::LoopOp::unorderedAttrName(),
+    result.addAttribute(fir::DoLoopOp::unorderedAttrName(),
                         builder.getUnitAttr());
 
   // Parse the optional initial iteration arguments.
   llvm::SmallVector<mlir::OpAsmParser::OperandType, 4> regionArgs, operands;
   llvm::SmallVector<mlir::Type, 4> argTypes;
+  auto prependCount = false;
   regionArgs.push_back(inductionVariable);
 
   if (succeeded(parser.parseOptionalKeyword("iter_args"))) {
     // Parse assignment list and results type list.
     if (parser.parseAssignmentList(regionArgs, operands) ||
         parser.parseArrowTypeList(result.types))
       return failure();
+    if (result.types.size() == operands.size() + 1)
+      prependCount = true;
     // Resolve input operands.
-    for (auto operand_type : llvm::zip(operands, result.types))
+    llvm::ArrayRef<mlir::Type> resTypes = result.types;
+    for (auto operand_type :
+         llvm::zip(operands, prependCount ? resTypes.drop_front() : resTypes))
       if (parser.resolveOperand(std::get<0>(operand_type),
                                 std::get<1>(operand_type), result.operands))
         return failure();
+  } else if (succeeded(parser.parseOptionalArrow())) {
+    if (parser.parseKeyword("index"))
+      return failure();
+    result.types.push_back(indexType);
+    prependCount = true;
   }
 
   if (parser.parseOptionalAttrDictWithKeyword(result.attributes))
     return mlir::failure();
 
   // Induction variable.
+  if (prependCount)
+    result.addAttribute(DoLoopOp::finalValueAttrName(), builder.getUnitAttr());
+  else
     argTypes.push_back(indexType);
   // Loop carried variables
   argTypes.append(result.types.begin(), result.types.end());
   // Parse the body region.
   auto *body = result.addRegion();
   if (regionArgs.size() != argTypes.size())
     return parser.emitError(
         parser.getNameLoc(),
         "mismatch in number of loop-carried values and defined values");
 
   if (parser.parseRegion(*body, regionArgs, argTypes))
     return failure();
 
-  fir::LoopOp::ensureTerminator(*body, builder, result.location);
+  DoLoopOp::ensureTerminator(*body, builder, result.location);
 
   return mlir::success();
 }
 
-fir::LoopOp fir::getForInductionVarOwner(mlir::Value val) {
+fir::DoLoopOp fir::getForInductionVarOwner(mlir::Value val) {
   auto ivArg = val.dyn_cast<mlir::BlockArgument>();
   if (!ivArg)
     return {};
   assert(ivArg.getOwner() && "unlinked block argument");
   auto *containingInst = ivArg.getOwner()->getParentOp();
-  return dyn_cast_or_null<fir::LoopOp>(containingInst);
+  return dyn_cast_or_null<fir::DoLoopOp>(containingInst);
 }
 
 // Lifted from loop.loop
-static mlir::LogicalResult verify(fir::LoopOp op) {
-  if (auto cst = dyn_cast_or_null<ConstantIndexOp>(op.step().getDefiningOp()))
-    if (cst.getValue() <= 0)
-      return op.emitOpError("constant step operand must be positive");
-
+static mlir::LogicalResult verify(fir::DoLoopOp op) {
   // Check that the body defines as single block argument for the induction
   // variable.
   auto *body = op.getBody();
   if (!body->getArgument(0).getType().isIndex())
     return op.emitOpError(
         "expected body first argument to be an index argument for "
         "the induction variable");
 
   auto opNumResults = op.getNumResults();
   if (opNumResults == 0)
     return success();
+
+  if (op.finalValue()) {
+    if (op.unordered())
+      return op.emitOpError("unordered loop has no final value");
+    opNumResults--;
+  }
   if (op.getNumIterOperands() != opNumResults)
     return op.emitOpError(
         "mismatch in number of loop-carried values and defined values");
   if (op.getNumRegionIterArgs() != opNumResults)
     return op.emitOpError(
         "mismatch in number of basic block args and defined values");
   auto iterOperands = op.getIterOperands();
   auto iterArgs = op.getRegionIterArgs();
-  auto opResults = op.getResults();
+  auto opResults =
+      op.finalValue() ? op.getResults().drop_front() : op.getResults();
   unsigned i = 0;
   for (auto e : llvm::zip(iterOperands, iterArgs, opResults)) {
     if (std::get<0>(e).getType() != std::get<2>(e).getType())
       return op.emitOpError() << "types mismatch between " << i
                               << "th iter operand and defined value";
     if (std::get<1>(e).getType() != std::get<2>(e).getType())
       return op.emitOpError() << "types mismatch between " << i
                               << "th iter region arg and defined value";
 
     i++;
   }
   return success();
 }
 
-static void print(mlir::OpAsmPrinter &p, fir::LoopOp op) {
+static void print(mlir::OpAsmPrinter &p, fir::DoLoopOp op) {
   bool printBlockTerminators = false;
-  p << fir::LoopOp::getOperationName() << ' ' << op.getInductionVar() << " = "
+  p << fir::DoLoopOp::getOperationName() << ' ' << op.getInductionVar() << " = "
     << op.lowerBound() << " to " << op.upperBound() << " step " << op.step();
   if (op.unordered())
     p << " unordered";
   if (op.hasIterOperands()) {
     p << " iter_args(";
     auto regionArgs = op.getRegionIterArgs();
     auto operands = op.getIterOperands();
     llvm::interleaveComma(llvm::zip(regionArgs, operands), p, [&](auto it) {
       p << std::get<0>(it) << " = " << std::get<1>(it);
     });
     p << ") -> (" << op.getResultTypes() << ')';
     printBlockTerminators = true;
+  } else if (op.finalValue()) {
+    p << " -> " << op.getResultTypes();
+    printBlockTerminators = true;
   }
   p.printOptionalAttrDictWithKeyword(op->getAttrs(),
-                                     {fir::LoopOp::unorderedAttrName()});
+                                     {fir::DoLoopOp::unorderedAttrName(),
+                                      fir::DoLoopOp::finalValueAttrName()});
   p.printRegion(op.region(), /*printEntryBlockArgs=*/false,
                 printBlockTerminators);
 }
 
-mlir::Region &fir::LoopOp::getLoopBody() { return region(); }
+mlir::Region &fir::DoLoopOp::getLoopBody() { return region(); }
 
-bool fir::LoopOp::isDefinedOutsideOfLoop(mlir::Value value) {
+bool fir::DoLoopOp::isDefinedOutsideOfLoop(mlir::Value value) {
   return !region().isAncestor(value.getParentRegion());
 }
 
 mlir::LogicalResult
-fir::LoopOp::moveOutOfLoop(llvm::ArrayRef<mlir::Operation *> ops) {
+fir::DoLoopOp::moveOutOfLoop(llvm::ArrayRef<mlir::Operation *> ops) {
   for (auto op : ops)
     op->moveBefore(*this);
   return success();
 }
 
+/// Translate a value passed as an iter_arg to the corresponding block
+/// argument in the body of the loop.
+mlir::BlockArgument fir::DoLoopOp::iterArgToBlockArg(mlir::Value iterArg) {
+  for (auto i : llvm::enumerate(initArgs()))
+    if (iterArg == i.value())
+      return region().front().getArgument(i.index() + 1);
+  return {};
+}
+
+/// Translate the result vector (by index number) to the corresponding value
+/// to the `fir.result` Op.
+void fir::DoLoopOp::resultToSourceOps(
+    llvm::SmallVectorImpl<mlir::Value> &results, unsigned resultNum) {
+  auto oper = finalValue() ? resultNum : resultNum + 1;
+  auto *term = region().front().getTerminator();
+  if (oper < term->getNumOperands())
+    results.push_back(term->getOperand(oper));
+}
+
+/// Translate the block argument (by index number) to the corresponding value
+/// passed as an iter_arg to the parent DoLoopOp.
+mlir::Value fir::DoLoopOp::blockArgToSourceOp(unsigned blockArgNum) {
+  if (blockArgNum > 0 && blockArgNum <= initArgs().size())
+    return initArgs()[blockArgNum - 1];
+  return {};
+}
+
 //===----------------------------------------------------------------------===//
 // MulfOp
 //===----------------------------------------------------------------------===//
 
 mlir::OpFoldResult fir::MulfOp::fold(llvm::ArrayRef<mlir::Attribute> opnds) {
   return mlir::constFoldBinaryOp<FloatAttr>(
       opnds, [](APFloat a, APFloat b) { return a * b; });
 }

 
 static constexpr llvm::StringRef getTargetOffsetAttr() {
   return "target_operand_offsets";
 }
 
 template <typename A, typename... AdditionalArgs>
 static A getSubOperands(unsigned pos, A allArgs,
                         mlir::DenseIntElementsAttr ranges,
-                        AdditionalArgs &&... additionalArgs) {
+                        AdditionalArgs &&...additionalArgs) {
   unsigned start = 0;
   for (unsigned i = 0; i < pos; ++i)
     start += (*(ranges.begin() + i)).getZExtValue();
   return allArgs.slice(start, (*(ranges.begin() + pos)).getZExtValue(),
                        std::forward<AdditionalArgs>(additionalArgs)...);
 }
 
 static mlir::MutableOperandRange
if (attr.dyn_cast_or_null<mlir::UnitAttr>()) {
       opers.push_back(oper);
       argOffs.push_back(1);
       ++offSize;
     }
     if (parser.parseSuccessorAndUseList(dest, destArg))
       return mlir::failure();
     dests.push_back(dest);
     destArgs.push_back(destArg);
-    if (!parser.parseOptionalRSquare())
+    if (mlir::succeeded(parser.parseOptionalRSquare()))
       break;
     if (parser.parseComma())
       return mlir::failure();
   }
   result.addAttribute(fir::SelectCaseOp::getCasesAttr(),
                       parser.getBuilder().getArrayAttr(attrs));
   if (parser.resolveOperands(opers, type, result.operands))
     return mlir::failure();
while (true) {
     llvm::SmallVector<mlir::Value, 8> destArg;
     mlir::NamedAttrList temp;
     if (parser.parseAttribute(attr, "a", temp) || parser.parseComma() ||
         parser.parseSuccessorAndUseList(dest, destArg))
       return mlir::failure();
     attrs.push_back(attr);
     dests.push_back(dest);
     destArgs.push_back(destArg);
-    if (!parser.parseOptionalRSquare())
+    if (mlir::succeeded(parser.parseOptionalRSquare()))
       break;
     if (parser.parseComma())
       return mlir::failure();
   }
   auto &bld = parser.getBuilder();
   result.addAttribute(fir::SelectTypeOp::getCasesAttr(),
                       bld.getArrayAttr(attrs));
   llvm::SmallVector<int32_t, 8> argOffs;

 //===----------------------------------------------------------------------===//
 
 mlir::OpFoldResult fir::SubfOp::fold(llvm::ArrayRef<mlir::Attribute> opnds) {
   return mlir::constFoldBinaryOp<FloatAttr>(
       opnds, [](APFloat a, APFloat b) { return a - b; });
 }
 
 //===----------------------------------------------------------------------===//
-// WhereOp
+// IfOp
 //===----------------------------------------------------------------------===//
-void fir::WhereOp::build(mlir::OpBuilder &builder, OperationState &result,
-                         mlir::Value cond, bool withElseRegion) {
+
+void fir::IfOp::build(mlir::OpBuilder &builder, OperationState &result,
   build(builder, result, llvm::None, cond, withElseRegion);
 }
 
-void fir::WhereOp::build(mlir::OpBuilder &builder, OperationState &result,
-                         mlir::TypeRange resultTypes, mlir::Value cond,
-                         bool withElseRegion) {
+void fir::IfOp::build(mlir::OpBuilder &builder, OperationState &result,
   result.addOperands(cond);
   result.addTypes(resultTypes);
 
   mlir::Region *thenRegion = result.addRegion();
   thenRegion->push_back(new mlir::Block());
   if (resultTypes.empty())
-    WhereOp::ensureTerminator(*thenRegion, builder, result.location);
+    IfOp::ensureTerminator(*thenRegion, builder, result.location);
 
   mlir::Region *elseRegion = result.addRegion();
   if (withElseRegion) {
     elseRegion->push_back(new mlir::Block());
     if (resultTypes.empty())
-      WhereOp::ensureTerminator(*elseRegion, builder, result.location);
+      IfOp::ensureTerminator(*elseRegion, builder, result.location);
   }
 }
 
-static mlir::ParseResult parseWhereOp(OpAsmParser &parser,
-                                      OperationState &result) {
+static mlir::ParseResult parseIfOp(OpAsmParser &parser,
   result.regions.reserve(2);
   mlir::Region *thenRegion = result.addRegion();
   mlir::Region *elseRegion = result.addRegion();
 
   auto &builder = parser.getBuilder();
   OpAsmParser::OperandType cond;
   mlir::Type i1Type = builder.getIntegerType(1);
   if (parser.parseOperand(cond) ||
       parser.resolveOperand(cond, i1Type, result.operands))
     return mlir::failure();
 
-  if (parser.parseRegion(*thenRegion, {}, {}))
+  if (parser.parseOptionalArrowTypeList(result.types))
     return mlir::failure();
 
-  WhereOp::ensureTerminator(*thenRegion, parser.getBuilder(), result.location);
+  if (parser.parseRegion(*thenRegion, {}, {}))
+    return mlir::failure();
+  IfOp::ensureTerminator(*thenRegion, parser.getBuilder(), result.location);
 
-  if (!parser.parseOptionalKeyword("else")) {
+  if (mlir::succeeded(parser.parseOptionalKeyword("else"))) {
     if (parser.parseRegion(*elseRegion, {}, {}))
       return mlir::failure();
-    WhereOp::ensureTerminator(*elseRegion, parser.getBuilder(),
-                              result.location);
+    IfOp::ensureTerminator(*elseRegion, parser.getBuilder(), result.location);
   }
 
   // Parse the optional attribute list.
   if (parser.parseOptionalAttrDict(result.attributes))
     return mlir::failure();
-
   return mlir::success();
 }
 
-static LogicalResult verify(fir::WhereOp op) {
-  if (op.getNumResults() != 0 && op.otherRegion().empty())
+static LogicalResult verify(fir::IfOp op) {
+  if (op.getNumResults() != 0 && op.elseRegion().empty())
     return op.emitOpError("must have an else block if defining values");
 
   return mlir::success();
 }
 
-static void print(mlir::OpAsmPrinter &p, fir::WhereOp op) {
+static void print(mlir::OpAsmPrinter &p, fir::IfOp op) {
   bool printBlockTerminators = false;
-  p << fir::WhereOp::getOperationName() << ' ' << op.condition();
+  p << fir::IfOp::getOperationName() << ' ' << op.condition();
   if (!op.results().empty()) {
     p << " -> (" << op.getResultTypes() << ')';
     printBlockTerminators = true;
   }
-  p.printRegion(op.whereRegion(), /*printEntryBlockArgs=*/false,
+  p.printRegion(op.thenRegion(), /*printEntryBlockArgs=*/false,
                 printBlockTerminators);
 
   // Print the 'else' regions if it exists and has a block.
-  auto &otherReg = op.otherRegion();
+  auto &otherReg = op.elseRegion();
   if (!otherReg.empty()) {
     p << " else";
     p.printRegion(otherReg, /*printEntryBlockArgs=*/false,
                   printBlockTerminators);
   }
   p.printOptionalAttrDict(op->getAttrs());
 }
 
+void fir::IfOp::resultToSourceOps(llvm::SmallVectorImpl<mlir::Value> &results,
+                                  unsigned resultNum) {
+  auto *term = thenRegion().front().getTerminator();
+  if (resultNum < term->getNumOperands())
+    results.push_back(term->getOperand(resultNum));
+  term = elseRegion().front().getTerminator();
+  if (resultNum < term->getNumOperands())
+    results.push_back(term->getOperand(resultNum));
+}
+
 //===----------------------------------------------------------------------===//
 
 mlir::ParseResult fir::isValidCaseAttr(mlir::Attribute attr) {
   if (attr.dyn_cast_or_null<mlir::UnitAttr>() ||
       attr.dyn_cast_or_null<ClosedIntervalAttr>() ||
       attr.dyn_cast_or_null<PointIntervalAttr>() ||
       attr.dyn_cast_or_null<LowerBoundAttr>() ||
       attr.dyn_cast_or_null<UpperBoundAttr>())

 
 mlir::FuncOp fir::createFuncOp(mlir::Location loc, mlir::ModuleOp module,
                                StringRef name, mlir::FunctionType type,
                                llvm::ArrayRef<mlir::NamedAttribute> attrs) {
   if (auto f = module.lookupSymbol<mlir::FuncOp>(name))
     return f;
   mlir::OpBuilder modBuilder(module.getBodyRegion());
   modBuilder.setInsertionPoint(module.getBody()->getTerminator());
-  return modBuilder.create<mlir::FuncOp>(loc, name, type, attrs);
+  auto result = modBuilder.create<mlir::FuncOp>(loc, name, type, attrs);
+  result.setVisibility(mlir::SymbolTable::Visibility::Private);
+  return result;
 }
 
 fir::GlobalOp fir::createGlobalOp(mlir::Location loc, mlir::ModuleOp module,
                                   StringRef name, mlir::Type type,
                                   llvm::ArrayRef<mlir::NamedAttribute> attrs) {
   if (auto g = module.lookupSymbol<fir::GlobalOp>(name))
     return g;
   mlir::OpBuilder modBuilder(module.getBodyRegion());
-  return modBuilder.create<fir::GlobalOp>(loc, name, type, attrs);
+  auto result = modBuilder.create<fir::GlobalOp>(loc, name, type, attrs);
+  result.setVisibility(mlir::SymbolTable::Visibility::Private);
+  return result;
 }
 
 // Tablegen operators
 
 #define GET_OP_CLASSES
 #include "flang/Optimizer/Dialect/FIROps.cpp.inc"

flang/lib/Optimizer/Dialect/FIRType.cpp

 //===-- FIRType.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
 //
 //===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "mlir/IR/Diagnostics.h"
 #include "mlir/IR/DialectImplementation.h"
 #include "llvm/ADT/SmallPtrSet.h"
 #include "llvm/ADT/StringSet.h"
 #include "llvm/ADT/TypeSwitch.h"
BoxCharType parseBoxChar(mlir::DialectAsmParser &parser) {
   return parseKindSingleton<BoxCharType>(parser);
 }
 
 // `boxproc` `<` return-type `>`
 BoxProcType parseBoxProc(mlir::DialectAsmParser &parser, mlir::Location loc) {
   return parseTypeSingleton<BoxProcType>(parser, loc);
 }
 
-// `char` `<` kind `>`
+// `char` `<` kind [`,` `len`] `>`
 CharacterType parseCharacter(mlir::DialectAsmParser &parser) {
-  return parseKindSingleton<CharacterType>(parser);
+  int kind = 0;
+  if (parser.parseLess() || parser.parseInteger(kind)) {
+    parser.emitError(parser.getCurrentLocation(), "kind value expected");
+    return {};
+  }
+  CharacterType::LenType len = 1;
+  if (mlir::succeeded(parser.parseOptionalComma())) {
+    if (mlir::succeeded(parser.parseOptionalQuestion())) {
+      len = fir::CharacterType::unknownLen();
+    } else if (!mlir::succeeded(parser.parseInteger(len))) {
+      parser.emitError(parser.getCurrentLocation(), "len value expected");
+      return {};
+    }
+  }
+  if (parser.parseGreater())
+    return {};
+  return CharacterType::get(parser.getBuilder().getContext(), kind, len);
 }
 
 // `complex` `<` kind `>`
-CplxType parseComplex(mlir::DialectAsmParser &parser) {
-  return parseKindSingleton<CplxType>(parser);
+fir::ComplexType parseComplex(mlir::DialectAsmParser &parser) {
+  return parseKindSingleton<fir::ComplexType>(parser);
+}
+
+// `shape` `<` rank `>`
+ShapeType parseShape(mlir::DialectAsmParser &parser) {
+  return parseRankSingleton<ShapeType>(parser);
 }
 
-// `dims` `<` rank `>`
-DimsType parseDims(mlir::DialectAsmParser &parser) {
-  return parseRankSingleton<DimsType>(parser);
+// `shapeshift` `<` rank `>`
+ShapeShiftType parseShapeShift(mlir::DialectAsmParser &parser) {
+  return parseRankSingleton<ShapeShiftType>(parser);
+}
+
+// `slice` `<` rank `>`
+SliceType parseSlice(mlir::DialectAsmParser &parser) {
+  return parseRankSingleton<SliceType>(parser);
 }
 
 // `field`
 FieldType parseField(mlir::DialectAsmParser &parser) {
   return FieldType::get(parser.getBuilder().getContext());
 }
 
 // `heap` `<` type `>`
 HeapType parseHeap(mlir::DialectAsmParser &parser, mlir::Location loc) {
   return parseTypeSingleton<HeapType>(parser, loc);
 }
 
 // `int` `<` kind `>`
-IntType parseInteger(mlir::DialectAsmParser &parser) {
-  return parseKindSingleton<IntType>(parser);
+fir::IntegerType parseInteger(mlir::DialectAsmParser &parser) {
+  return parseKindSingleton<fir::IntegerType>(parser);
 }
 
 // `len`
 LenType parseLen(mlir::DialectAsmParser &parser) {
   return LenType::get(parser.getBuilder().getContext());
 }
 
 // `logical` `<` kind `>`
ReferenceType parseReference(mlir::DialectAsmParser &parser,
   return parseTypeSingleton<ReferenceType>(parser, loc);
 }
 
 // `tdesc` `<` type `>`
 TypeDescType parseTypeDesc(mlir::DialectAsmParser &parser, mlir::Location loc) {
   return parseTypeSingleton<TypeDescType>(parser, loc);
 }
 
+// `vector` `<` len `:` type `>`
+fir::VectorType parseVector(mlir::DialectAsmParser &parser,
+                            mlir::Location loc) {
+  int64_t len = 0;
+  mlir::Type eleTy;
+  if (parser.parseLess() || parser.parseInteger(len) || parser.parseColon() ||
+      parser.parseType(eleTy) || parser.parseGreater()) {
+    parser.emitError(parser.getNameLoc(), "invalid vector type");
+    return {};
+  }
+  return fir::VectorType::get(len, eleTy);
+}
+
 // `void`
 mlir::Type parseVoid(mlir::DialectAsmParser &parser) {
   return parser.getBuilder().getNoneType();
 }
 
 // `array` `<` `*` | bounds (`x` bounds)* `:` type (',' affine-map)? `>`
 // bounds ::= `?` | int-lit
 SequenceType parseSequence(mlir::DialectAsmParser &parser, mlir::Location) {
   if (parser.parseLess()) {
     parser.emitError(parser.getNameLoc(), "expecting '<'");
     return {};
   }
   SequenceType::Shape shape;
   if (parser.parseOptionalStar()) {
-    if (parser.parseDimensionList(shape, true)) {
+    if (parser.parseDimensionList(shape, /*allowDynamic=*/true)) {
       parser.emitError(parser.getNameLoc(), "invalid shape");
       return {};
     }
   } else if (parser.parseColon()) {
     parser.emitError(parser.getNameLoc(), "expected ':'");
     return {};
   }
   mlir::Type eleTy;
   if (parser.parseType(eleTy) || parser.parseGreater()) {
     parser.emitError(parser.getNameLoc(), "expecting element type");
     return {};
   }
   mlir::AffineMapAttr map;
   if (!parser.parseOptionalComma())
     if (parser.parseAttribute(map)) {
       parser.emitError(parser.getNameLoc(), "expecting affine map");
       return {};
     }
   return SequenceType::get(shape, eleTy, map);
 }
 
 /// Is `ty` a standard or FIR integer type?
 static bool isaIntegerType(mlir::Type ty) {
   // TODO: why aren't we using isa_integer? investigatation required.
-  return ty.isa<mlir::IntegerType>() || ty.isa<fir::IntType>();
+  return ty.isa<mlir::IntegerType>() || ty.isa<fir::IntegerType>();
 }
 
 bool verifyRecordMemberType(mlir::Type ty) {
   return !(ty.isa<BoxType>() || ty.isa<BoxCharType>() ||
-           ty.isa<BoxProcType>() || ty.isa<DimsType>() || ty.isa<FieldType>() ||
-           ty.isa<LenType>() || ty.isa<ReferenceType>() ||
-           ty.isa<TypeDescType>());
+           ty.isa<BoxProcType>() || ty.isa<ShapeType>() ||
+           ty.isa<ShapeShiftType>() || ty.isa<SliceType>() ||
+           ty.isa<FieldType>() || ty.isa<LenType>() ||
+           ty.isa<ReferenceType>() || ty.isa<TypeDescType>());
 }
 
 bool verifySameLists(llvm::ArrayRef<RecordType::TypePair> a1,
                      llvm::ArrayRef<RecordType::TypePair> a2) {
   // FIXME: do we need to allow for any variance here?
   return a1 == a2;
 }
 
mlir::Type fir::parseFirType(FIROpsDialect *, mlir::DialectAsmParser &parser) {
   if (typeNameLit == "boxchar")
     return parseBoxChar(parser);
   if (typeNameLit == "boxproc")
     return parseBoxProc(parser, loc);
   if (typeNameLit == "char")
     return parseCharacter(parser);
   if (typeNameLit == "complex")
     return parseComplex(parser);
-  if (typeNameLit == "dims")
-    return parseDims(parser);
   if (typeNameLit == "field")
     return parseField(parser);
   if (typeNameLit == "heap")
     return parseHeap(parser, loc);
   if (typeNameLit == "int")
     return parseInteger(parser);
   if (typeNameLit == "len")
     return parseLen(parser);
   if (typeNameLit == "logical")
     return parseLogical(parser);
   if (typeNameLit == "ptr")
     return parsePointer(parser, loc);
   if (typeNameLit == "real")
     return parseReal(parser);
   if (typeNameLit == "ref")
     return parseReference(parser, loc);
+  if (typeNameLit == "shape")
+    return parseShape(parser);
+  if (typeNameLit == "shapeshift")
+    return parseShapeShift(parser);
+  if (typeNameLit == "slice")
+    return parseSlice(parser);
   if (typeNameLit == "tdesc")
     return parseTypeDesc(parser, loc);
   if (typeNameLit == "type")
     return parseDerived(parser, loc);
   if (typeNameLit == "void")
     return parseVoid(parser);
+  if (typeNameLit == "vector")
+    return parseVector(parser, loc);
 
   parser.emitError(parser.getNameLoc(), "unknown FIR type " + typeNameLit);
   return {};
 }
 
 namespace fir {
 namespace detail {
 
 // Type storage classes
 
 /// `CHARACTER` storage
 struct CharacterTypeStorage : public mlir::TypeStorage {
-  using KeyTy = KindTy;
+  using KeyTy = std::tuple<KindTy, CharacterType::LenType>;
 
-  static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
+  static unsigned hashKey(const KeyTy &key) {
+    auto hashVal = llvm::hash_combine(std::get<0>(key));
+    return llvm::hash_combine(hashVal, llvm::hash_combine(std::get<1>(key)));
+  }
 
-  bool operator==(const KeyTy &key) const { return key == getFKind(); }
+  bool operator==(const KeyTy &key) const {
+    return key == KeyTy{getFKind(), getLen()};
+  }
 
   static CharacterTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
-                                         KindTy kind) {
+                                         const KeyTy &key) {
     auto *storage = allocator.allocate<CharacterTypeStorage>();
-    return new (storage) CharacterTypeStorage{kind};
+    return new (storage)
+        CharacterTypeStorage{std::get<0>(key), std::get<1>(key)};
   }
 
   KindTy getFKind() const { return kind; }
+  CharacterType::LenType getLen() const { return len; }
 
 protected:
   KindTy kind;
+  CharacterType::LenType len;
 
 private:
   CharacterTypeStorage() = delete;
-  explicit CharacterTypeStorage(KindTy kind) : kind{kind} {}
+  explicit CharacterTypeStorage(KindTy kind, CharacterType::LenType len)
+      : kind{kind}, len{len} {}
+};
+
+struct ShapeTypeStorage : public mlir::TypeStorage {
+  using KeyTy = unsigned;
+
+  static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
+
+  bool operator==(const KeyTy &key) const { return key == getRank(); }
+
+  static ShapeTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
+                                     unsigned rank) {
+    auto *storage = allocator.allocate<ShapeTypeStorage>();
+    return new (storage) ShapeTypeStorage{rank};
+  }
+
+  unsigned getRank() const { return rank; }
+
+protected:
+  unsigned rank;
+
+private:
+  ShapeTypeStorage() = delete;
+  explicit ShapeTypeStorage(unsigned rank) : rank{rank} {}
 };
+struct ShapeShiftTypeStorage : public mlir::TypeStorage {
+  using KeyTy = unsigned;
+
+  static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
+
+  bool operator==(const KeyTy &key) const { return key == getRank(); }
+
+  static ShapeShiftTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
+                                          unsigned rank) {
+    auto *storage = allocator.allocate<ShapeShiftTypeStorage>();
+    return new (storage) ShapeShiftTypeStorage{rank};
+  }
+
+  unsigned getRank() const { return rank; }
+
+protected:
+  unsigned rank;
 
-struct DimsTypeStorage : public mlir::TypeStorage {
+private:
+  ShapeShiftTypeStorage() = delete;
+  explicit ShapeShiftTypeStorage(unsigned rank) : rank{rank} {}
+};
+struct SliceTypeStorage : public mlir::TypeStorage {
   using KeyTy = unsigned;
 
   static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
 
   bool operator==(const KeyTy &key) const { return key == getRank(); }
 
-  static DimsTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
+  static SliceTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
                                      unsigned rank) {
-    auto *storage = allocator.allocate<DimsTypeStorage>();
-    return new (storage) DimsTypeStorage{rank};
+    auto *storage = allocator.allocate<SliceTypeStorage>();
+    return new (storage) SliceTypeStorage{rank};
   }
 
   unsigned getRank() const { return rank; }
 
 protected:
   unsigned rank;
 
 private:
-  DimsTypeStorage() = delete;
-  explicit DimsTypeStorage(unsigned rank) : rank{rank} {}
+  SliceTypeStorage() = delete;
+  explicit SliceTypeStorage(unsigned rank) : rank{rank} {}
 };
 
 /// The type of a derived type part reference
 struct FieldTypeStorage : public mlir::TypeStorage {
   using KeyTy = KindTy;
 
   static unsigned hashKey(const KeyTy &) { return llvm::hash_combine(0); }
 
protected:
   KindTy kind;
 
 private:
   LogicalTypeStorage() = delete;
   explicit LogicalTypeStorage(KindTy kind) : kind{kind} {}
 };
 
 /// `INTEGER` storage
-struct IntTypeStorage : public mlir::TypeStorage {
+struct IntegerTypeStorage : public mlir::TypeStorage {
   using KeyTy = KindTy;
 
   static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
 
   bool operator==(const KeyTy &key) const { return key == getFKind(); }
 
-  static IntTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
+  static IntegerTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
                                        KindTy kind) {
-    auto *storage = allocator.allocate<IntTypeStorage>();
-    return new (storage) IntTypeStorage{kind};
+    auto *storage = allocator.allocate<IntegerTypeStorage>();
+    return new (storage) IntegerTypeStorage{kind};
   }
 
   KindTy getFKind() const { return kind; }
 
 protected:
   KindTy kind;
 
 private:
-  IntTypeStorage() = delete;
-  explicit IntTypeStorage(KindTy kind) : kind{kind} {}
+  IntegerTypeStorage() = delete;
+  explicit IntegerTypeStorage(KindTy kind) : kind{kind} {}
 };
 
 /// `COMPLEX` storage
-struct CplxTypeStorage : public mlir::TypeStorage {
+struct ComplexTypeStorage : public mlir::TypeStorage {
   using KeyTy = KindTy;
 
   static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
 
   bool operator==(const KeyTy &key) const { return key == getFKind(); }
 
-  static CplxTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
+  static ComplexTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
                                        KindTy kind) {
-    auto *storage = allocator.allocate<CplxTypeStorage>();
-    return new (storage) CplxTypeStorage{kind};
+    auto *storage = allocator.allocate<ComplexTypeStorage>();
+    return new (storage) ComplexTypeStorage{kind};
   }
 
   KindTy getFKind() const { return kind; }
 
 protected:
   KindTy kind;
 
 private:
-  CplxTypeStorage() = delete;
-  explicit CplxTypeStorage(KindTy kind) : kind{kind} {}
+  ComplexTypeStorage() = delete;
+  explicit ComplexTypeStorage(KindTy kind) : kind{kind} {}
 };
 
 /// `REAL` storage (for reals of unsupported sizes)
 struct RealTypeStorage : public mlir::TypeStorage {
   using KeyTy = KindTy;
 
   static unsigned hashKey(const KeyTy &key) { return llvm::hash_combine(key); }
 
struct BoxCharTypeStorage : public mlir::TypeStorage {
   static BoxCharTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
                                        KindTy kind) {
     auto *storage = allocator.allocate<BoxCharTypeStorage>();
     return new (storage) BoxCharTypeStorage{kind};
   }
 
   KindTy getFKind() const { return kind; }
 
-  // a !fir.boxchar<k> always wraps a !fir.char<k>
+  // a !fir.boxchar<k> always wraps a !fir.char<k, ?>
   CharacterType getElementType(mlir::MLIRContext *ctxt) const {
-    return CharacterType::get(ctxt, getFKind());
+    return CharacterType::getUnknownLen(ctxt, getFKind());
   }
 
 protected:
   KindTy kind;
 
 private:
   BoxCharTypeStorage() = delete;
   explicit BoxCharTypeStorage(KindTy kind) : kind{kind} {}

 };
 
 /// Sequence-like object storage
 struct SequenceTypeStorage : public mlir::TypeStorage {
   using KeyTy =
       std::tuple<SequenceType::Shape, mlir::Type, mlir::AffineMapAttr>;
 
   static unsigned hashKey(const KeyTy &key) {
-    auto shapeHash{hash_value(std::get<SequenceType::Shape>(key))};
+    auto shapeHash = hash_value(std::get<SequenceType::Shape>(key));
     shapeHash = llvm::hash_combine(shapeHash, std::get<mlir::Type>(key));
     return llvm::hash_combine(shapeHash, std::get<mlir::AffineMapAttr>(key));
   }
 
   bool operator==(const KeyTy &key) const {
     return key == KeyTy{getShape(), getElementType(), getLayoutMap()};
   }
 

 protected:
   mlir::Type ofTy;
 
 private:
   TypeDescTypeStorage() = delete;
   explicit TypeDescTypeStorage(mlir::Type ofTy) : ofTy{ofTy} {}
 };
 
+/// Vector type storage
+struct VectorTypeStorage : public mlir::TypeStorage {
+  using KeyTy = std::tuple<uint64_t, mlir::Type>;
+
+  static unsigned hashKey(const KeyTy &key) {
+    return llvm::hash_combine(std::get<uint64_t>(key),
+                              std::get<mlir::Type>(key));
+  }
+
+  bool operator==(const KeyTy &key) const {
+    return key == KeyTy{getLen(), getEleTy()};
+  }
+
+  static VectorTypeStorage *construct(mlir::TypeStorageAllocator &allocator,
+                                      const KeyTy &key) {
+    auto *storage = allocator.allocate<VectorTypeStorage>();
+    return new (storage)
+        VectorTypeStorage{std::get<uint64_t>(key), std::get<mlir::Type>(key)};
+  }
+
+  uint64_t getLen() const { return len; }
+  mlir::Type getEleTy() const { return eleTy; }
+
+protected:
+  uint64_t len;
+  mlir::Type eleTy;
+
+private:
+  VectorTypeStorage() = delete;
+  explicit VectorTypeStorage(uint64_t len, mlir::Type eleTy)
+      : len{len}, eleTy{eleTy} {}
+};
+
 } // namespace detail
 
 template <typename A, typename B>
 bool inbounds(A v, B lb, B ub) {
   return v >= lb && v < ub;
 }
 
 bool isa_fir_type(mlir::Type t) {
   return llvm::isa<FIROpsDialect>(t.getDialect());
 }
 
 bool isa_std_type(mlir::Type t) {
   return t.getDialect().getNamespace().empty();
 }
 
 bool isa_fir_or_std_type(mlir::Type t) {
   if (auto funcType = t.dyn_cast<mlir::FunctionType>())
-    return llvm::all_of(funcType.getInputs(), isa_fir_or_std_type) &&  
+    return llvm::all_of(funcType.getInputs(), isa_fir_or_std_type) &&
            llvm::all_of(funcType.getResults(), isa_fir_or_std_type);
   return isa_fir_type(t) || isa_std_type(t);
 }
 
 bool isa_ref_type(mlir::Type t) {
   return t.isa<ReferenceType>() || t.isa<PointerType>() || t.isa<HeapType>();
 }
 
 bool isa_box_type(mlir::Type t) {
   return t.isa<BoxType>() || t.isa<BoxCharType>() || t.isa<BoxProcType>();
 }
 
 bool isa_passbyref_type(mlir::Type t) {
-  return t.isa<ReferenceType>() || isa_box_type(t);
+  return t.isa<ReferenceType>() || isa_box_type(t) ||
+         t.isa<mlir::FunctionType>();
 }
 
 bool isa_aggregate(mlir::Type t) {
-  return t.isa<SequenceType>() || t.isa<RecordType>();
+  return t.isa<SequenceType>() || t.isa<RecordType>() ||
+         t.isa<mlir::TupleType>();
 }
 
 mlir::Type dyn_cast_ptrEleTy(mlir::Type t) {
   return llvm::TypeSwitch<mlir::Type, mlir::Type>(t)
       .Case<fir::ReferenceType, fir::PointerType, fir::HeapType>(
           [](auto p) { return p.getEleTy(); })
       .Default([](mlir::Type) { return mlir::Type{}; });
 }
 
 } // namespace fir
 
 // CHARACTER
 
-CharacterType fir::CharacterType::get(mlir::MLIRContext *ctxt, KindTy kind) {
-  return Base::get(ctxt, kind);
+CharacterType fir::CharacterType::get(mlir::MLIRContext *ctxt, KindTy kind,
+                                      CharacterType::LenType len) {
+  return Base::get(ctxt, kind, len);
 }
 
-int fir::CharacterType::getFKind() const { return getImpl()->getFKind(); }
-
-// Dims
+KindTy fir::CharacterType::getFKind() const { return getImpl()->getFKind(); }
 
-DimsType fir::DimsType::get(mlir::MLIRContext *ctxt, unsigned rank) {
-  return Base::get(ctxt, rank);
+CharacterType::LenType fir::CharacterType::getLen() const {
+  return getImpl()->getLen();
 }
 
-unsigned fir::DimsType::getRank() const { return getImpl()->getRank(); }
-
 // Field
 
 FieldType fir::FieldType::get(mlir::MLIRContext *ctxt) {
   return Base::get(ctxt, 0);
 }
 
 // Len
 
 LenType fir::LenType::get(mlir::MLIRContext *ctxt) {
   return Base::get(ctxt, 0);
 }
 
 // LOGICAL
 
 LogicalType fir::LogicalType::get(mlir::MLIRContext *ctxt, KindTy kind) {
   return Base::get(ctxt, kind);
 }
 
-int fir::LogicalType::getFKind() const { return getImpl()->getFKind(); }
+KindTy fir::LogicalType::getFKind() const { return getImpl()->getFKind(); }
 
 // INTEGER
 
-IntType fir::IntType::get(mlir::MLIRContext *ctxt, KindTy kind) {
+fir::IntegerType fir::IntegerType::get(mlir::MLIRContext *ctxt, KindTy kind) {
   return Base::get(ctxt, kind);
 }
 
-int fir::IntType::getFKind() const { return getImpl()->getFKind(); }
+KindTy fir::IntegerType::getFKind() const { return getImpl()->getFKind(); }
 
 // COMPLEX
 
-CplxType fir::CplxType::get(mlir::MLIRContext *ctxt, KindTy kind) {
+fir::ComplexType fir::ComplexType::get(mlir::MLIRContext *ctxt, KindTy kind) {
   return Base::get(ctxt, kind);
 }
 
-mlir::Type fir::CplxType::getElementType() const {
+mlir::Type fir::ComplexType::getElementType() const {
   return fir::RealType::get(getContext(), getFKind());
 }
 
-KindTy fir::CplxType::getFKind() const { return getImpl()->getFKind(); }
+KindTy fir::ComplexType::getFKind() const { return getImpl()->getFKind(); }
 
 // REAL
 
 RealType fir::RealType::get(mlir::MLIRContext *ctxt, KindTy kind) {
   return Base::get(ctxt, kind);
 }
 
-int fir::RealType::getFKind() const { return getImpl()->getFKind(); }
+KindTy fir::RealType::getFKind() const { return getImpl()->getFKind(); }
 
 // Box<T>
 
 BoxType fir::BoxType::get(mlir::Type elementType, mlir::AffineMapAttr map) {
   return Base::get(elementType.getContext(), elementType, map);
 }
 
 mlir::Type fir::BoxType::getEleTy() const {

 
 mlir::Type fir::ReferenceType::getEleTy() const {
   return getImpl()->getElementType();
 }
 
 mlir::LogicalResult
 fir::ReferenceType::verifyConstructionInvariants(mlir::Location loc,
                                                  mlir::Type eleTy) {
-  if (eleTy.isa<DimsType>() || eleTy.isa<FieldType>() || eleTy.isa<LenType>() ||
-      eleTy.isa<ReferenceType>() || eleTy.isa<TypeDescType>())
+  if (eleTy.isa<ShapeType>() || eleTy.isa<ShapeShiftType>() ||
+      eleTy.isa<SliceType>() || eleTy.isa<FieldType>() ||
+      eleTy.isa<LenType>() || eleTy.isa<ReferenceType>() ||
+      eleTy.isa<TypeDescType>())
     return mlir::emitError(loc, "cannot build a reference to type: ")
            << eleTy << '\n';
   return mlir::success();
 }
 
 // Pointer<T>
 
 PointerType fir::PointerType::get(mlir::Type elementType) {
   assert(singleIndirectionLevel(elementType) && "invalid element type");
   return Base::get(elementType.getContext(), elementType);
 }
 
 mlir::Type fir::PointerType::getEleTy() const {
   return getImpl()->getElementType();
 }
 
 static bool canBePointerOrHeapElementType(mlir::Type eleTy) {
   return eleTy.isa<BoxType>() || eleTy.isa<BoxCharType>() ||
-         eleTy.isa<BoxProcType>() || eleTy.isa<DimsType>() ||
+         eleTy.isa<BoxProcType>() || eleTy.isa<ShapeType>() ||
+         eleTy.isa<ShapeShiftType>() || eleTy.isa<SliceType>() ||
          eleTy.isa<FieldType>() || eleTy.isa<LenType>() ||
          eleTy.isa<HeapType>() || eleTy.isa<PointerType>() ||
          eleTy.isa<ReferenceType>() || eleTy.isa<TypeDescType>();
 }
 
 mlir::LogicalResult
 fir::PointerType::verifyConstructionInvariants(mlir::Location loc,
                                                mlir::Type eleTy) {
bool fir::SequenceType::hasConstantInterior() const {
   return true;
 }
 
 mlir::LogicalResult fir::SequenceType::verifyConstructionInvariants(
     mlir::Location loc, const SequenceType::Shape &shape, mlir::Type eleTy,
     mlir::AffineMapAttr map) {
   // DIMENSION attribute can only be applied to an intrinsic or record type
   if (eleTy.isa<BoxType>() || eleTy.isa<BoxCharType>() ||
-      eleTy.isa<BoxProcType>() || eleTy.isa<DimsType>() ||
+      eleTy.isa<BoxProcType>() || eleTy.isa<ShapeType>() ||
+      eleTy.isa<ShapeShiftType>() || eleTy.isa<SliceType>() ||
       eleTy.isa<FieldType>() || eleTy.isa<LenType>() || eleTy.isa<HeapType>() ||
       eleTy.isa<PointerType>() || eleTy.isa<ReferenceType>() ||
-      eleTy.isa<TypeDescType>() || eleTy.isa<SequenceType>())
+      eleTy.isa<TypeDescType>() || eleTy.isa<fir::VectorType>() ||
+      eleTy.isa<SequenceType>())
     return mlir::emitError(loc, "cannot build an array of this element type: ")
            << eleTy << '\n';
   return mlir::success();
 }
 
 // compare if two shapes are equivalent
 bool fir::operator==(const SequenceType::Shape &sh_1,
                      const SequenceType::Shape &sh_2) {

 // compute the hash of a Shape
 llvm::hash_code fir::hash_value(const SequenceType::Shape &sh) {
   if (sh.size()) {
     return llvm::hash_combine_range(sh.begin(), sh.end());
   }
   return llvm::hash_combine(0);
 }
 
+// Shape
+
+ShapeType fir::ShapeType::get(mlir::MLIRContext *ctxt, unsigned rank) {
+  return Base::get(ctxt, rank);
+}
+
+unsigned fir::ShapeType::getRank() const { return getImpl()->getRank(); }
+
+// Shapeshift
+
+ShapeShiftType fir::ShapeShiftType::get(mlir::MLIRContext *ctxt,
+                                        unsigned rank) {
+  return Base::get(ctxt, rank);
+}
+
+unsigned fir::ShapeShiftType::getRank() const { return getImpl()->getRank(); }
+
+// Slice
+
+SliceType fir::SliceType::get(mlir::MLIRContext *ctxt, unsigned rank) {
+  return Base::get(ctxt, rank);
+}
+
+unsigned fir::SliceType::getRank() const { return getImpl()->getRank(); }
+
 /// RecordType
 ///
 /// This type captures a Fortran "derived type"
 
 RecordType fir::RecordType::get(mlir::MLIRContext *ctxt, llvm::StringRef name) {
   return Base::get(ctxt, name);
 }
 

 
 mlir::Type fir::RecordType::getType(llvm::StringRef ident) {
   for (auto f : getTypeList())
     if (ident == f.first)
       return f.second;
   return {};
 }
 
-/// Type descriptor type
-///
-/// This is the type of a type descriptor object (similar to a class instance)
+//===----------------------------------------------------------------------===//
+// Type descriptor type
+//===----------------------------------------------------------------------===//
 
 TypeDescType fir::TypeDescType::get(mlir::Type ofType) {
   assert(!ofType.isa<ReferenceType>());
   return Base::get(ofType.getContext(), ofType);
 }
 
 mlir::Type fir::TypeDescType::getOfTy() const { return getImpl()->getOfType(); }
 
 mlir::LogicalResult
 fir::TypeDescType::verifyConstructionInvariants(mlir::Location loc,
                                                 mlir::Type eleTy) {
   if (eleTy.isa<BoxType>() || eleTy.isa<BoxCharType>() ||
-      eleTy.isa<BoxProcType>() || eleTy.isa<DimsType>() ||
+      eleTy.isa<BoxProcType>() || eleTy.isa<ShapeType>() ||
+      eleTy.isa<ShapeShiftType>() || eleTy.isa<SliceType>() ||
       eleTy.isa<FieldType>() || eleTy.isa<LenType>() ||
       eleTy.isa<ReferenceType>() || eleTy.isa<TypeDescType>())
     return mlir::emitError(loc, "cannot build a type descriptor of type: ")
            << eleTy << '\n';
   return mlir::success();
 }
 
+//===----------------------------------------------------------------------===//
+// Vector type
+//===----------------------------------------------------------------------===//
+
+fir::VectorType fir::VectorType::get(uint64_t len, mlir::Type eleTy) {
+  return Base::get(eleTy.getContext(), len, eleTy);
+}
+
+mlir::Type fir::VectorType::getEleTy() const { return getImpl()->getEleTy(); }
+
+uint64_t fir::VectorType::getLen() const { return getImpl()->getLen(); }
+
+mlir::LogicalResult
+fir::VectorType::verifyConstructionInvariants(mlir::Location loc, uint64_t len,
+                                              mlir::Type eleTy) {
+  if (!(fir::isa_real(eleTy) || fir::isa_integer(eleTy)))
+    return mlir::emitError(loc, "cannot build a vector of type ")
+           << eleTy << '\n';
+  return mlir::success();
+}
+
 namespace {
 
 void printBounds(llvm::raw_ostream &os, const SequenceType::Shape &bounds) {
   os << '<';
   for (auto &b : bounds) {
-    if (b >= 0) {
+    if (b >= 0)
       os << b << 'x';
-    } else {
+    else
       os << "?x";
-    }
-  }
-}
 
 llvm::SmallPtrSet<detail::RecordTypeStorage const *, 4> recordTypeVisited;
 
 } // namespace
 
 void fir::verifyIntegralType(mlir::Type type) {
   if (isaIntegerType(type) || type.isa<mlir::IndexType>())
     return;
if (auto type = ty.dyn_cast<BoxCharType>()) {
     return;
   }
   if (auto type = ty.dyn_cast<BoxProcType>()) {
     os << "boxproc<";
     p.printType(type.getEleTy());
     os << '>';
     return;
   }
-  if (auto type = ty.dyn_cast<CharacterType>()) {
-    os << "char<" << type.getFKind() << '>';
+  if (auto chTy = ty.dyn_cast<CharacterType>()) {
+    // Fortran intrinsic type CHARACTER
+    os << "char<" << chTy.getFKind();
+    auto len = chTy.getLen();
+    if (len != fir::CharacterType::singleton()) {
+      os << ',';
+      if (len == fir::CharacterType::unknownLen())
+        os << '?';
+      else
+        os << len;
+    }
+    os << '>';
     return;
   }
-  if (auto type = ty.dyn_cast<CplxType>()) {
+  if (auto type = ty.dyn_cast<fir::ComplexType>()) {
+    // Fortran intrinsic type COMPLEX
     os << "complex<" << type.getFKind() << '>';
     return;
   }
   if (auto type = ty.dyn_cast<RecordType>()) {
+    // Fortran derived type
     os << "type<" << type.getName();
     if (!recordTypeVisited.count(type.uniqueKey())) {
       recordTypeVisited.insert(type.uniqueKey());
       if (type.getLenParamList().size()) {
         char ch = '(';
         for (auto p : type.getLenParamList()) {
           os << ch << p.first << ':';
           p.second.print(os);
if (!recordTypeVisited.count(type.uniqueKey())) {
         }
         os << '}';
       }
       recordTypeVisited.erase(type.uniqueKey());
     }
     os << '>';
     return;
   }
-  if (auto type = ty.dyn_cast<DimsType>()) {
-    os << "dims<" << type.getRank() << '>';
+  if (auto type = ty.dyn_cast<ShapeType>()) {
+    os << "shape<" << type.getRank() << '>';
+    return;
+  }
+  if (auto type = ty.dyn_cast<ShapeShiftType>()) {
+    os << "shapeshift<" << type.getRank() << '>';
+    return;
+  }
+  if (auto type = ty.dyn_cast<SliceType>()) {
+    os << "slice<" << type.getRank() << '>';
     return;
   }
   if (ty.isa<FieldType>()) {
     os << "field";
     return;
   }
   if (auto type = ty.dyn_cast<HeapType>()) {
     os << "heap<";
     p.printType(type.getEleTy());
     os << '>';
     return;
   }
-  if (auto type = ty.dyn_cast<fir::IntType>()) {
+  if (auto type = ty.dyn_cast<fir::IntegerType>()) {
+    // Fortran intrinsic type INTEGER
     os << "int<" << type.getFKind() << '>';
     return;
   }
   if (auto type = ty.dyn_cast<LenType>()) {
     os << "len";
     return;
   }
   if (auto type = ty.dyn_cast<LogicalType>()) {
+    // Fortran intrinsic type LOGICAL
     os << "logical<" << type.getFKind() << '>';
     return;
   }
   if (auto type = ty.dyn_cast<PointerType>()) {
     os << "ptr<";
     p.printType(type.getEleTy());
     os << '>';
     return;
   }
   if (auto type = ty.dyn_cast<fir::RealType>()) {
+    // Fortran intrinsic types REAL and DOUBLE PRECISION
     os << "real<" << type.getFKind() << '>';
     return;
   }
   if (auto type = ty.dyn_cast<ReferenceType>()) {
     os << "ref<";
     p.printType(type.getEleTy());
     os << '>';
     return;
if (auto type = ty.dyn_cast<SequenceType>()) {
     return;
   }
   if (auto type = ty.dyn_cast<TypeDescType>()) {
     os << "tdesc<";
     p.printType(type.getOfTy());
     os << '>';
     return;
   }
+  if (auto type = ty.dyn_cast<fir::VectorType>()) {
+    os << "vector<" << type.getLen() << ':';
+    p.printType(type.getEleTy());
+    os << '>';
+    return;
+  }
+}
+
+bool fir::isa_unknown_size_box(mlir::Type t) {
+  if (auto boxTy = t.dyn_cast<fir::BoxType>()) {
+    auto eleTy = boxTy.getEleTy();
+    if (auto actualEleTy = fir::dyn_cast_ptrEleTy(eleTy))
+      eleTy = actualEleTy;
+    if (eleTy.isa<mlir::NoneType>())
+      return true;
+    if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>())
+      if (seqTy.hasUnknownShape())
+        return true;
+  }
+  return false;
 }

flang/test/Fir/fir-ops.fir

 // Test the FIR operations
 
 // RUN: tco -emit-fir %s | tco -emit-fir | FileCheck %s
-// UNSUPPORTED: !fir
+// XFAIL: *
 
 // CHECK-LABEL: func private @it1() -> !fir.int<4>
 // CHECK: func private @box1() -> !fir.boxchar<2>
 // CHECK: func private @box2() -> !fir.boxproc<(i32, i32) -> i64>
 // CHECK: func private @box3() -> !fir.box<!fir.type<derived3{f:f32}>>
 func private @it1() -> !fir.int<4>
 func private @box1() -> !fir.boxchar<2>
 func private @box2() -> !fir.boxproc<(i32, i32) -> i64>

 // CHECK: [[VAL_25:%.*]] = fir.extract_value [[VAL_24]], [[VAL_23]] : (!fir.type<derived{f:f32}>, !fir.field) -> f32
   %19 = constant 10 : i32
   %20 = fir.coordinate_of %5, %19 : (!fir.heap<!fir.array<100xf32>>, i32) -> !fir.ref<f32>
   %21 = fir.field_index f, !fir.type<derived{f:f32}>
   %22 = fir.undefined !fir.type<derived{f:f32}>
   %23 = fir.extract_value %22, %21 : (!fir.type<derived{f:f32}>, !fir.field) -> f32
 
 // CHECK: [[VAL_26:%.*]] = constant 1 : i32
-// CHECK: [[VAL_27:%.*]] = fir.gendims [[VAL_26]], [[VAL_21]], [[VAL_26]] : (i32, i32, i32) -> !fir.dims<1>
+// CHECK: [[VAL_27:%.*]] = fir.shape [[VAL_21]] : (i32) -> !fir.shape<1>
 // CHECK: [[VAL_28:%.*]] = constant 1.0
 // CHECK: [[VAL_29:%.*]] = fir.insert_value [[VAL_24]], [[VAL_28]], [[VAL_23]] : (!fir.type<derived{f:f32}>, f32, !fir.field) -> !fir.type<derived{f:f32}>
 // CHECK: [[VAL_30:%.*]] = fir.len_param_index f, !fir.type<derived3{f:f32}>
   %c1 = constant 1 : i32
-  %24 = fir.gendims %c1, %19, %c1 : (i32, i32, i32) -> !fir.dims<1>
+  %24 = fir.shape %19 : (i32) -> !fir.shape<1>
   %cf1 = constant 1.0 : f32
   %25 = fir.insert_value %22, %cf1, %21 : (!fir.type<derived{f:f32}>, f32, !fir.field) -> !fir.type<derived{f:f32}>
   %26 = fir.len_param_index f, !fir.type<derived3{f:f32}>
 
 // CHECK: [[VAL_31:%.*]] = fir.call @box3() : () -> !fir.box<!fir.type<derived3{f:f32}>>
 // CHECK: [[VAL_32:%.*]] = fir.dispatch "method"([[VAL_31]]) : (!fir.box<!fir.type<derived3{f:f32}>>) -> i32
 // CHECK: [[VAL_33:%.*]] = fir.convert [[VAL_32]] : (i32) -> i64
 // CHECK: [[VAL_34:%.*]] = fir.gentypedesc !fir.type<x>

 
 // CHECK-LABEL: func @boxing_match() {
 func @boxing_match() {
 // CHECK: [[VAL_38:%.*]] = fir.alloca i32
 // CHECK: [[VAL_39:%.*]] = fir.alloca !fir.type<qq2{f1:i32,f2:f64}>
 // CHECK: [[VAL_40:%.*]] = fir.alloca !fir.char<1>
 // CHECK: [[VAL_41:%.*]] = fir.alloca tuple<i32, f64>
 // CHECK: [[VAL_42:%.*]] = fir.embox [[VAL_38]] : (!fir.ref<i32>) -> !fir.box<i32>
-// CHECK: [[VAL_43:%.*]]:6 = fir.unbox [[VAL_42]] : (!fir.box<i32>) -> (!fir.ref<i32>, i32, i32, !fir.tdesc<i32>, i32, !fir.dims<0>)
+// CHECK: [[VAL_43:%.*]]:6 = fir.unbox [[VAL_42]] : (!fir.box<i32>) -> (!fir.ref<i32>, i32, i32, !fir.tdesc<i32>, i32, !fir.array<3x?xindex>)
 // CHECK: [[VAL_44:%.*]] = constant 8 : i32
 // CHECK: [[VAL_45:%.*]] = fir.undefined !fir.char<1>
 // CHECK: [[VAL_46:%.*]] = fir.emboxchar [[VAL_40]], [[VAL_44]] : (!fir.ref<!fir.char<1>>, i32) -> !fir.boxchar<1>
 // CHECK: [[VAL_47:%.*]]:2 = fir.unboxchar [[VAL_46]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1>>, i32)
 // CHECK: [[VAL_48:%.*]] = fir.undefined !fir.type<qq2{f1:i32,f2:f64}>
 // CHECK: [[VAL_49:%.*]] = constant 0 : i32
 // CHECK: [[VAL_50:%.*]] = constant 12 : i32
 // CHECK: [[VAL_51:%.*]] = fir.insert_value [[VAL_48]], [[VAL_50]], [[VAL_49]] : (!fir.type<qq2{f1:i32,f2:f64}>, i32, i32) -> !fir.type<qq2{f1:i32,f2:f64}>

 // CHECK: fir.call @store_tuple([[VAL_61]]) : (tuple<!fir.type<qq1{f1:i32}>>) -> ()
 // CHECK: return
 // CHECK: }
   %0 = fir.alloca i32
   %d6 = fir.alloca !fir.type<qq2{f1:i32,f2:f64}>
   %d3 = fir.alloca !fir.char<1>
   %e6 = fir.alloca tuple<i32,f64>
   %1 = fir.embox %0 : (!fir.ref<i32>) -> !fir.box<i32>
-  %2:6 = fir.unbox %1 : (!fir.box<i32>) -> (!fir.ref<i32>,i32,i32,!fir.tdesc<i32>,i32,!fir.dims<0>)
+  %2:6 = fir.unbox %1 : (!fir.box<i32>) -> (!fir.ref<i32>,i32,i32,!fir.tdesc<i32>,i32,!fir.array<3x?xindex>)
   %c8 = constant 8 : i32
   %3 = fir.undefined !fir.char<1>
   %4 = fir.emboxchar %d3, %c8 : (!fir.ref<!fir.char<1>>, i32) -> !fir.boxchar<1>
   %5:2 = fir.unboxchar %4 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1>>, i32)
   %6 = fir.undefined !fir.type<qq2{f1:i32,f2:f64}>
   %z = constant 0 : i32
   %c12 = constant 12 : i32
   %a2 = fir.insert_value %6, %c12, %z : (!fir.type<qq2{f1:i32,f2:f64}>, i32, i32) -> !fir.type<qq2{f1:i32,f2:f64}>
// CHECK: [[VAL_184:%.*]] = fir.divc [[VAL_183]], [[VAL_178]] : !fir.complex<16>
   %3 = fir.subc %2, %b : !fir.complex<16>
   %4 = fir.mulc %1, %3 : !fir.complex<16>
   %5 = fir.divc %4, %a : !fir.complex<16>
 // CHECK: return [[VAL_184]] : !fir.complex<16>
 // CHECK: }
   return %5 : !fir.complex<16>
 }
 
-// CHECK-LABEL: func @character_literal() -> !fir.array<13x!fir.char<1>> {
-func @character_literal() -> !fir.array<13 x !fir.char<1>> {
-// CHECK: [[VAL_185:%.*]] = fir.string_lit "Hello, World!"(13) : !fir.char<1>
+// CHECK-LABEL: func @character_literal() -> !fir.char<1,13> {
+func @character_literal() -> !fir.char<1,13> {
+// CHECK: [[VAL_185:%.*]] = fir.string_lit "Hello, World!"(13) : !fir.char<1,13>
   %0 = fir.string_lit "Hello, World!"(13) : !fir.char<1>
-// CHECK: return [[VAL_185]] : !fir.array<13x!fir.char<1>>
-  return %0 : !fir.array<13 x !fir.char<1>>
+// CHECK: return [[VAL_185]] : !fir.char<1,13>
+  return %0 : !fir.char<1,13>
 // CHECK: }
 }
 
 // CHECK-LABEL: func private @earlyexit2(i32) -> i1
 func private @earlyexit2(%a : i32) -> i1
 
 // CHECK-LABEL: func @early_exit(
 // CHECK-SAME: [[VAL_186:%.*]]: i1, [[VAL_187:%.*]]: i32) -> i1 {
 func @early_exit(%ok : i1, %k : i32) -> i1 {
 // CHECK: [[VAL_188:%.*]] = constant 1 : index
 // CHECK: [[VAL_189:%.*]] = constant 100 : index
   %c1 = constant 1 : index
   %c100 = constant 100 : index
 
-// CHECK: [[VAL_190:%.*]], [[VAL_191:%.*]] = fir.iterate_while ([[VAL_192:%.*]] = [[VAL_188]] to [[VAL_189]] step [[VAL_188]]) and ([[VAL_193:%.*]] = [[VAL_186]]) iter_args([[VAL_194:%.*]] = [[VAL_187]]) -> (i32) {
+// CHECK: %[[VAL_190:.*]]:2 = fir.iterate_while ([[VAL_192:%.*]] = [[VAL_188]] to [[VAL_189]] step [[VAL_188]]) and ([[VAL_193:%.*]] = [[VAL_186]]) iter_args([[VAL_194:%.*]] = [[VAL_187]]) -> (i32) {
 // CHECK: [[VAL_195:%.*]] = call @earlyexit2([[VAL_194]]) : (i32) -> i1
 // CHECK: fir.result [[VAL_195]], [[VAL_194]] : i1, i32
 // CHECK: }
   %newOk:2 = fir.iterate_while (%i = %c1 to %c100 step %c1) and (%ok_ = %ok) iter_args(%v = %k) -> (i32) {
     %stop = call @earlyexit2(%v) : (i32) -> i1
     fir.result %stop, %v : i1, i32
   }
-// CHECK: return [[VAL_190]] : i1
+// CHECK: return %[[VAL_190]]#0 : i1
 // CHECK: }
   return %newOk#0 : i1
 }
+
+// CHECK-LABEL: @array_access
+func @array_access(%arr : !fir.ref<!fir.array<?x?xf32>>) {
+  // CHECK-DAG: %[[c1:.*]] = constant 100
+  // CHECK-DAG: %[[c2:.*]] = constant 50
+  %c100 = constant 100 : index
+  %c50 = constant 50 : index
+  // CHECK: %[[sh:.*]] = fir.shape %[[c1]], %[[c2]] : {{.*}} -> !fir.shape<2>
+  %shape = fir.shape %c100, %c50 : (index, index) -> !fir.shape<2>
+  %c47 = constant 47 : index
+  %c78 = constant 78 : index
+  %c3 = constant 3 : index
+  %c18 = constant 18 : index
+  %c36 = constant 36 : index
+  %c4 = constant 4 : index
+  // CHECK: %[[sl:.*]] = fir.slice {{.*}} -> !fir.slice<2>
+  %slice = fir.slice %c47, %c78, %c3, %c18, %c36, %c4 : (index,index,index,index,index,index) -> !fir.slice<2>
+  %c0 = constant 0 : index
+  %c99 = constant 99 : index
+  %c1 = constant 1 : index
+  fir.do_loop %i = %c0 to %c99 step %c1 {
+    %c49 = constant 49 : index
+    fir.do_loop %j = %c0 to %c49 step %c1 {
+      // CHECK: fir.array_coor %{{.*}}(%[[sh]]) [%[[sl]]] %{{.*}}, %{{.*}} :
+      %p = fir.array_coor %arr(%shape)[%slice] %i, %j : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32>
+      %x = constant 42.0 : f32
+      fir.store %x to %p : !fir.ref<f32>
+    }
+  }
+  return
+}

flang/test/Fir/fir-types.fir

 // Test the FIR types
 
 // RUN: tco -emit-fir %s | tco -emit-fir | FileCheck %s
-// UNSUPPORTED: !fir
 
 // Fortran Intrinsic types
 // CHECK-LABEL: func private @it1() -> !fir.int<4>
 // CHECK-LABEL: func private @it2() -> !fir.real<8>
 // CHECK-LABEL: func private @it3() -> !fir.complex<8>
 // CHECK-LABEL: func private @it4() -> !fir.logical<1>
 // CHECK-LABEL: func private @it5() -> !fir.char<1>
+// CHECK-LABEL: func private @it6() -> !fir.char<2,10>
+// CHECK-LABEL: func private @it7() -> !fir.char<4,?>
 func private @it1() -> !fir.int<4>
 func private @it2() -> !fir.real<8>
 func private @it3() -> !fir.complex<8>
 func private @it4() -> !fir.logical<1>
 func private @it5() -> !fir.char<1>
+func private @it6() -> !fir.char<2,10>
+func private @it7() -> !fir.char<4,?>
 
 // Fortran Derived types (records)
 // CHECK-LABEL: func private @dvd1() -> !fir.type<derived1>
 // CHECK-LABEL: func private @dvd2() -> !fir.type<derived2(p:i32)>
 // CHECK-LABEL: func private @dvd3() -> !fir.type<derived3{f:f32}>
 // CHECK-LABEL: func private @dvd4() -> !fir.type<derived4(p:i8){f:f32}>
 // CHECK-LABEL: func private @dvd5() -> !fir.type<derived5(p1:i8,p2:i8,p3:i8,p4:i8,p5:i8){f1:f32,f2:f32,f3:f32,f4:f32,f5:f32,f6:f32,f7:f32,f8:f32}>
 // CHECK-LABEL: func private @dvd6() -> !fir.type<derived6{f:!fir.ptr<!fir.type<derived6>>}>

 // CHECK-LABEL: func private @box5() -> !fir.box<!fir.type<derived3{f:f32}>>
 func private @box1() -> !fir.box<!fir.array<?xf32>>
 func private @box2() -> !fir.boxchar<2>
 func private @box3() -> !fir.boxproc<(i32, i32) -> i64>
 func private @box4() -> !fir.box<none>
 func private @box5() -> !fir.box<!fir.type<derived3{f:f32}>>
 
 // FIR misc. types
-// CHECK-LABEL: func private @oth1() -> !fir.dims<1>
+// CHECK-LABEL: func private @oth1() -> !fir.shape<1>
 // CHECK-LABEL: func private @oth2() -> !fir.field
 // CHECK-LABEL: func private @oth3() -> !fir.tdesc<!fir.type<derived7{f1:f32,f2:f32}>>
-// CHECK-LABEL: func private @oth4() -> !fir.dims<15>
-func private @oth1() -> !fir.dims<1>
+// CHECK-LABEL: func private @oth4() -> !fir.shapeshift<15>
+// CHECK-LABEL: func private @oth5() -> !fir.slice<8>
+func private @oth1() -> !fir.shape<1>
 func private @oth2() -> !fir.field
 func private @oth3() -> !fir.tdesc<!fir.type<derived7{f1:f32,f2:f32}>>
-func private @oth4() -> !fir.dims<15>
+func private @oth4() -> !fir.shapeshift<15>
+func private @oth5() -> !fir.slice<8>

flang/tools/tco/tco.cpp

if (std::error_code EC = fileOrErr.getError()) {
     errs() << "Could not open file: " << EC.message() << '\n';
     return 1;
   }
 
   // load the file into a module
   SourceMgr sourceMgr;
   sourceMgr.AddNewSourceBuffer(std::move(*fileOrErr), SMLoc());
   mlir::MLIRContext context;
-  fir::registerFIRDialects(context.getDialectRegistry());
   auto owningRef = mlir::parseSourceFile(sourceMgr, &context);
 
   if (!owningRef) {
     errs() << "Error can't load file " << inputFilename << '\n';
     return 2;
   }
   if (mlir::failed(owningRef->verify())) {
     errs() << "Error verifying FIR module\n";