[fir] Add array value copy pass

[clementval]

Summary

This patch upstream the array value copy pass.

Transform the set of array value primitives to a memory-based array
representation.

The Ops array_load, array_store, array_fetch, and array_update are
used to manage abstract aggregate array values. A simple analysis is done
to determine if there are potential dependences between these operations.
If not, these array operations can be lowered to work directly on the memory
representation. If there is a potential conflict, a temporary is created
along with appropriate copy-in/copy-out operations. Here, a more refined
analysis might be deployed, such as using the affine framework.

This pass is required before code gen to the LLVM IR dialect.

This patch is part of the upstreaming effort from fir-dev branch. The
pass is bringing quite a lot of file with it.

Co-authored-by: Jean Perier <[e-mail]>
Co-authored-by: Eric Schweitz <[e-mail]>
Co-authored-by: V Donaldson <[e-mail]>

[mehdi_amini]

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

553

This condition does not seem tested

584

This case seems untested.

598

I can delete the 4 lines above (the if and its body) and the test still passes

618

This condition doesn't seem tested

619

This condition doesn't seem tested.

636

Actually this entire method isn't covered by the test

662

The reverse can be deleted here and the test still pass.

[clementval]

In D111337#3089322, @mehdi_amini wrote:

I took a few minutes to evaluate more precisely the level of testing, see inline: we're very far from covering our bases here (and this is far from exhaustive!).

I would suggest going back to first principles in terms of testing and building some solid and minimal tests for the passes you're trying to upstream.
I know you're not necessarily the author of the passes, and I suggest to involve the author(s) of the code ahead of time to improve the testing before attempting to upstream all of this.

I agree with you that this test does not cover 100% of the pass. We have more extensive tests but they cannot be upstream right now since they are using another tool not upstreamed yet. This is the problem with upstreaming small chunk. Of course I'm trying to add tests where I can but this one can have some more. I'll rework on this patch and add more fir to fir tests.

[mehdi_amini]

We have more extensive tests but they cannot be upstream right now since they are using another tool not upstreamed yet. This is the problem with upstreaming small chunk.

I'm not really sure what "other tool" is supposed to provide the basic coverage for testing a pass? In general it is "IR in, IR out" just like the test here.

I'm wary by the view that the issue is with the "small chunk" while on the contrary, the "small chunk" is working exactly as intended here: it points as fairly important testing issues for example.

[clementval]

Add more extensive tests in flang/test/Fir/array-value-copy.fir

flang/test/Fir/array-modify.fir has been merged with the new
test file.

Remove some code in the pass that cannot be tested now with
the current upstreaming state.

[clementval]

The latest update to this patch add a new flang/test/Fir/array-value-copy.fir file that cover the array-value-copy in more details.

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

553

Test added in flang/test/Fir/array-value-copy.fir cover this part as well.

584

Test added in flang/test/Fir/array-value-copy.fir cover this code.

598

The test added in flang/test/Fir/array-value-copy.fir that uses array of derived types is covering this part of the code.

618

This will require fir.array_acccess/fir.array_amend to be tested correctly with character arrays. Remove it from this upstreaming patch for now.

619

This will require fir.array_acccess/fir.array_amend to be tested correctly with character arrays. Remove it from this upstreaming patch for now.

636

This will require fir.array_acccess/fir.array_amend to be tested correctly with character arrays. Remove it from this upstreaming patch for now.

662

The test with multidimensional array added in flang/test/Fir/array-value-copy.fir make sure the reverse indices is tested correctly.

834

This cannot be tested currently with what is upstreamed. Remove it for the moment.

861

Test covering fir.array_update conversion have been added in flang/test/Fir/array-value-copy.fir.

[clementval]

@mehdi_amini Can we move on with this one now that we have better test coverage?

[mehdi_amini]

Testing is better now, thanks!
I haven't seen a follow up on https://reviews.llvm.org/D111288#inline-1071935 ; but this is a recurring issue that affects this revision as well.

[clementval]

In D111337#3100539, @mehdi_amini wrote:

Testing is better now, thanks!
I haven't seen a follow up on https://reviews.llvm.org/D111288#inline-1071935 ; but this is a recurring issue that affects this revision as well.

I replied on D111288 about the next steps for auto. I'll update this patch where it makes sense.

[clementval]

Replace some auto occurences + rebase

[clementval]

In D111337#3100539, @mehdi_amini wrote:

Testing is better now, thanks!
I haven't seen a follow up on https://reviews.llvm.org/D111288#inline-1071935 ; but this is a recurring issue that affects this revision as well.

@mehdi_amini I have updated this patch and removed some auto occurrences. As mentioned we will post soon a small guideline for Flang doc that precise that we are using the MLIR style in folder related to MLIR (Optimizer, Lower) and precise how we use auto. Don't worry it is not a "use auto everywhere" but rather a clarification of the LLVM guidelines that is somewhat open. I have looked through the MLIR codebase and I think we are pretty much on par with the use of auto.
I hope we can move forward with this patch now.

[mehdi_amini]

Thanks for the update, the size makes it tractable now, and the test helps to figure out the corner cases when the code isn't straightforward.

I mostly looked at ArrayCopyAnalysis here.

One thing that can be problematic for future patches: the control flow in general should be handled with the ControlFlowInterface which may not be yet implemented on the relevant FIR ops. But that had a significant impact on the code inside the passes, so likely something to consider prioritizing downstream.

flang/include/flang/Optimizer/Builder/FIRBuilder.h

413

Is there a use for this method? (same for the other above)

418

No definition added for this declaration?

468

Is this method used somewhere? (Same for the two above)

flang/include/flang/Optimizer/Transforms/Factory.h

146

Do you know why this is returning a vector instead of an OperandRange? (this is a question for the ShapeOp definition).

It seems strange to force copy on all the accessors when they may just want to iterate on the Values...

flang/include/flang/Optimizer/Transforms/Passes.td

95

Can you just let me know what fails if you remove any of these?

flang/lib/Optimizer/Builder/FIRBuilder.cpp

289

Why the commented out code? Can it just be removed?

315–459

Is this method used?

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

90

I don't understand this comment (I read it 4 times though).

Edit: the comment on the implementation is actually much more clear:

/// Find all the array operations that access the array value that is loaded by
/// the array load operation, `load`.

109

A comment around the constructor (or the member variable definition) would be helpful to say:

If provided, the `loopRegion` is the body of a loop that produces the array of interest.

(or something like that)

117

121

I am very concerned about a recursive algorithm on def-use chain: this is a ticking bomb for a stack overflow in the compiler.
Can you make this an iterative algorithm with an explicit stack?

147

(here and elsewhere)

156

Of all the if above, only the DoLoopOp seems tested. There are some specific cases for the treatment of EmboxOp and ArrayMergeStoreOp that likely should be covered

230

This is the only method actually accessed outside of the class, can you make sure it is the only one in the public section?

Everything else could be private (constructor included)

235

Should this also support other kind of loops? (if so add a TODO)

251

Isn't this whole function isAncestor?

return loopRegion->isAncestor(op->getParentRegion());

Edit: actually, loopRegion may be null here but it isn't obvious from the class invariant. So instead:

return loopRegion && loopRegion->isAncestor(op->getParentRegion());

260

261

Same recursion issue here.

278

279

290

303

304

305

I don't understand how this can happen: an OpOperand does not have a lifetime outside of its owner operation IIRC

309

Make the type explicit (you're doing arithmetic arg - 1 on the next line, I shouldn't have to think about the impact of signedness here)

310

The finalValue() check here is also another case not covered in the test.

finalValue isn't documented in ODS and initArgs isn't documented either, it'd be great if this could be addressed (separately from this revision of course)

310

315

316–320

This loop isn't great when you already have everything to compute offsets.

In general all the special casing for the Loop, branches, and the control flow in general should be handled with the ControlFlowInterface: https://github.com/llvm/llvm-project/blob/main/mlir/include/mlir/Interfaces/ControlFlowInterfaces.td

This would make the code entirely uniform, and any new op that has to do with the control flow would not require to modify the pass.

I'm fine if you want to handle this later for this pass (please add a big // TODO: this need to be updated to use the control-flow interface), but I'm not sure we should upstream many other passes that would be implemented without going through interfaces.

329–330

361

Seems like we're storing much more than what we need actually, I tried locally to change loadMapSets to store the SmallVector of "accesses" and it is just enough (and it makes subsequent call even easier).

Here is a patch: https://gist.github.com/joker-eph/8f00e79783688bf6349b6b5d9d44a480

372

This is a complex body, worth using braces here

373

In general, early continue reduces indentation:

374–376

If this is a pattern that repeats, it'll be worth having a helper (potentially a method on ArrayLoadOp : Type getUnboxedLoadedType() or something like that)

390

This would be worth a comment I think

417

Seems like this should be an assert

419–422

SmallVector has an operator==, is this different?

439–443

Isn't this entire loop nest + recursion just a walk?

Also, I'd change the signature of the construct method to be:
void ArrayCopyAnalysis::construct(Operation *topLevelOp) {

So that you can just write topLevelOp->walk([&] (Operation *op) {

(the only reason for the current signature was the recursion as far as I can tell)

440

Non trivial nesting should use braces ( https://llvm.org/docs/CodingStandards.html#don-t-use-braces-on-simple-single-statement-bodies-of-if-else-loop-statements )

445

It may be worth moving all the temporary storage outside of the walk, and then just calling .clear() before using them here (which is already done inside arrayAccesses() by the way, even though it is for nothing right now). That way they would "grow" only once and the memory can be reused over and over.

449

Where is the guarantee that this cast will always succeed coming from?
The doc for ArrayMergeStoreOp does not mention anything, and there is no verifier for ArrayMergeStoreOp

469

Can this check fail? Right now the contract of arrayAccesses() is to only return these three operations, and conflictOnMerge would fail if there were any other op.
Can this be replace with an assert here?

470

Same (I think) but with a single map lookup if (!useMap.insert({acc, &op}).second) {

475

Seems like this should signal an error? Is this conservative to just "continue" here?

660

In general, use llvm::function_ref instead of std::function when you don't take ownership (this avoid potential heap allocation and copies)

663

Alternatively: auto loadOp = mlir::cast<ArrayLoadOp>(useMap.lookup(op)); and use loadOp everywhere instead of having load and loadOp

674

681

700

795

824

(typo)

[clementval]

In D111337#3105093, @mehdi_amini wrote:

Thanks for the update, the size makes it tractable now, and the test helps to figure out the corner cases when the code isn't straightforward.

I mostly looked at ArrayCopyAnalysis here.

One thing that can be problematic for future patches: the control flow in general should be handled with the ControlFlowInterface which may not be yet implemented on the relevant FIR ops. But that had a significant impact on the code inside the passes, so likely something to consider prioritizing downstream.

Tried to address most of the comments. I think we will need couple of follow up patches to make it easier to move foward (and sync back in between).

flang/include/flang/Optimizer/Builder/FIRBuilder.h

413

This one is not used currently (removed from this patch). The one above is.

418

Mistake of the rebase. It's the same as the one just above. Removed.

flang/include/flang/Optimizer/Transforms/Factory.h

146

I don't think there is a good reason for this. Will add a TODO so we can address this in a follow up patch since it touches the op definiton and probably other places in the code.

flang/include/flang/Optimizer/Transforms/Passes.td

95

These were artifact from the time it didn't work without it. Looks like it is now fine to remove them.

flang/lib/Optimizer/Builder/FIRBuilder.cpp

289

Yeah will be added later anyway.

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

90

Updated.

121

Would it be ok to address this in a follow up patch? I just added a todo right now.

316–320

I think it is better to handle this later (switch to control flow interface) as it will bring lots of changes with it.

361

Thanks for the patch. look like it does the trick.

439–443

Thanks for the inputs here. Replace by a simple walk.

449

ArrayMergeStoreOp verifier has this:

if (!isa<ArrayLoadOp>(op.original().getDefiningOp()))
    return op.emitOpError("operand #0 must be result of a fir.array_load op");

824

Thanks.

[clementval]

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

156

Added some test and removed the IterWhileOp and EmboxOp special case since they will be added later when we can add better test coverage.

235

From a practical point of view, array operations are normally generated with DoLoopOp so there is no real code that need the other loops. From a purely FIR point of view, of course someone could write some IterWhileOp with array operations but we do not have use cases in mind for that.
I added a comment to make precise this in the code.

261

Same here. Would be great if we can address that in a follow up patch directly after finishing this one.

310

They are loops with finalValue and iterArgs in the tests. Will add the documentation in another path. Added on my todo list.

[mehdi_amini]

I think you haven't updated the revision yet.

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

121

How to we track that this get addressed though? I'm wary of TODO that will stay here for a while.
Is someone gonna commit to work on this ASAP?

[clementval]

Address various review comments + rebase

[clementval]

In D111337#3147981, @mehdi_amini wrote:

I think you haven't updated the revision yet.

Sorry, it was stuck on the arc lint phase :(

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

121

I can work on that in the next 2-3 weeks probably.

[mehdi_amini]

Looks fine overall, thanks!

There are still a few minor issues: dead code in particular, but also the code documentation is a bit on the light side for something that really does not seem trivial to me.
(+ some inline comments)

flang/include/flang/Optimizer/Builder/FIRBuilder.h

67

Seems unused in this patch?

356

Unused in this patch?

449

This is unused in this patch?

460

Same

469

Unused as well (and undocumented)

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

360

Can you document all this macro system?
Does it need to in header? In general macros defined in header is "dangerous", should these be prefixed with Fir or something?

364

You could add this in the function body if this is really needed, or what do I misse?

flang/include/flang/Optimizer/Transforms/Factory.h

45

This method isn't used anywhere either

148

I don't see a call-site for this either

191–193

Move this assert with the one a few lines above? They seem related.
Using the assert(!shapeVal || form like above you can avoid the if and the nesting

254

The createLoopNest functions seem unused as well

flang/lib/Optimizer/Builder/FIRBuilder.cpp

317

323

Seems like there should be a llvm_unreachable after this error is emitted

325

I don't quite find what the .match( call resolves to on the fir::ExtendedValue class? Any tip?

327

(same below)

352

Can you comment on what this is supposed to match?

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

356

not sure if it is a Value here?

454–463

I commented on this before I believe: you have two map lookup when one would be enough I think:

469

You marked it done, but I don't see it done in the code.

645

672

(previous use of useMap.lookup() in this function spelled out the type)

717

This branch may be worth a comment.

In general the entire pattern is a bit light on documentation.

731

You can reduce the indentation in the code by inverting the else and the then branch:

if (!inEleTy.isa<fir::RecordType>())
   llvm::report_fatal_error("not a legal reference type");

Also, I'm not sure why it isn't an assertion here? If this can't be then shouldn't we degrade more gracefully?

assert(inEleTy.isa<fir::RecordType>());

[kiranchandramohan]

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

121

I have created an issue to capture this in the upstreaming FIR Passes board.
https://github.com/flang-compiler/f18-llvm-project/projects/7
https://github.com/flang-compiler/f18-llvm-project/issues/1268

@clementval if this is just about converting to an iterative version then we can help.

[clementval]

Address review comments

flang/lib/Optimizer/Builder/FIRBuilder.cpp

325

https://github.com/llvm/llvm-project/blob/102d2a8a99057b2f54ca97661f862e33d055171a/flang/include/flang/Optimizer/Builder/BoxValue.h#L406

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

121

Yeah this is it. With all the changes (compare to fir-dev) in this patch it would be nice to be able to make a sync before this kind of refactoring.

454–463

Yeah sorry I thought I made the update. Must have been lost in an other branch.

645

Sorry missed this update as well. It's updated.

717

ArrayUpdateOp is actually not supported for reference type anymore since there is a new op for it. This code is removed.

731

Replaced with an assert and remove the if-else

[mehdi_amini]

@kiranchandramohan do you plan on reviewing/approving the current version of the patch?

I don't have any more comment than before, there are just a few that are still pending.

flang/include/flang/Optimizer/Builder/FIRBuilder.h

449

Missed this one?

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

360

Marked done, but I don't see a change here?

flang/lib/Optimizer/Builder/FIRBuilder.cpp

30

This is marked done, but you actually extracted it as-is and landed it in https://reviews.llvm.org/D112057 ; can you address that as well (in a separate patch, but I'm wary of losing track of this).

46

Same here: you marked it done without commenting and landed it separately.

325

Thanks!

Something really confusing is that there is another class with the same name, and located in a header with the same filename!
(in include/flang/Lower/Support/BoxValue.h)

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

469

Yet again
(line 452 by now)

[clementval]

Address missed comments

[clementval]

flang/include/flang/Optimizer/Builder/FIRBuilder.h

449

My bad. I thought I removed it.

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

360

No idea why it was mark done since I don't even remember reading this one. I have added some comments and prefixed the macros. I kept mkRTKey without prefix since it is used outside.

flang/lib/Optimizer/Builder/FIRBuilder.cpp

30

Sorry, I marked it as done here to be able to navigate more easily in the comments since it was not part of this part anymore. I'll look at it in another patch.

46

Is this really important? If so I'll update it.

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

469

My bad. I'm sure I made the change but I probably mixed up my branches and it was not in this update. Updated now.

[clementval]

flang/lib/Optimizer/Builder/FIRBuilder.cpp

30

Patch here: https://reviews.llvm.org/D114630

[kiranchandramohan]

In D111337#3154805, @mehdi_amini wrote:

@kiranchandramohan do you plan on reviewing/approving the current version of the patch?

I don't have any more comment than before, there are just a few that are still pending.

The patch LGTM. Thanks for going through the patch in detail and pointing out various issues. And thanks to @clementval for addressing most of the issues. I agree that the remaining issues can be dealt with later. I have created a few github issues to follow up on later work.

Nit: The changes in the following files are in other patches or have been merged. How are you planning to handle this?
flang/lib/Optimizer/Dialect/FIRType.cpp
flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
flang/include/flang/Optimizer/Builder/Runtime/Assign.h
flang/lib/Optimizer/Builder/Runtime/Assign.cpp

flang/lib/Optimizer/Builder/FIRBuilder.cpp

30

Raised an issue for this https://github.com/flang-compiler/f18-llvm-project/issues/1273

46

Might be easier to read for newcomers.

325

I think there is some refactoring going on, where code in Lower is moved to the Optimizer/Builder directory. I think once all the code is moved the code in Lower can be deleted.

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

121

OK. I have moved this to the post-upstream board.

310

Raised https://github.com/flang-compiler/f18-llvm-project/issues/1274

316–320

Raised https://github.com/flang-compiler/f18-llvm-project/issues/1275 to look into this later.

[clementval]

In D111337#3155551, @kiranchandramohan wrote:

In D111337#3154805, @mehdi_amini wrote:

@kiranchandramohan do you plan on reviewing/approving the current version of the patch?

I don't have any more comment than before, there are just a few that are still pending.

The patch LGTM. Thanks for going through the patch in detail and pointing out various issues. And thanks to @clementval for addressing most of the issues. I agree that the remaining issues can be dealt with later. I have created a few github issues to follow up on later work.

Nit: The changes in the following files are in other patches or have been merged. How are you planning to handle this?
flang/lib/Optimizer/Dialect/FIRType.cpp
flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
flang/include/flang/Optimizer/Builder/Runtime/Assign.h
flang/lib/Optimizer/Builder/Runtime/Assign.cpp

@kiranchandramohan I'm just gonna rebase on main since some of the patch have landed and I'll merge in the change requested from this review.

[clementval]

Rebase

[clementval]

@kiranchandramohan I just did a rebase. Let me know if it is still ok for you.

[mehdi_amini]

flang/include/flang/Optimizer/Builder/FIRBuilder.h

25

Can you double check that these are needed in this header? It's not clear from the change in this file

[clementval]

Remove extra headers

[clementval]

flang/include/flang/Optimizer/Builder/FIRBuilder.h

25

Removed

[kiranchandramohan]

LGTM.

flang/lib/Optimizer/Builder/FIRBuilder.cpp

118

Nit: Is this change necessary?

[clementval]

Revert useless change

flang/include/flang/Optimizer/Builder/FIRBuilder.h

 #ifndef FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H
 #define FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H
 
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Optimizer/Support/KindMapping.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinOps.h"
+#include "llvm/ADT/DenseMap.h"
+#include "llvm/ADT/Optional.h"
 
 namespace fir {
 class ExtendedValue;
+class AbstractArrayBox;
+class ExtendedValue;
+class BoxValue;
 
 //===----------------------------------------------------------------------===//
 // FirOpBuilder
 //===----------------------------------------------------------------------===//
 
 /// Extends the MLIR OpBuilder to provide methods for building common FIR
 /// patterns.
 class FirOpBuilder : public mlir::OpBuilder {
public:
   /// Get the current Function
   mlir::FuncOp getFunction() {
     return getRegion().getParentOfType<mlir::FuncOp>();
   }
 
   /// Get a reference to the kind map.
   const fir::KindMapping &getKindMap() { return kindMap; }
 
+  /// The LHS and RHS are not always in agreement in terms of
+  /// type. In some cases, the disagreement is between COMPLEX and other scalar
+  /// types. In that case, the conversion must insert/extract out of a COMPLEX
+  /// value to have the proper semantics and be strongly typed.
+  mlir::Value convertWithSemantics(mlir::Location loc, mlir::Type toTy,
+                                   mlir::Value val);
+
   /// Get the entry block of the current Function
   mlir::Block *getEntryBlock() { return &getFunction().front(); }
 
   /// Get the block for adding Allocas. If OpenMP is enabled then get the
   /// the alloca block from an Operation which can be Outlined. Otherwise
   /// use the entry block of the current Function
   mlir::Block *getAllocaBlock();
 
public:
   mlir::StringAttr createCommonLinkage() { return getStringAttr("common"); }
 
   mlir::StringAttr createInternalLinkage() { return getStringAttr("internal"); }
 
   mlir::StringAttr createLinkOnceLinkage() { return getStringAttr("linkonce"); }
 
   mlir::StringAttr createWeakLinkage() { return getStringAttr("weak"); }
 
-  /// Cast the input value to IndexType.
-  mlir::Value convertToIndexType(mlir::Location loc, mlir::Value val) {
-    return createConvert(loc, getIndexType(), val);
-  }
-
   /// Get a function by name. If the function exists in the current module, it
   /// is returned. Otherwise, a null FuncOp is returned.
   mlir::FuncOp getNamedFunction(llvm::StringRef name) {
     return getNamedFunction(getModule(), name);
   }
 
   static mlir::FuncOp getNamedFunction(mlir::ModuleOp module,
                                        llvm::StringRef name);
static mlir::FuncOp addNamedFunction(mlir::Location loc,
                                        mlir::ModuleOp module,
                                        llvm::StringRef name,
                                        mlir::FunctionType ty) {
     if (auto func = getNamedFunction(module, name))
       return func;
     return createFunction(loc, module, name, ty);
   }
 
+  /// Cast the input value to IndexType.
+  mlir::Value convertToIndexType(mlir::Location loc, mlir::Value val) {
+    return createConvert(loc, getIndexType(), val);
+  }
+
+  /// Construct one of the two forms of shape op from an array box.
+  mlir::Value genShape(mlir::Location loc, const fir::AbstractArrayBox &arr);
+  mlir::Value genShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> shift,
+                       llvm::ArrayRef<mlir::Value> exts);
+  mlir::Value genShape(mlir::Location loc, llvm::ArrayRef<mlir::Value> exts);
+
+  /// Create one of the shape ops given an extended value. For a boxed value,
+  /// this may create a `fir.shift` op.
+  mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv);
+
+  /// Create a slice op extended value. The value to be sliced, `exv`, must be
+  /// an array.
+  mlir::Value createSlice(mlir::Location loc, const fir::ExtendedValue &exv,
+                          mlir::ValueRange triples, mlir::ValueRange path);
+
+  /// Create a boxed value (Fortran descriptor) to be passed to the runtime.
+  /// \p exv is an extended value holding a memory reference to the object that
+  /// must be boxed. This function will crash if provided something that is not
+  /// a memory reference type.
+  /// Array entities are boxed with a shape and character with their length.
+  mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv);
+
   /// Create constant i1 with value 1. if \p b is true or 0. otherwise
   mlir::Value createBool(mlir::Location loc, bool b) {
     return createIntegerConstant(loc, getIntegerType(1), b ? 1 : 0);
   }
 
   //===--------------------------------------------------------------------===//
   // If-Then-Else generation helper
   //===--------------------------------------------------------------------===//
public:
   }
 
   /// Generate code testing \p addr is not a null address.
   mlir::Value genIsNotNull(mlir::Location loc, mlir::Value addr);
 
   /// Generate code testing \p addr is a null address.
   mlir::Value genIsNull(mlir::Location loc, mlir::Value addr);
 
+  /// Compute the extent of (lb:ub:step) as max((ub-lb+step)/step, 0). See
+  /// Fortran 2018 9.5.3.3.2 section for more details.
+  mlir::Value genExtentFromTriplet(mlir::Location loc, mlir::Value lb,
+                                   mlir::Value ub, mlir::Value step,
+                                   mlir::Type type);
+
 private:
   const KindMapping &kindMap;
 };
 
 } // namespace fir
 
 namespace fir::factory {
 
 //===----------------------------------------------------------------------===//
+// ExtendedValue inquiry helpers
+//===----------------------------------------------------------------------===//
+
+/// Read or get character length from \p box that must contain a character
+/// entity. If the length value is contained in the ExtendedValue, this will
+/// not generate any code, otherwise this will generate a read of the fir.box
+/// describing the entity.
+mlir::Value readCharLen(fir::FirOpBuilder &builder, mlir::Location loc,
+                        const fir::ExtendedValue &box);
+
+/// Read or get the extent in dimension \p dim of the array described by \p box.
+mlir::Value readExtent(fir::FirOpBuilder &builder, mlir::Location loc,
+                       const fir::ExtendedValue &box, unsigned dim);
+
+/// Read or get the lower bound in dimension \p dim of the array described by
+/// \p box. If the lower bound is left default in the ExtendedValue,
+/// \p defaultValue will be returned.
+mlir::Value readLowerBound(fir::FirOpBuilder &builder, mlir::Location loc,
+                           const fir::ExtendedValue &box, unsigned dim,
+                           mlir::Value defaultValue);
+
+/// Read extents from \p box.
+llvm::SmallVector<mlir::Value> readExtents(fir::FirOpBuilder &builder,
+                                           mlir::Location loc,
+                                           const fir::BoxValue &box);
+
+/// Get extents from \p box. For fir::BoxValue and
+/// fir::MutableBoxValue, this will generate code to read the extents.
+llvm::SmallVector<mlir::Value> getExtents(fir::FirOpBuilder &builder,
+                                          mlir::Location loc,
+                                          const fir::ExtendedValue &box);
+
+/// Read a fir::BoxValue into an fir::UnboxValue, a fir::ArrayBoxValue or a
+/// fir::CharArrayBoxValue. This should only be called if the fir::BoxValue is
+/// known to be contiguous given the context (or if the resulting address will
+/// not be used). If the value is polymorphic, its dynamic type will be lost.
+/// This must not be used on unlimited polymorphic and assumed rank entities.
+fir::ExtendedValue readBoxValue(fir::FirOpBuilder &builder, mlir::Location loc,
+                                const fir::BoxValue &box);
+
+//===----------------------------------------------------------------------===//
 // String literal helper helpers
 //===----------------------------------------------------------------------===//
 
 /// Create a !fir.char<1> string literal global and returns a
 /// fir::CharBoxValue with its address and length.
 fir::ExtendedValue createStringLiteral(fir::FirOpBuilder &, mlir::Location,
                                        llvm::StringRef string);
 
+/// Create a !fir.char<1> string literal global and returns a
+/// fir::CharBoxValue with its address en length.
+fir::ExtendedValue createStringLiteral(fir::FirOpBuilder &, mlir::Location,
+                                       llvm::StringRef string);
+
 /// Unique a compiler generated identifier. A short prefix should be provided
 /// to hint at the origin of the identifier.
 std::string uniqueCGIdent(llvm::StringRef prefix, llvm::StringRef name);
 
-//===----------------------------------------------------------------------===//
+/// Lowers the extents from the sequence type to Values.
+/// Any unknown extents are lowered to undefined values.
+llvm::SmallVector<mlir::Value> createExtents(fir::FirOpBuilder &builder,
+                                             mlir::Location loc,
+                                             fir::SequenceType seqTy);
+
+//===--------------------------------------------------------------------===//
 // Location helpers
-//===----------------------------------------------------------------------===//
+//===--------------------------------------------------------------------===//
 
 /// Generate a string literal containing the file name and return its address
 mlir::Value locationToFilename(fir::FirOpBuilder &, mlir::Location);
 
 /// Generate a constant of the given type with the location line number
 mlir::Value locationToLineNo(fir::FirOpBuilder &, mlir::Location, mlir::Type);
 
+//===--------------------------------------------------------------------===//
+// ExtendedValue helpers
+//===--------------------------------------------------------------------===//
+
+/// Return the extended value for a component of a derived type instance given
+/// the extended value \p obj of the derived type instance and the address of
+/// the component.
+fir::ExtendedValue componentToExtendedValue(fir::FirOpBuilder &builder,
+                                            mlir::Location loc,
+                                            mlir::Value component);
+
+/// Given the address of an array element and the ExtendedValue describing the
+/// array, returns the ExtendedValue describing the array element. The purpose
+/// is to propagate the length parameters of the array to the element.
+/// This can be used for elements of `array` or `array(i:j:k)`. If \p element
+/// belongs to an array section `array%x` whose base is \p array,
+/// arraySectionElementToExtendedValue must be used instead.
+fir::ExtendedValue arrayElementToExtendedValue(fir::FirOpBuilder &builder,
+                                               mlir::Location loc,
+                                               const fir::ExtendedValue &array,
+                                               mlir::Value element);
+
+/// Build the ExtendedValue for \p element that is an element of an array or
+/// array section with \p array base (`array` or `array(i:j:k)%x%y`).
+/// If it is an array section, \p slice must be provided and be a fir::SliceOp
+/// that describes the section.
+fir::ExtendedValue arraySectionElementToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice);
+
+/// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalar derived
+/// types. The assignment follows Fortran intrinsic assignment semantic for
+/// derived types (10.2.1.3 point 13).
+void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
+                         const fir::ExtendedValue &lhs,
+                         const fir::ExtendedValue &rhs);
+
+mlir::TupleType getRaggedArrayHeaderType(fir::FirOpBuilder &builder);
+
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H

flang/include/flang/Optimizer/Builder/MutableBox.h

+//===-- MutableBox.h -- MutableBox utilities  -----------------------------===//
+//
+// 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 FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H
+#define FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H
+
+#include "llvm/ADT/StringRef.h"
+
+namespace mlir {
+class Value;
+class ValueRange;
+class Type;
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+class MutableBoxValue;
+class ExtendedValue;
+} // namespace fir
+
+namespace fir::factory {
+
+/// Create a fir.box of type \p boxType that can be used to initialize an
+/// allocatable variable. Initialization of such variable has to be done at the
+/// beginning of the variable lifetime by storing the created box in the memory
+/// for the variable box.
+/// \p nonDeferredParams must provide the non deferred length parameters so that
+/// they can already be placed in the unallocated box (inquiries about these
+/// parameters are legal even in unallocated state).
+mlir::Value createUnallocatedBox(fir::FirOpBuilder &builder, mlir::Location loc,
+                                 mlir::Type boxType,
+                                 mlir::ValueRange nonDeferredParams);
+
+/// Create a MutableBoxValue for a temporary allocatable.
+/// The created MutableBoxValue wraps a fir.ref<fir.box<fir.heap<type>>> and is
+/// initialized to unallocated/diassociated status. An optional name can be
+/// given to the created !fir.ref<fir.box>.
+fir::MutableBoxValue createTempMutableBox(fir::FirOpBuilder &builder,
+                                          mlir::Location loc, mlir::Type type,
+                                          llvm::StringRef name = {});
+
+/// Update a MutableBoxValue to describe entity \p source (that must be in
+/// memory). If \lbounds is not empty, it is used to defined the MutableBoxValue
+/// lower bounds, otherwise, the lower bounds from \p source are used.
+void associateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc,
+                         const fir::MutableBoxValue &box,
+                         const fir::ExtendedValue &source,
+                         mlir::ValueRange lbounds);
+
+/// Update a MutableBoxValue to describe entity \p source (that must be in
+/// memory) with a new array layout given by \p lbounds and \p ubounds.
+/// \p source must be known to be contiguous at compile time, or it must have
+/// rank 1 (constraint from Fortran 2018 standard 10.2.2.3 point 9).
+void associateMutableBoxWithRemap(fir::FirOpBuilder &builder,
+                                  mlir::Location loc,
+                                  const fir::MutableBoxValue &box,
+                                  const fir::ExtendedValue &source,
+                                  mlir::ValueRange lbounds,
+                                  mlir::ValueRange ubounds);
+
+/// Set the association status of a MutableBoxValue to
+/// disassociated/unallocated. Nothing is done with the entity that was
+/// previously associated/allocated. The function generates code that sets the
+/// address field of the MutableBoxValue to zero.
+void disassociateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc,
+                            const fir::MutableBoxValue &box);
+
+/// Generate code to conditionally reallocate a MutableBoxValue with a new
+/// shape, lower bounds, and length parameters if it is unallocated or if its
+/// current shape or deferred  length parameters do not match the provided ones.
+/// Lower bounds are only used if the entity needs to be allocated, otherwise,
+/// the MutableBoxValue will keep its current lower bounds.
+/// If the MutableBoxValue is an array, the provided shape can be empty, in
+/// which case the MutableBoxValue must already be allocated at runtime and its
+/// shape and lower bounds will be kept. If \p shape is empty, only a length
+/// parameter mismatch can trigger a reallocation. See Fortran 10.2.1.3 point 3
+/// that this function is implementing for more details. The polymorphic
+/// requirements are not yet covered by this function.
+void genReallocIfNeeded(fir::FirOpBuilder &builder, mlir::Location loc,
+                        const fir::MutableBoxValue &box,
+                        mlir::ValueRange lbounds, mlir::ValueRange shape,
+                        mlir::ValueRange lengthParams);
+
+/// Finalize a mutable box if it is allocated or associated. This includes both
+/// calling the finalizer, if any, and deallocating the storage.
+void genFinalization(fir::FirOpBuilder &builder, mlir::Location loc,
+                     const fir::MutableBoxValue &box);
+
+void genInlinedAllocation(fir::FirOpBuilder &builder, mlir::Location loc,
+                          const fir::MutableBoxValue &box,
+                          mlir::ValueRange lbounds, mlir::ValueRange extents,
+                          mlir::ValueRange lenParams,
+                          llvm::StringRef allocName);
+
+void genInlinedDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
+                          const fir::MutableBoxValue &box);
+
+/// When the MutableBoxValue was passed as a fir.ref<fir.box> to a call that may
+/// have modified it, update the MutableBoxValue according to the
+/// fir.ref<fir.box> value.
+void syncMutableBoxFromIRBox(fir::FirOpBuilder &builder, mlir::Location loc,
+                             const fir::MutableBoxValue &box);
+
+/// Read all mutable properties into a normal symbol box.
+/// It is OK to call this on unassociated/unallocated boxes but any use of the
+/// resulting values will be undefined (only the base address will be guaranteed
+/// to be null).
+fir::ExtendedValue genMutableBoxRead(fir::FirOpBuilder &builder,
+                                     mlir::Location loc,
+                                     const fir::MutableBoxValue &box,
+                                     bool mayBePolymorphic = true);
+
+/// Returns the fir.ref<fir.box<T>> of a MutableBoxValue filled with the current
+/// association / allocation properties. If the fir.ref<fir.box> already exists
+/// and is-up to date, this is a no-op, otherwise, code will be generated to
+/// fill the it.
+mlir::Value getMutableIRBox(fir::FirOpBuilder &builder, mlir::Location loc,
+                            const fir::MutableBoxValue &box);
+
+/// Generate allocation or association status test and returns the resulting
+/// i1. This is testing this for a valid/non-null base address value.
+mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
+                                           mlir::Location loc,
+                                           const fir::MutableBoxValue &box);
+
+} // namespace fir::factory
+
+#endif // FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H

flang/include/flang/Optimizer/Builder/Runtime/Assign.h

+//===-- Assign.h - generate assignment runtime API calls     ----*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H
+
+namespace mlir {
+class Value;
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+} // namespace fir
+
+namespace fir::runtime {
+
+/// Generate runtime call to assign \p sourceBox to \p destBox.
+/// \p destBox must be a fir.ref<fir.box<T>> and \p sourceBox a fir.box<T>.
+/// \p destBox Fortran descriptor may be modified if destBox is an allocatable
+/// according to Fortran allocatable assignment rules, otherwise it is not
+/// modified.
+void genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
+               mlir::Value destBox, mlir::Value sourceBox);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ASSIGN_H

flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h

+//===-- RTBuilder.h ---------------------------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+///
+/// \file
+/// This file defines some C++17 template classes that are used to convert the
+/// signatures of plain old C functions into a model that can be used to
+/// generate MLIR calls to those functions. This can be used to autogenerate
+/// tables at compiler compile-time to call runtime support code.
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_RTBUILDER_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_RTBUILDER_H
+
+#include "flang/Common/Fortran.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "mlir/IR/BuiltinTypes.h"
+#include "mlir/IR/MLIRContext.h"
+#include "llvm/ADT/SmallVector.h"
+#include <functional>
+
+// Incomplete type indicating C99 complex ABI in interfaces. Beware, _Complex
+// and std::complex are layout compatible, but not compatible in all ABI call
+// interface (e.g. X86 32 bits). _Complex is not standard C++, so do not use
+// it here.
+struct c_float_complex_t;
+struct c_double_complex_t;
+
+namespace Fortran::runtime {
+class Descriptor;
+} // namespace Fortran::runtime
+
+namespace fir::runtime {
+
+using TypeBuilderFunc = mlir::Type (*)(mlir::MLIRContext *);
+using FuncTypeBuilderFunc = mlir::FunctionType (*)(mlir::MLIRContext *);
+
+//===----------------------------------------------------------------------===//
+// Type builder models
+//===----------------------------------------------------------------------===//
+
+// TODO: all usages of sizeof in this file assume build ==  host == target.
+// This will need to be re-visited for cross compilation.
+
+/// Return a function that returns the type signature model for the type `T`
+/// when provided an MLIRContext*. This allows one to translate C(++) function
+/// signatures from runtime header files to MLIR signatures into a static table
+/// at compile-time.
+///
+/// For example, when `T` is `int`, return a function that returns the MLIR
+/// standard type `i32` when `sizeof(int)` is 4.
+template <typename T>
+static constexpr TypeBuilderFunc getModel();
+template <>
+constexpr TypeBuilderFunc getModel<short int>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(short int));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<int>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(int));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<int &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<int>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<char *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::IntegerType::get(context, 8));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const char *>() {
+  return getModel<char *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const char16_t *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::IntegerType::get(context, 16));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const char32_t *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::IntegerType::get(context, 32));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<signed char>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(signed char));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<void *>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::LLVMPointerType::get(mlir::IntegerType::get(context, 8));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<void **>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(
+        fir::LLVMPointerType::get(mlir::IntegerType::get(context, 8)));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<long>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(long));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<long &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<long>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<long *>() {
+  return getModel<long &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<long long>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(std::size_t));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<long long &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<long long>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<long long *>() {
+  return getModel<long long &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned long>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(unsigned long));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned long long>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 8 * sizeof(unsigned long long));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<double>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::FloatType::getF64(context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<double &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<double>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<double *>() {
+  return getModel<double &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<float>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::FloatType::getF32(context);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<float &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<float>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<float *>() {
+  return getModel<float &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<bool>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context, 1);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<bool &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    TypeBuilderFunc f{getModel<bool>()};
+    return fir::ReferenceType::get(f(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<std::complex<float> &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    auto ty = mlir::ComplexType::get(mlir::FloatType::getF32(context));
+    return fir::ReferenceType::get(ty);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<std::complex<double> &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    auto ty = mlir::ComplexType::get(mlir::FloatType::getF64(context));
+    return fir::ReferenceType::get(ty);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<c_float_complex_t>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ComplexType::get(context, sizeof(float));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<c_double_complex_t>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ComplexType::get(context, sizeof(double));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const Fortran::runtime::Descriptor &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::BoxType::get(mlir::NoneType::get(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::runtime::Descriptor &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(
+        fir::BoxType::get(mlir::NoneType::get(context)));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const Fortran::runtime::Descriptor *>() {
+  return getModel<const Fortran::runtime::Descriptor &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::runtime::Descriptor *>() {
+  return getModel<Fortran::runtime::Descriptor &>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::common::TypeCategory>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context,
+                                  sizeof(Fortran::common::TypeCategory) * 8);
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<void>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::NoneType::get(context);
+  };
+}
+
+template <typename...>
+struct RuntimeTableKey;
+template <typename RT, typename... ATs>
+struct RuntimeTableKey<RT(ATs...)> {
+  static constexpr FuncTypeBuilderFunc getTypeModel() {
+    return [](mlir::MLIRContext *ctxt) {
+      TypeBuilderFunc ret = getModel<RT>();
+      std::array<TypeBuilderFunc, sizeof...(ATs)> args = {getModel<ATs>()...};
+      mlir::Type retTy = ret(ctxt);
+      llvm::SmallVector<mlir::Type, sizeof...(ATs)> argTys;
+      for (auto f : args)
+        argTys.push_back(f(ctxt));
+      return mlir::FunctionType::get(ctxt, argTys, {retTy});
+    };
+  }
+};
+
+//===----------------------------------------------------------------------===//
+// Runtime table building (constexpr folded)
+//===----------------------------------------------------------------------===//
+
+template <char... Cs>
+using RuntimeIdentifier = std::integer_sequence<char, Cs...>;
+
+namespace details {
+template <typename T, T... As, T... Bs>
+static constexpr std::integer_sequence<T, As..., Bs...>
+concat(std::integer_sequence<T, As...>, std::integer_sequence<T, Bs...>) {
+  return {};
+}
+template <typename T, T... As, T... Bs, typename... Cs>
+static constexpr auto concat(std::integer_sequence<T, As...>,
+                             std::integer_sequence<T, Bs...>, Cs...) {
+  return concat(std::integer_sequence<T, As..., Bs...>{}, Cs{}...);
+}
+template <typename T>
+static constexpr std::integer_sequence<T> concat(std::integer_sequence<T>) {
+  return {};
+}
+template <typename T, T a>
+static constexpr auto filterZero(std::integer_sequence<T, a>) {
+  if constexpr (a != 0) {
+    return std::integer_sequence<T, a>{};
+  } else {
+    return std::integer_sequence<T>{};
+  }
+}
+template <typename T, T... b>
+static constexpr auto filter(std::integer_sequence<T, b...>) {
+  if constexpr (sizeof...(b) > 0) {
+    return details::concat(filterZero(std::integer_sequence<T, b>{})...);
+  } else {
+    return std::integer_sequence<T>{};
+  }
+}
+} // namespace details
+
+template <typename...>
+struct RuntimeTableEntry;
+template <typename KT, char... Cs>
+struct RuntimeTableEntry<RuntimeTableKey<KT>, RuntimeIdentifier<Cs...>> {
+  static constexpr FuncTypeBuilderFunc getTypeModel() {
+    return RuntimeTableKey<KT>::getTypeModel();
+  }
+  static constexpr const char name[sizeof...(Cs) + 1] = {Cs..., '\0'};
+};
+
+#undef E
+#define E(L, I) (I < sizeof(L) / sizeof(*L) ? L[I] : 0)
+#define QuoteKey(X) #X
+#define ExpandAndQuoteKey(X) QuoteKey(X)
+#define MacroExpandKey(X)                                                      \
+  E(X, 0), E(X, 1), E(X, 2), E(X, 3), E(X, 4), E(X, 5), E(X, 6), E(X, 7),      \
+      E(X, 8), E(X, 9), E(X, 10), E(X, 11), E(X, 12), E(X, 13), E(X, 14),      \
+      E(X, 15), E(X, 16), E(X, 17), E(X, 18), E(X, 19), E(X, 20), E(X, 21),    \
+      E(X, 22), E(X, 23), E(X, 24), E(X, 25), E(X, 26), E(X, 27), E(X, 28),    \
+      E(X, 29), E(X, 30), E(X, 31), E(X, 32), E(X, 33), E(X, 34), E(X, 35),    \
+      E(X, 36), E(X, 37), E(X, 38), E(X, 39), E(X, 40), E(X, 41), E(X, 42),    \
+      E(X, 43), E(X, 44), E(X, 45), E(X, 46), E(X, 47), E(X, 48), E(X, 49)
+#define ExpandKey(X) MacroExpandKey(QuoteKey(X))
+#define FullSeq(X) std::integer_sequence<char, ExpandKey(X)>
+#define AsSequence(X) decltype(fir::runtime::details::filter(FullSeq(X){}))
+#define mkKey(X)                                                               \
+  fir::runtime::RuntimeTableEntry<fir::runtime::RuntimeTableKey<decltype(X)>,  \
+                                  AsSequence(X)>
+#define mkRTKey(X) mkKey(RTNAME(X))
+
+/// Get (or generate) the MLIR FuncOp for a given runtime function. Its template
+/// argument is intended to be of the form: <mkRTKey(runtime function name)>
+/// Clients should add "using namespace Fortran::runtime"
+/// in order to use this function.
+template <typename RuntimeEntry>
+static mlir::FuncOp getRuntimeFunc(mlir::Location loc,
+                                   fir::FirOpBuilder &builder) {
+  auto name = RuntimeEntry::name;
+  auto func = builder.getNamedFunction(name);
+  if (func)
+    return func;
+  auto funTy = RuntimeEntry::getTypeModel()(builder.getContext());
+  func = builder.createFunction(loc, name, funTy);
+  func->setAttr("fir.runtime", builder.getUnitAttr());
+  return func;
+}
+
+namespace helper {
+template <int N, typename A>
+void createArguments(llvm::SmallVectorImpl<mlir::Value> &result,
+                     fir::FirOpBuilder &builder, mlir::Location loc,
+                     mlir::FunctionType fTy, A arg) {
+  result.emplace_back(builder.createConvert(loc, fTy.getInput(N), arg));
+}
+
+template <int N, typename A, typename... As>
+void createArguments(llvm::SmallVectorImpl<mlir::Value> &result,
+                     fir::FirOpBuilder &builder, mlir::Location loc,
+                     mlir::FunctionType fTy, A arg, As... args) {
+  result.emplace_back(builder.createConvert(loc, fTy.getInput(N), arg));
+  createArguments<N + 1>(result, builder, loc, fTy, args...);
+}
+} // namespace helper
+
+/// Create a SmallVector of arguments for a runtime call.
+template <typename... As>
+llvm::SmallVector<mlir::Value>
+createArguments(fir::FirOpBuilder &builder, mlir::Location loc,
+                mlir::FunctionType fTy, As... args) {
+  llvm::SmallVector<mlir::Value> result;
+  helper::createArguments<0>(result, builder, loc, fTy, args...);
+  return result;
+}
+
+} // namespace fir::runtime
+
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_RTBUILDER_H

flang/include/flang/Optimizer/Dialect/FIROpsSupport.h

 
 /// Get or create a GlobalOp in a module.
 fir::GlobalOp createGlobalOp(mlir::Location loc, mlir::ModuleOp module,
                              llvm::StringRef name, mlir::Type type,
                              llvm::ArrayRef<mlir::NamedAttribute> attrs = {});
 
 /// Attribute to mark Fortran entities with the CONTIGUOUS attribute.
 constexpr llvm::StringRef getContiguousAttrName() { return "fir.contiguous"; }
+
 /// Attribute to mark Fortran entities with the OPTIONAL attribute.
 constexpr llvm::StringRef getOptionalAttrName() { return "fir.optional"; }
 
 /// Attribute to mark Fortran entities with the TARGET attribute.
 static constexpr llvm::StringRef getTargetAttrName() { return "fir.target"; }
 
 /// Tell if \p value is:
 ///   - a function argument that has attribute \p attributeName

flang/include/flang/Optimizer/Dialect/FIRTypes.td

def fir_LogicalType : FIR_Type<"Logical", "logical"> {
 
   let parameters = (ins "KindTy":$fKind);
 
   let extraClassDeclaration = [{
     using KindTy = unsigned;
   }];
 }
 
+def fir_LLVMPointerType : FIR_Type<"LLVMPointer", "llvm_ptr"> {
+  let summary = "Like LLVM pointer type";
+
+  let description = [{
+    A pointer type that does not have any of the constraints and semantics
+    of other FIR pointer types and that translates to llvm pointer types.
+    It is meant to implement indirection that cannot be expressed directly
+    in Fortran, but are needed to implement some Fortran features (e.g,
+    double indirections).
+  }];
+
+  let parameters = (ins "mlir::Type":$eleTy);
+
+  let skipDefaultBuilders = 1;
+
+  let builders = [
+    TypeBuilderWithInferredContext<(ins "mlir::Type":$elementType), [{
+      return Base::get(elementType.getContext(), elementType);
+    }]>,
+  ];
+}
+
 def fir_PointerType : FIR_Type<"Pointer", "ptr"> {
   let summary = "Reference to a POINTER attribute type";
 
   let description = [{
     The type of entities with the POINTER attribute.  These pointers are
     explicitly distinguished to disallow the composition of multiple levels of
     indirection. For example, an ALLOCATABLE POINTER is invalid.
   }];
def fir_SequenceType : FIR_Type<"Sequence", "array"> {
   let genVerifyDecl = 1;
 
   let builders = [
     TypeBuilderWithInferredContext<(ins
         "llvm::ArrayRef<int64_t>":$shape,
         "mlir::Type":$eleTy), [{
       return get(eleTy.getContext(), shape, eleTy, {});
     }]>,
+    TypeBuilderWithInferredContext<(ins
+        "mlir::Type":$eleTy,
+        "size_t":$dimensions), [{
+      llvm::SmallVector<int64_t> shape(dimensions, getUnknownExtent());
+      return get(eleTy.getContext(), shape, eleTy, {});
+    }]>
   ];
 
   let extraClassDeclaration = [{
     using Extent = int64_t;
     using Shape = llvm::SmallVector<Extent, 8>;
     using ShapeRef = llvm::ArrayRef<int64_t>;
     unsigned getConstantRows() const;
 

flang/include/flang/Optimizer/Transforms/Factory.h

+//===-- Optimizer/Transforms/Factory.h --------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Templates to generate more complex code patterns in transformation passes.
+// In transformation passes, front-end information such as is available in
+// lowering is not available.
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_TRANSFORMS_FACTORY_H
+#define FORTRAN_OPTIMIZER_TRANSFORMS_FACTORY_H
+
+#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Dialect/FIRType.h"
+#include "mlir/Dialect/StandardOps/IR/Ops.h"
+#include "llvm/ADT/iterator_range.h"
+
+namespace mlir {
+class Location;
+class Value;
+} // namespace mlir
+
+namespace fir::factory {
+
+constexpr llvm::StringRef attrFortranArrayOffsets() {
+  return "Fortran.offsets";
+}
+
+/// Generate a character copy with optimized forms.
+///
+/// If the lengths are constant and equal, use load/store rather than a loop.
+/// Otherwise, if the lengths are constant and the input is longer than the
+/// output, generate a loop to move a truncated portion of the source to the
+/// destination. Finally, if the lengths are runtime values or the destination
+/// is longer than the source, move the entire source character and pad the
+/// destination with spaces as needed.
+template <typename B>
+void genCharacterCopy(mlir::Value src, mlir::Value srcLen, mlir::Value dst,
+                      mlir::Value dstLen, B &builder, mlir::Location loc) {
+  auto srcTy =
+      fir::dyn_cast_ptrEleTy(src.getType()).template cast<fir::CharacterType>();
+  auto dstTy =
+      fir::dyn_cast_ptrEleTy(dst.getType()).template cast<fir::CharacterType>();
+  if (!srcLen && !dstLen && srcTy.getFKind() == dstTy.getFKind() &&
+      srcTy.getLen() == dstTy.getLen()) {
+    // same size, so just use load and store
+    auto load = builder.template create<fir::LoadOp>(loc, src);
+    builder.template create<fir::StoreOp>(loc, load, dst);
+    return;
+  }
+  auto zero = builder.template create<arith::ConstantIndexOp>(loc, 0);
+  auto one = builder.template create<arith::ConstantIndexOp>(loc, 1);
+  auto toArrayTy = [&](fir::CharacterType ty) {
+    return fir::ReferenceType::get(fir::SequenceType::get(
+        fir::SequenceType::ShapeRef{fir::SequenceType::getUnknownExtent()},
+        fir::CharacterType::getSingleton(ty.getContext(), ty.getFKind())));
+  };
+  auto toEleTy = [&](fir::ReferenceType ty) {
+    auto seqTy = ty.getEleTy().cast<fir::SequenceType>();
+    return seqTy.getEleTy().cast<fir::CharacterType>();
+  };
+  auto toCoorTy = [&](fir::ReferenceType ty) {
+    return fir::ReferenceType::get(toEleTy(ty));
+  };
+  if (!srcLen && !dstLen && srcTy.getLen() >= dstTy.getLen()) {
+    auto upper = builder.template create<arith::ConstantIndexOp>(
+        loc, dstTy.getLen() - 1);
+    auto loop = builder.template create<fir::DoLoopOp>(loc, zero, upper, one);
+    auto insPt = builder.saveInsertionPoint();
+    builder.setInsertionPointToStart(loop.getBody());
+    auto csrcTy = toArrayTy(srcTy);
+    auto csrc = builder.template create<fir::ConvertOp>(loc, csrcTy, src);
+    auto in = builder.template create<fir::CoordinateOp>(
+        loc, toCoorTy(csrcTy), csrc, loop.getInductionVar());
+    auto load = builder.template create<fir::LoadOp>(loc, in);
+    auto cdstTy = toArrayTy(dstTy);
+    auto cdst = builder.template create<fir::ConvertOp>(loc, cdstTy, dst);
+    auto out = builder.template create<fir::CoordinateOp>(
+        loc, toCoorTy(cdstTy), cdst, loop.getInductionVar());
+    mlir::Value cast =
+        srcTy.getFKind() == dstTy.getFKind()
+            ? load.getResult()
+            : builder
+                  .template create<fir::ConvertOp>(loc, toEleTy(cdstTy), load)
+                  .getResult();
+    builder.template create<fir::StoreOp>(loc, cast, out);
+    builder.restoreInsertionPoint(insPt);
+    return;
+  }
+  auto minusOne = [&](mlir::Value v) -> mlir::Value {
+    return builder.template create<arith::SubIOp>(
+        loc, builder.template create<fir::ConvertOp>(loc, one.getType(), v),
+        one);
+  };
+  mlir::Value len = dstLen ? minusOne(dstLen)
+                           : builder
+                                 .template create<arith::ConstantIndexOp>(
+                                     loc, dstTy.getLen() - 1)
+                                 .getResult();
+  auto loop = builder.template create<fir::DoLoopOp>(loc, zero, len, one);
+  auto insPt = builder.saveInsertionPoint();
+  builder.setInsertionPointToStart(loop.getBody());
+  mlir::Value slen =
+      srcLen
+          ? builder.template create<fir::ConvertOp>(loc, one.getType(), srcLen)
+                .getResult()
+          : builder.template create<arith::ConstantIndexOp>(loc, srcTy.getLen())
+                .getResult();
+  auto cond = builder.template create<arith::CmpIOp>(
+      loc, arith::CmpIPredicate::slt, loop.getInductionVar(), slen);
+  auto ifOp = builder.template create<fir::IfOp>(loc, cond, /*withElse=*/true);
+  builder.setInsertionPointToStart(&ifOp.thenRegion().front());
+  auto csrcTy = toArrayTy(srcTy);
+  auto csrc = builder.template create<fir::ConvertOp>(loc, csrcTy, src);
+  auto in = builder.template create<fir::CoordinateOp>(
+      loc, toCoorTy(csrcTy), csrc, loop.getInductionVar());
+  auto load = builder.template create<fir::LoadOp>(loc, in);
+  auto cdstTy = toArrayTy(dstTy);
+  auto cdst = builder.template create<fir::ConvertOp>(loc, cdstTy, dst);
+  auto out = builder.template create<fir::CoordinateOp>(
+      loc, toCoorTy(cdstTy), cdst, loop.getInductionVar());
+  mlir::Value cast =
+      srcTy.getFKind() == dstTy.getFKind()
+          ? load.getResult()
+          : builder.template create<fir::ConvertOp>(loc, toEleTy(cdstTy), load)
+                .getResult();
+  builder.template create<fir::StoreOp>(loc, cast, out);
+  builder.setInsertionPointToStart(&ifOp.elseRegion().front());
+  auto space = builder.template create<fir::StringLitOp>(
+      loc, toEleTy(cdstTy), llvm::ArrayRef<char>{' '});
+  auto cdst2 = builder.template create<fir::ConvertOp>(loc, cdstTy, dst);
+  auto out2 = builder.template create<fir::CoordinateOp>(
+      loc, toCoorTy(cdstTy), cdst2, loop.getInductionVar());
+  builder.template create<fir::StoreOp>(loc, space, out2);
+  builder.restoreInsertionPoint(insPt);
+}
+
+/// Get extents from fir.shape/fir.shape_shift op. Empty result if
+/// \p shapeVal is empty or is a fir.shift.
+inline std::vector<mlir::Value> getExtents(mlir::Value shapeVal) {
+  if (shapeVal)
+    if (auto *shapeOp = shapeVal.getDefiningOp()) {
+      if (auto shOp = mlir::dyn_cast<fir::ShapeOp>(shapeOp))
+        return shOp.getExtents();
+      if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp))
+        return shOp.getExtents();
+    }
+  return {};
+}
+
+/// Get origins from fir.shape_shift/fir.shift op. Empty result if
+/// \p shapeVal is empty or is a fir.shape.
+inline std::vector<mlir::Value> getOrigins(mlir::Value shapeVal) {
+  if (shapeVal)
+    if (auto *shapeOp = shapeVal.getDefiningOp()) {
+      if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp))
+        return shOp.getOrigins();
+      if (auto shOp = mlir::dyn_cast<fir::ShiftOp>(shapeOp))
+        return shOp.getOrigins();
+    }
+  return {};
+}
+
+/// Convert the normalized indices on array_fetch and array_update to the
+/// dynamic (and non-zero) origin required by array_coor.
+/// Do not adjust any trailing components in the path as they specify a
+/// particular path into the array value and must already correspond to the
+/// structure of an element.
+template <typename B>
+llvm::SmallVector<mlir::Value>
+originateIndices(mlir::Location loc, B &builder, mlir::Type memTy,
+                 mlir::Value shapeVal, mlir::ValueRange indices) {
+  llvm::SmallVector<mlir::Value> result;
+  auto origins = getOrigins(shapeVal);
+  if (origins.empty()) {
+    assert(!shapeVal || mlir::isa<fir::ShapeOp>(shapeVal.getDefiningOp()));
+    auto ty = fir::dyn_cast_ptrOrBoxEleTy(memTy);
+    assert(ty && ty.isa<fir::SequenceType>());
+    auto seqTy = ty.cast<fir::SequenceType>();
+    auto one = builder.template create<arith::ConstantIndexOp>(loc, 1);
+    const auto dimension = seqTy.getDimension();
+    if (shapeVal) {
+      assert(dimension == mlir::cast<fir::ShapeOp>(shapeVal.getDefiningOp())
+                              .getType()
+                              .getRank());
+    }
+    for (auto i : llvm::enumerate(indices)) {
+      if (i.index() < dimension) {
+        assert(fir::isa_integer(i.value().getType()));
+        result.push_back(
+            builder.template create<arith::AddIOp>(loc, i.value(), one));
+      } else {
+        result.push_back(i.value());
+      }
+    }
+    return result;
+  }
+  const auto dimension = origins.size();
+  unsigned origOff = 0;
+  for (auto i : llvm::enumerate(indices)) {
+    if (i.index() < dimension)
+      result.push_back(builder.template create<arith::AddIOp>(
+          loc, i.value(), origins[origOff++]));
+    else
+      result.push_back(i.value());
+  }
+  return result;
+}
+
+template <typename B, typename Iter>
+llvm::SmallVector<fir::DoLoopOp> createLoopNest(
+    mlir::Location loc, B &builder, llvm::iterator_range<Iter> lows,
+    llvm::iterator_range<Iter> highs, llvm::iterator_range<Iter> steps,
+    llvm::ArrayRef<mlir::Value> threadedVals, bool unordered = false) {
+  llvm::SmallVector<fir::DoLoopOp> loops;
+  llvm::SmallVector<mlir::Value> inners(threadedVals.begin(),
+                                        threadedVals.end());
+  for (auto iter0 = lows.begin(), iter1 = highs.begin(), iter2 = steps.begin();
+       iter1 != highs.end(); ++iter0, ++iter1, ++iter2) {
+    auto lp = builder.template create<fir::DoLoopOp>(
+        loc, *iter0, *iter1, *iter2, unordered,
+        /*finalCount=*/false, inners);
+    loops.push_back(lp);
+    inners.assign(lp.getRegionIterArgs().begin(), lp.getRegionIterArgs().end());
+    builder.setInsertionPointToStart(lp.getBody());
+  }
+  auto numLoops = loops.size();
+  for (decltype(numLoops) i = 0; i + 1 < numLoops; ++i) {
+    builder.setInsertionPointToEnd(loops[i].getBody());
+    builder.template create<fir::ResultOp>(loc, loops[i + 1].getResults());
+  }
+  builder.setInsertionPointAfter(loops[0]);
+  llvm::errs() << loops[0] << '\n';
+  return loops;
+}
+
+template <typename B>
+llvm::SmallVector<fir::DoLoopOp> createLoopNest(
+    mlir::Location loc, B &builder, llvm::ArrayRef<mlir::Value> lows,
+    llvm::ArrayRef<mlir::Value> highs, llvm::ArrayRef<mlir::Value> steps,
+    llvm::ArrayRef<mlir::Value> threadedVals, bool unordered = false) {
+  return createLoopNest(
+      loc, builder, llvm::make_range(lows.begin(), lows.end()),
+      llvm::make_range(highs.begin(), highs.end()),
+      llvm::make_range(steps.begin(), steps.end()), threadedVals, unordered);
+}
+
+} // namespace fir::factory
+
+#endif // FORTRAN_OPTIMIZER_TRANSFORMS_FACTORY_H

flang/include/flang/Optimizer/Transforms/Passes.h

 namespace fir {
 
 //===----------------------------------------------------------------------===//
 // Passes defined in Passes.td
 //===----------------------------------------------------------------------===//
 
 std::unique_ptr<mlir::Pass> createAbstractResultOptPass();
 std::unique_ptr<mlir::Pass> createAffineDemotionPass();
+std::unique_ptr<mlir::Pass> createArrayValueCopyPass();
 std::unique_ptr<mlir::Pass> createFirToCfgPass();
 std::unique_ptr<mlir::Pass> createCharacterConversionPass();
 std::unique_ptr<mlir::Pass> createExternalNameConversionPass();
 std::unique_ptr<mlir::Pass> createPromoteToAffinePass();
 
 /// Support for inlining on FIR.
 bool canLegallyInline(mlir::Operation *op, mlir::Region *reg,
                       mlir::BlockAndValueMapping &map);
 
 // declarative passes
 #define GEN_PASS_REGISTRATION
 #include "flang/Optimizer/Transforms/Passes.h.inc"
 
 } // namespace fir
 
 #endif // OPTIMIZER_TRANSFORMS_PASSES_H

flang/include/flang/Optimizer/Transforms/Passes.td

let description = [{
     `fir.load` and `fir.store` with `!fir.ref<?>` types is required.
   }];
   let constructor = "::fir::createAffineDemotionPass()";
   let dependentDialects = [
     "fir::FIROpsDialect", "mlir::StandardOpsDialect", "mlir::AffineDialect"
   ];
 }
 
+def ArrayValueCopy : FunctionPass<"array-value-copy"> {
+  let summary = "Convert array value operations to memory operations.";
+  let description = [{
+    Transform the set of array value primitives to a memory-based array
+    representation.
+
+    The Ops `array_load`, `array_store`, `array_fetch`, and `array_update` are
+    used to manage abstract aggregate array values. A simple analysis is done
+    to determine if there are potential dependences between these operations.
+    If not, these array operations can be lowered to work directly on the memory
+    representation. If there is a potential conflict, a temporary is created
+    along with appropriate copy-in/copy-out operations. Here, a more refined
+    analysis might be deployed, such as using the affine framework.
+
+    This pass is required before code gen to the LLVM IR dialect.
+  }];
+  let constructor = "::fir::createArrayValueCopyPass()";
+  let dependentDialects = [
+    "fir::FIROpsDialect", "mlir::StandardOpsDialect"
+  ];
+}
+
 def CharacterConversion : Pass<"character-conversion"> {
   let summary = "Convert CHARACTER entities with different KINDs";
   let description = [{
     Translates entities of one CHARACTER KIND to another.
 
     By default the translation is to naively zero-extend or truncate a code
     point to fit the destination size.
   }];

flang/lib/Optimizer/Builder/CMakeLists.txt

 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FIRBuilder
   BoxValue.cpp
   Character.cpp
   DoLoopHelper.cpp
   FIRBuilder.cpp
+  MutableBox.cpp
+  Runtime/Assign.cpp
 
   DEPENDS
   FIRDialect
   FIRSupport
   ${dialect_libs}
 
   LINK_LIBS
   FIRDialect
   FIRSupport
   ${dialect_libs}
 )

flang/lib/Optimizer/Builder/FIRBuilder.cpp

 //===-- FIRBuilder.cpp ----------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Builder/Character.h"
+#include "flang/Optimizer/Builder/MutableBox.h"
+#include "flang/Optimizer/Builder/Runtime/Assign.h"
+#include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Optimizer/Support/InternalNames.h"
 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
+#include "llvm/ADT/ArrayRef.h"
 #include "llvm/ADT/StringExtras.h"
 #include "llvm/Support/CommandLine.h"
+#include "llvm/Support/ErrorHandling.h"
 #include "llvm/Support/MD5.h"
 
 static llvm::cl::opt<std::size_t>
     nameLengthHashSize("length-to-hash-string-literal",
                        llvm::cl::desc("string literals that exceed this length"
                                       " will use a hash value as their symbol "
                                       "name"),
                        llvm::cl::init(32));
 
 mlir::FuncOp fir::FirOpBuilder::createFunction(mlir::Location loc,
                                                mlir::ModuleOp module,
                                                llvm::StringRef name,
                                                mlir::FunctionType ty) {
   return fir::createFuncOp(loc, module, name, ty);
 }
 
 mlir::FuncOp fir::FirOpBuilder::getNamedFunction(mlir::ModuleOp modOp,
                                                  llvm::StringRef name) {
   return modOp.lookupSymbol<mlir::FuncOp>(name);
 }
 
 fir::GlobalOp fir::FirOpBuilder::getNamedGlobal(mlir::ModuleOp modOp,
                                                 llvm::StringRef name) {
   return modOp.lookupSymbol<fir::GlobalOp>(name);
 }
 
 mlir::Type fir::FirOpBuilder::getRefType(mlir::Type eleTy) {
   assert(!eleTy.isa<fir::ReferenceType>() && "cannot be a reference type");
   return fir::ReferenceType::get(eleTy);
 }
 
fir::FirOpBuilder::createRealConstant(mlir::Location loc, mlir::Type fltTy,
   return createRealConstant(loc, fltTy, apf());
 }
 
 mlir::Value fir::FirOpBuilder::createRealConstant(mlir::Location loc,
                                                   mlir::Type fltTy,
                                                   const llvm::APFloat &value) {
   if (fltTy.isa<mlir::FloatType>()) {
     auto attr = getFloatAttr(fltTy, value);
-    return create<mlir::arith::ConstantOp>(loc, fltTy, attr);
+    return create<mlir::ConstantOp>(loc, fltTy, attr);
   }
   llvm_unreachable("should use builtin floating-point type");
 }
 
 static llvm::SmallVector<mlir::Value>
 elideExtentsAlreadyInType(mlir::Type type, mlir::ValueRange shape) {
   auto arrTy = type.dyn_cast<fir::SequenceType>();
   if (shape.empty() || !arrTy)
fir::GlobalOp fir::FirOpBuilder::createGlobal(
   region.push_back(new mlir::Block);
   auto &block = glob.getRegion().back();
   setInsertionPointToStart(&block);
   bodyBuilder(*this);
   restoreInsertionPoint(insertPt);
   return glob;
 }
 
+mlir::Value fir::FirOpBuilder::convertWithSemantics(mlir::Location loc,
+                                                    mlir::Type toTy,
+                                                    mlir::Value val) {
+  assert(toTy && "store location must be typed");
+  auto fromTy = val.getType();
+  if (fromTy == toTy)
+    return val;
+  // fir::factory::ComplexExprHelper helper{*this, loc};
+  // if ((fir::isa_real(fromTy) || fir::isa_integer(fromTy)) &&
+  //     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);
+  // }
+  // if (fir::isa_complex(fromTy) &&
+  //     (fir::isa_integer(toTy) || fir::isa_real(toTy))) {
+  //   // drop the imaginary part
+  //   auto rp = helper.extractComplexPart(val, /*isImagPart=*/false);
+  //   return createConvert(loc, toTy, rp);
+  // }
+  return createConvert(loc, toTy, val);
+}
+
 mlir::Value fir::FirOpBuilder::createConvert(mlir::Location loc,
                                              mlir::Type toTy, mlir::Value val) {
   if (val.getType() != toTy) {
     assert(!fir::isa_derived(toTy));
     return create<fir::ConvertOp>(loc, toTy, val);
   }
   return val;
 }
 
 fir::StringLitOp fir::FirOpBuilder::createStringLitOp(mlir::Location loc,
                                                       llvm::StringRef data) {
   auto type = fir::CharacterType::get(getContext(), 1, data.size());
   auto strAttr = mlir::StringAttr::get(getContext(), data);
   auto valTag = mlir::Identifier::get(fir::StringLitOp::value(), getContext());
   mlir::NamedAttribute dataAttr(valTag, strAttr);
   auto sizeTag = mlir::Identifier::get(fir::StringLitOp::size(), getContext());
   mlir::NamedAttribute sizeAttr(sizeTag, getI64IntegerAttr(data.size()));
   llvm::SmallVector<mlir::NamedAttribute> attrs{dataAttr, sizeAttr};
   return create<fir::StringLitOp>(loc, llvm::ArrayRef<mlir::Type>{type},
                                   llvm::None, attrs);
 }
 
-static mlir::Value genNullPointerComparison(fir::FirOpBuilder &builder,
-                                            mlir::Location loc,
-                                            mlir::Value addr,
-                                            arith::CmpIPredicate condition) {
+mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
+                                        llvm::ArrayRef<mlir::Value> exts) {
+  auto shapeType = fir::ShapeType::get(getContext(), exts.size());
+  return create<fir::ShapeOp>(loc, shapeType, exts);
+}
+
+mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
+                                        llvm::ArrayRef<mlir::Value> shift,
+                                        llvm::ArrayRef<mlir::Value> exts) {
+  auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size());
+  llvm::SmallVector<mlir::Value> shapeArgs;
+  auto idxTy = getIndexType();
+  for (auto [lbnd, ext] : llvm::zip(shift, exts)) {
+    auto lb = createConvert(loc, idxTy, lbnd);
+    shapeArgs.push_back(lb);
+    shapeArgs.push_back(ext);
+  }
+  return create<fir::ShapeShiftOp>(loc, shapeType, shapeArgs);
+}
+
+mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc,
+                                        const fir::AbstractArrayBox &arr) {
+  if (arr.lboundsAllOne())
+    return genShape(loc, arr.getExtents());
+  return genShape(loc, arr.getLBounds(), arr.getExtents());
+}
+
+mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc,
+                                           const fir::ExtendedValue &exv) {
+  return exv.match(
+      [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); },
+      [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); },
+      [&](const fir::BoxValue &box) -> mlir::Value {
+        if (!box.getLBounds().empty()) {
+          auto shiftType =
+              fir::ShiftType::get(getContext(), box.getLBounds().size());
+          return create<fir::ShiftOp>(loc, shiftType, box.getLBounds());
+        }
+        return {};
+      },
+      [&](const fir::MutableBoxValue &) -> mlir::Value {
+        // MutableBoxValue must be read into another category to work with them
+        // outside of allocation/assignment contexts.
+        fir::emitFatalError(loc, "createShape on MutableBoxValue");
+      },
+      [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
+}
+
+mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,
+                                           const fir::ExtendedValue &exv,
+                                           mlir::ValueRange triples,
+                                           mlir::ValueRange path) {
+  if (triples.empty()) {
+    // If there is no slicing by triple notation, then take the whole array.
+    auto fullShape = [&](const llvm::ArrayRef<mlir::Value> lbounds,
+                         llvm::ArrayRef<mlir::Value> extents) -> mlir::Value {
+      llvm::SmallVector<mlir::Value> trips;
+      auto idxTy = getIndexType();
+      auto one = createIntegerConstant(loc, idxTy, 1);
+      auto sliceTy = fir::SliceType::get(getContext(), extents.size());
+      if (lbounds.empty()) {
+        for (auto v : extents) {
+          trips.push_back(one);
+          trips.push_back(v);
+          trips.push_back(one);
+        }
+        return create<fir::SliceOp>(loc, sliceTy, trips, path);
+      }
+      for (auto [lbnd, ext] : llvm::zip(lbounds, extents)) {
+        auto lb = createConvert(loc, idxTy, lbnd);
+        trips.push_back(lb);
+        trips.push_back(ext);
+        trips.push_back(one);
+      }
+      return create<fir::SliceOp>(loc, sliceTy, trips, path);
+    };
+    return exv.match(
+        [&](const fir::ArrayBoxValue &box) {
+          return fullShape(box.getLBounds(), box.getExtents());
+        },
+        [&](const fir::CharArrayBoxValue &box) {
+          return fullShape(box.getLBounds(), box.getExtents());
+        },
+        [&](const fir::BoxValue &box) {
+          auto extents = fir::factory::readExtents(*this, loc, box);
+          return fullShape(box.getLBounds(), extents);
+        },
+        [&](const fir::MutableBoxValue &) -> mlir::Value {
+          // MutableBoxValue must be read into another category to work with
+          // them outside of allocation/assignment contexts.
+          fir::emitFatalError(loc, "createSlice on MutableBoxValue");
+        },
+        [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); });
+  }
+  auto rank = exv.rank();
+  auto sliceTy = fir::SliceType::get(getContext(), rank);
+  return create<fir::SliceOp>(loc, sliceTy, triples, path);
+}
+
+mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
+                                         const fir::ExtendedValue &exv) {
+  auto itemAddr = fir::getBase(exv);
+  if (itemAddr.getType().isa<fir::BoxType>())
+    return itemAddr;
+  auto elementType = fir::dyn_cast_ptrEleTy(itemAddr.getType());
+  if (!elementType)
+    mlir::emitError(loc, "internal: expected a memory reference type ")
+        << itemAddr.getType();
+  auto boxTy = fir::BoxType::get(elementType);
+  return exv.match(
+      [&](const fir::ArrayBoxValue &box) -> mlir::Value {
+        auto s = createShape(loc, exv);
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
+      },
+      [&](const fir::CharArrayBoxValue &box) -> mlir::Value {
+        auto s = createShape(loc, exv);
+        if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
+          return create<fir::EmboxOp>(loc, boxTy, itemAddr, s);
+
+        mlir::Value emptySlice;
+        llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, s, emptySlice,
+                                    lenParams);
+      },
+      [&](const fir::CharBoxValue &box) -> mlir::Value {
+        if (fir::factory::CharacterExprHelper::hasConstantLengthInType(exv))
+          return create<fir::EmboxOp>(loc, boxTy, itemAddr);
+        mlir::Value emptyShape, emptySlice;
+        llvm::SmallVector<mlir::Value> lenParams{box.getLen()};
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr, emptyShape,
+                                    emptySlice, lenParams);
+      },
+      [&](const fir::MutableBoxValue &x) -> mlir::Value {
+        return create<fir::LoadOp>(
+            loc, fir::factory::getMutableIRBox(*this, loc, x));
+      },
+      [&](const auto &) -> mlir::Value {
+        return create<fir::EmboxOp>(loc, boxTy, itemAddr);
+      });
+}
+
+static mlir::Value
+genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc,
+                         mlir::arith::CmpIPredicate condition) {
   auto intPtrTy = builder.getIntPtrType();
   auto ptrToInt = builder.createConvert(loc, intPtrTy, addr);
   auto c0 = builder.createIntegerConstant(loc, intPtrTy, 0);
-  return builder.create<arith::CmpIOp>(loc, condition, ptrToInt, c0);
+  return builder.create<mlir::arith::CmpIOp>(loc, condition, ptrToInt, c0);
 }
 
 mlir::Value fir::FirOpBuilder::genIsNotNull(mlir::Location loc,
                                             mlir::Value addr) {
-  return genNullPointerComparison(*this, loc, addr, arith::CmpIPredicate::ne);
+  return genNullPointerComparison(*this, loc, addr,
+                                  mlir::arith::CmpIPredicate::ne);
 }
 
 mlir::Value fir::FirOpBuilder::genIsNull(mlir::Location loc, mlir::Value addr) {
-  return genNullPointerComparison(*this, loc, addr, arith::CmpIPredicate::eq);
+  return genNullPointerComparison(*this, loc, addr,
+                                  mlir::arith::CmpIPredicate::eq);
+}
+
+mlir::Value fir::FirOpBuilder::genExtentFromTriplet(mlir::Location loc,
+                                                    mlir::Value lb,
+                                                    mlir::Value ub,
+                                                    mlir::Value step,
+                                                    mlir::Type type) {
+  auto zero = createIntegerConstant(loc, type, 0);
+  lb = createConvert(loc, type, lb);
+  ub = createConvert(loc, type, ub);
+  step = createConvert(loc, type, step);
+  auto diff = create<mlir::arith::SubIOp>(loc, ub, lb);
+  auto add = create<mlir::arith::AddIOp>(loc, diff, step);
+  auto div = create<mlir::arith::DivSIOp>(loc, add, step);
+  auto cmp = create<mlir::arith::CmpIOp>(loc, mlir::arith::CmpIPredicate::sgt,
+                                         div, zero);
+  return create<mlir::SelectOp>(loc, cmp, div, zero);
+}
+
+//===--------------------------------------------------------------------===//
+// ExtendedValue inquiry helper implementation
+//===--------------------------------------------------------------------===//
+
+mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder,
+                                      mlir::Location loc,
+                                      const fir::ExtendedValue &box) {
+  return box.match(
+      [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); },
+      [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
+        return x.getLen();
+      },
+      [&](const fir::BoxValue &x) -> mlir::Value {
+        assert(x.isCharacter());
+        if (!x.getExplicitParameters().empty())
+          return x.getExplicitParameters()[0];
+        return fir::factory::CharacterExprHelper{builder, loc}
+            .readLengthFromBox(x.getAddr());
+      },
+      [&](const fir::MutableBoxValue &) -> mlir::Value {
+        // MutableBoxValue must be read into another category to work with them
+        // outside of allocation/assignment contexts.
+        fir::emitFatalError(loc, "readCharLen on MutableBoxValue");
+      },
+      [&](const auto &) -> mlir::Value {
+        fir::emitFatalError(
+            loc, "Character length inquiry on a non-character entity");
+      });
+}
+
+mlir::Value fir::factory::readExtent(fir::FirOpBuilder &builder,
+                                     mlir::Location loc,
+                                     const fir::ExtendedValue &box,
+                                     unsigned dim) {
+  assert(box.rank() > dim);
+  return box.match(
+      [&](const fir::ArrayBoxValue &x) -> mlir::Value {
+        return x.getExtents()[dim];
+      },
+      [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
+        return x.getExtents()[dim];
+      },
+      [&](const fir::BoxValue &x) -> mlir::Value {
+        if (!x.getExplicitExtents().empty())
+          return x.getExplicitExtents()[dim];
+        auto idxTy = builder.getIndexType();
+        auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
+        return builder
+            .create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, x.getAddr(),
+                                    dimVal)
+            .getResult(1);
+      },
+      [&](const fir::MutableBoxValue &x) -> mlir::Value {
+        // MutableBoxValue must be read into another category to work with them
+        // outside of allocation/assignment contexts.
+        fir::emitFatalError(loc, "readExtents on MutableBoxValue");
+      },
+      [&](const auto &) -> mlir::Value {
+        fir::emitFatalError(loc, "extent inquiry on scalar");
+      });
+}
+
+mlir::Value fir::factory::readLowerBound(fir::FirOpBuilder &,
+                                         mlir::Location loc,
+                                         const fir::ExtendedValue &box,
+                                         unsigned dim,
+                                         mlir::Value defaultValue) {
+  assert(box.rank() > dim);
+  auto lb = box.match(
+      [&](const fir::ArrayBoxValue &x) -> mlir::Value {
+        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
+      },
+      [&](const fir::CharArrayBoxValue &x) -> mlir::Value {
+        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
+      },
+      [&](const fir::BoxValue &x) -> mlir::Value {
+        return x.getLBounds().empty() ? mlir::Value{} : x.getLBounds()[dim];
+      },
+      [&](const fir::MutableBoxValue &) -> mlir::Value {
+        // MutableBoxValue must be read into another category to work with them
+        // outside of allocation/assignment contexts.
+        fir::emitFatalError(loc, "readLowerBound on MutableBoxValue");
+      },
+      [&](const auto &) -> mlir::Value {
+        fir::emitFatalError(loc, "lower bound inquiry on scalar");
+      });
+  if (lb)
+    return lb;
+  return defaultValue;
+}
+
+llvm::SmallVector<mlir::Value>
+fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,
+                          const fir::BoxValue &box) {
+  llvm::SmallVector<mlir::Value> result;
+  auto explicitExtents = box.getExplicitExtents();
+  if (!explicitExtents.empty()) {
+    result.append(explicitExtents.begin(), explicitExtents.end());
+    return result;
+  }
+  auto rank = box.rank();
+  auto idxTy = builder.getIndexType();
+  for (decltype(rank) dim = 0; dim < rank; ++dim) {
+    auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
+    auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+                                                  box.getAddr(), dimVal);
+    result.emplace_back(dimInfo.getResult(1));
+  }
+  return result;
+}
+
+llvm::SmallVector<mlir::Value>
+fir::factory::getExtents(fir::FirOpBuilder &builder, mlir::Location loc,
+                         const fir::ExtendedValue &box) {
+  return box.match(
+      [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
+        return {x.getExtents().begin(), x.getExtents().end()};
+      },
+      [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
+        return {x.getExtents().begin(), x.getExtents().end()};
+      },
+      [&](const fir::BoxValue &x) -> llvm::SmallVector<mlir::Value> {
+        return fir::factory::readExtents(builder, loc, x);
+      },
+      [&](const fir::MutableBoxValue &x) -> llvm::SmallVector<mlir::Value> {
+        auto load = fir::factory::genMutableBoxRead(builder, loc, x);
+        return fir::factory::getExtents(builder, loc, load);
+      },
+      [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
+}
+
+fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
+                                              mlir::Location loc,
+                                              const fir::BoxValue &box) {
+  assert(!box.isUnlimitedPolymorphic() && !box.hasAssumedRank() &&
+         "cannot read unlimited polymorphic or assumed rank fir.box");
+  auto addr =
+      builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
+  if (box.isCharacter()) {
+    auto len = fir::factory::readCharLen(builder, loc, box);
+    if (box.rank() == 0)
+      return fir::CharBoxValue(addr, len);
+    return fir::CharArrayBoxValue(addr, len,
+                                  fir::factory::readExtents(builder, loc, box),
+                                  box.getLBounds());
+  }
+  if (box.isDerivedWithLengthParameters())
+    TODO(loc, "read fir.box with length parameters");
+  if (box.rank() == 0)
+    return addr;
+  return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),
+                            box.getLBounds());
 }
 
 std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,
                                         llvm::StringRef name) {
   // For "long" identifiers use a hash value
   if (name.size() > nameLengthHashSize) {
     llvm::MD5 hash;
     hash.update(name);
global = builder.createGlobalConstant(
         },
         builder.createLinkOnceLinkage());
   auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
                                             global.getSymbol());
   auto len = builder.createIntegerConstant(
       loc, builder.getCharacterLengthType(), str.size());
   return fir::CharBoxValue{addr, len};
 }
+
+llvm::SmallVector<mlir::Value>
+fir::factory::createExtents(fir::FirOpBuilder &builder, mlir::Location loc,
+                            fir::SequenceType seqTy) {
+  llvm::SmallVector<mlir::Value> extents;
+  auto idxTy = builder.getIndexType();
+  for (auto ext : seqTy.getShape())
+    extents.emplace_back(
+        ext == fir::SequenceType::getUnknownExtent()
+            ? builder.create<fir::UndefOp>(loc, idxTy).getResult()
+            : builder.createIntegerConstant(loc, idxTy, ext));
+  return extents;
+}
+
+// FIXME: This needs some work. To correctly determine the extended value of a
+// component, one needs the base object, its type, and its type parameters. (An
+// alternative would be to provide an already computed address of the final
+// component rather than the base object's address, the point being the result
+// will require the address of the final component to create the extended
+// value.) One further needs the full path of components being applied. One
+// needs to apply type-based expressions to type parameters along this said
+// path. (See applyPathToType for a type-only derivation.) Finally, one needs to
+// compose the extended value of the terminal component, including all of its
+// parameters: array lower bounds expressions, extents, type parameters, etc.
+// Any of these properties may be deferred until runtime in Fortran. This
+// operation may therefore generate a sizeable block of IR, including calls to
+// type-based helper functions, so caching the result of this operation in the
+// client would be advised as well.
+fir::ExtendedValue fir::factory::componentToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value component) {
+  auto fieldTy = component.getType();
+  if (auto ty = fir::dyn_cast_ptrEleTy(fieldTy))
+    fieldTy = ty;
+  if (fieldTy.isa<fir::BoxType>()) {
+    llvm::SmallVector<mlir::Value> nonDeferredTypeParams;
+    auto eleTy = fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(fieldTy));
+    if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
+      auto lenTy = builder.getCharacterLengthType();
+      if (charTy.hasConstantLen())
+        nonDeferredTypeParams.emplace_back(
+            builder.createIntegerConstant(loc, lenTy, charTy.getLen()));
+      // TODO: Starting, F2003, the dynamic character length might be dependent
+      // on a PDT length parameter. There is no way to make a difference with
+      // deferred length here yet.
+    }
+    if (auto recTy = eleTy.dyn_cast<fir::RecordType>())
+      if (recTy.getNumLenParams() > 0)
+        TODO(loc, "allocatable and pointer components non deferred length "
+                  "parameters");
+
+    return fir::MutableBoxValue(component, nonDeferredTypeParams,
+                                /*mutableProperties=*/{});
+  }
+  llvm::SmallVector<mlir::Value> extents;
+  if (auto seqTy = fieldTy.dyn_cast<fir::SequenceType>()) {
+    fieldTy = seqTy.getEleTy();
+    auto idxTy = builder.getIndexType();
+    for (auto extent : seqTy.getShape()) {
+      if (extent == fir::SequenceType::getUnknownExtent())
+        TODO(loc, "array component shape depending on length parameters");
+      extents.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
+    }
+  }
+  if (auto charTy = fieldTy.dyn_cast<fir::CharacterType>()) {
+    auto cstLen = charTy.getLen();
+    if (cstLen == fir::CharacterType::unknownLen())
+      TODO(loc, "get character component length from length type parameters");
+    auto len = builder.createIntegerConstant(
+        loc, builder.getCharacterLengthType(), cstLen);
+    if (!extents.empty())
+      return fir::CharArrayBoxValue{component, len, extents};
+    return fir::CharBoxValue{component, len};
+  }
+  if (auto recordTy = fieldTy.dyn_cast<fir::RecordType>())
+    if (recordTy.getNumLenParams() != 0)
+      TODO(loc,
+           "lower component ref that is a derived type with length parameter");
+  if (!extents.empty())
+    return fir::ArrayBoxValue{component, extents};
+  return component;
+}
+
+fir::ExtendedValue fir::factory::arrayElementToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::ExtendedValue &array, mlir::Value element) {
+  return array.match(
+      [&](const fir::CharBoxValue &cb) -> fir::ExtendedValue {
+        return cb.clone(element);
+      },
+      [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue {
+        return bv.cloneElement(element);
+      },
+      [&](const fir::BoxValue &box) -> fir::ExtendedValue {
+        if (box.isCharacter()) {
+          auto len = fir::factory::readCharLen(builder, loc, box);
+          return fir::CharBoxValue{element, len};
+        }
+        if (box.isDerivedWithLengthParameters())
+          TODO(loc, "get length parameters from derived type BoxValue");
+        return element;
+      },
+      [&](const auto &) -> fir::ExtendedValue { return element; });
+}
+
+fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::ExtendedValue &array, mlir::Value element, mlir::Value slice) {
+  if (!slice)
+    return arrayElementToExtendedValue(builder, loc, array, element);
+  auto sliceOp = mlir::dyn_cast_or_null<fir::SliceOp>(slice.getDefiningOp());
+  assert(sliceOp && "slice must be a sliceOp");
+  if (sliceOp.fields().empty())
+    return arrayElementToExtendedValue(builder, loc, array, element);
+  // For F95, using componentToExtendedValue will work, but when PDTs are
+  // lowered. It will be required to go down the slice to propagate the length
+  // parameters.
+  return fir::factory::componentToExtendedValue(builder, loc, element);
+}
+
+/// Can the assignment of this record type be implement with a simple memory
+/// copy ?
+static bool recordTypeCanBeMemCopied(fir::RecordType recordType) {
+  if (fir::hasDynamicSize(recordType))
+    return false;
+  for (auto [_, fieldType] : recordType.getTypeList()) {
+    // Derived type component may have user assignment (so far, we cannot tell
+    // in FIR, so assume it is always the case, TODO: get the actual info).
+    if (fir::unwrapSequenceType(fieldType).isa<fir::RecordType>())
+      return false;
+    // Allocatable components need deep copy.
+    if (auto boxType = fieldType.dyn_cast<fir::BoxType>())
+      if (boxType.getEleTy().isa<fir::HeapType>())
+        return false;
+  }
+  // Constant size components without user defined assignment and pointers can
+  // be memcopied.
+  return true;
+}
+
+void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
+                                       mlir::Location loc,
+                                       const fir::ExtendedValue &lhs,
+                                       const fir::ExtendedValue &rhs) {
+  assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
+  auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
+  assert(baseTy && "must be a memory type");
+  // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
+  // if the assignment is performed on the dynamic of declared type. Use the
+  // runtime assuming it is performed on the dynamic type.
+  bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BoxType>() ||
+                        fir::getBase(rhs).getType().isa<fir::BoxType>();
+  auto recTy = baseTy.dyn_cast<fir::RecordType>();
+  assert(recTy && "must be a record type");
+  if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {
+    auto to = fir::getBase(builder.createBox(loc, lhs));
+    auto from = fir::getBase(builder.createBox(loc, rhs));
+    // The runtime entry point may modify the LHS descriptor if it is
+    // an allocatable. Allocatable assignment is handle elsewhere in lowering,
+    // so just create a fir.ref<fir.box<>> from the fir.box to comply with the
+    // runtime interface, but assume the fir.box is unchanged.
+    // TODO: does this holds true with polymorphic entities ?
+    auto toMutableBox = builder.createTemporary(loc, to.getType());
+    builder.create<fir::StoreOp>(loc, to, toMutableBox);
+    fir::runtime::genAssign(builder, loc, toMutableBox, from);
+    return;
+  }
+  // Otherwise, the derived type has compile time constant size and for which
+  // the component by component assignment can be replaced by a memory copy.
+  auto load = builder.create<fir::LoadOp>(loc, fir::getBase(rhs));
+  builder.create<fir::StoreOp>(loc, load, fir::getBase(lhs));
+}
+
+mlir::TupleType
+fir::factory::getRaggedArrayHeaderType(fir::FirOpBuilder &builder) {
+  auto i64Ty = builder.getIntegerType(64);
+  auto arrTy = fir::SequenceType::get(builder.getIntegerType(8), 1);
+  auto buffTy = fir::HeapType::get(arrTy);
+  auto extTy = fir::SequenceType::get(i64Ty, 1);
+  auto shTy = fir::HeapType::get(extTy);
+  return mlir::TupleType::get(builder.getContext(), {i64Ty, buffTy, shTy});
+}

flang/lib/Optimizer/Builder/MutableBox.cpp

+//===-- MutableBox.cpp -- MutableBox utilities ----------------------------===//
+//
+// 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/Builder/MutableBox.h"
+#include "flang/Lower/Todo.h"
+#include "flang/Optimizer/Builder/Character.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Dialect/FIROpsSupport.h"
+#include "flang/Optimizer/Support/FatalError.h"
+
+//===----------------------------------------------------------------------===//
+// MutableBoxValue writer and reader
+//===----------------------------------------------------------------------===//
+
+namespace {
+/// MutablePropertyWriter and MutablePropertyReader implementations are the only
+/// places that depend on how the properties of MutableBoxValue (pointers and
+/// allocatables) that can be modified in the lifetime of the entity (address,
+/// extents, lower bounds, length parameters) are represented.
+/// That is, the properties may be only stored in a fir.box in memory if we
+/// need to enforce a single point of truth for the properties across calls.
+/// Or, they can be tracked as independent local variables when it is safe to
+/// do so. Using bare variables benefits from all optimization passes, even
+/// when they are not aware of what a fir.box is and fir.box have not been
+/// optimized out yet.
+
+/// MutablePropertyWriter allows reading the properties of a MutableBoxValue.
+class MutablePropertyReader {
+public:
+  MutablePropertyReader(fir::FirOpBuilder &builder, mlir::Location loc,
+                        const fir::MutableBoxValue &box,
+                        bool forceIRBoxRead = false)
+      : builder{builder}, loc{loc}, box{box} {
+    if (forceIRBoxRead || !box.isDescribedByVariables())
+      irBox = builder.create<fir::LoadOp>(loc, box.getAddr());
+  }
+  /// Get base address of allocated/associated entity.
+  mlir::Value readBaseAddress() {
+    if (irBox) {
+      auto heapOrPtrTy = box.getBoxTy().getEleTy();
+      return builder.create<fir::BoxAddrOp>(loc, heapOrPtrTy, irBox);
+    }
+    auto addrVar = box.getMutableProperties().addr;
+    return builder.create<fir::LoadOp>(loc, addrVar);
+  }
+  /// Return {lbound, extent} values read from the MutableBoxValue given
+  /// the dimension.
+  std::pair<mlir::Value, mlir::Value> readShape(unsigned dim) {
+    auto idxTy = builder.getIndexType();
+    if (irBox) {
+      auto dimVal = builder.createIntegerConstant(loc, idxTy, dim);
+      auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+                                                    irBox, dimVal);
+      return {dimInfo.getResult(0), dimInfo.getResult(1)};
+    }
+    const auto &mutableProperties = box.getMutableProperties();
+    auto lb = builder.create<fir::LoadOp>(loc, mutableProperties.lbounds[dim]);
+    auto ext = builder.create<fir::LoadOp>(loc, mutableProperties.extents[dim]);
+    return {lb, ext};
+  }
+
+  /// Return the character length. If the length was not deferred, the value
+  /// that was specified is returned (The mutable fields is not read).
+  mlir::Value readCharacterLength() {
+    if (box.hasNonDeferredLenParams())
+      return box.nonDeferredLenParams()[0];
+    if (irBox)
+      return fir::factory::CharacterExprHelper{builder, loc}.readLengthFromBox(
+          irBox);
+    const auto &deferred = box.getMutableProperties().deferredParams;
+    if (deferred.empty())
+      fir::emitFatalError(loc, "allocatable entity has no length property");
+    return builder.create<fir::LoadOp>(loc, deferred[0]);
+  }
+
+  /// Read and return all extents. If \p lbounds vector is provided, lbounds are
+  /// also read into it.
+  llvm::SmallVector<mlir::Value>
+  readShape(llvm::SmallVectorImpl<mlir::Value> *lbounds = nullptr) {
+    llvm::SmallVector<mlir::Value> extents;
+    auto rank = box.rank();
+    for (decltype(rank) dim = 0; dim < rank; ++dim) {
+      auto [lb, extent] = readShape(dim);
+      if (lbounds)
+        lbounds->push_back(lb);
+      extents.push_back(extent);
+    }
+    return extents;
+  }
+
+  /// Read all mutable properties. Return the base address.
+  mlir::Value read(llvm::SmallVectorImpl<mlir::Value> &lbounds,
+                   llvm::SmallVectorImpl<mlir::Value> &extents,
+                   llvm::SmallVectorImpl<mlir::Value> &lengths) {
+    extents = readShape(&lbounds);
+    if (box.isCharacter())
+      lengths.emplace_back(readCharacterLength());
+    else if (box.isDerivedWithLengthParameters())
+      TODO(loc, "read allocatable or pointer derived type LEN parameters");
+    return readBaseAddress();
+  }
+
+  /// Return the loaded fir.box.
+  mlir::Value getIrBox() const {
+    assert(irBox);
+    return irBox;
+  }
+
+  /// Read the lower bounds
+  void getLowerBounds(llvm::SmallVectorImpl<mlir::Value> &lbounds) {
+    auto rank = box.rank();
+    for (decltype(rank) dim = 0; dim < rank; ++dim)
+      lbounds.push_back(std::get<0>(readShape(dim)));
+  }
+
+private:
+  fir::FirOpBuilder &builder;
+  mlir::Location loc;
+  fir::MutableBoxValue box;
+  mlir::Value irBox;
+};
+
+/// MutablePropertyWriter allows modifying the properties of a MutableBoxValue.
+class MutablePropertyWriter {
+public:
+  MutablePropertyWriter(fir::FirOpBuilder &builder, mlir::Location loc,
+                        const fir::MutableBoxValue &box)
+      : builder{builder}, loc{loc}, box{box} {}
+  /// Update MutableBoxValue with new address, shape and length parameters.
+  /// Extents and lbounds must all have index type.
+  /// lbounds can be empty in which case all ones is assumed.
+  /// Length parameters must be provided for the length parameters that are
+  /// deferred.
+  void updateMutableBox(mlir::Value addr, mlir::ValueRange lbounds,
+                        mlir::ValueRange extents, mlir::ValueRange lengths) {
+    if (box.isDescribedByVariables())
+      updateMutableProperties(addr, lbounds, extents, lengths);
+    else
+      updateIRBox(addr, lbounds, extents, lengths);
+  }
+
+  /// Update MutableBoxValue with a new fir.box. This requires that the mutable
+  /// box is not described by a set of variables, since they could not describe
+  /// all that can be described in the new fir.box (e.g. non contiguous entity).
+  void updateWithIrBox(mlir::Value newBox) {
+    assert(!box.isDescribedByVariables());
+    builder.create<fir::StoreOp>(loc, newBox, box.getAddr());
+  }
+  /// Set unallocated/disassociated status for the entity described by
+  /// MutableBoxValue. Deallocation is not performed by this helper.
+  void setUnallocatedStatus() {
+    if (box.isDescribedByVariables()) {
+      auto addrVar = box.getMutableProperties().addr;
+      auto nullTy = fir::dyn_cast_ptrEleTy(addrVar.getType());
+      builder.create<fir::StoreOp>(loc, builder.createNullConstant(loc, nullTy),
+                                   addrVar);
+    } else {
+      // Note that the dynamic type of polymorphic entities must be reset to the
+      // declaration type of the mutable box. See Fortran 2018 7.8.2 NOTE 1.
+      // For those, we cannot simply set the address to zero. The way we are
+      // currently unallocating fir.box guarantees that we are resetting the
+      // type to the declared type. Beware if changing this.
+      // Note: the standard is not clear in Deallocate and p => NULL semantics
+      // regarding the new dynamic type the entity must have. So far, assume
+      // this is just like NULLIFY and the dynamic type must be set to the
+      // declared type, not retain the previous dynamic type.
+      auto deallocatedBox = fir::factory::createUnallocatedBox(
+          builder, loc, box.getBoxTy(), box.nonDeferredLenParams());
+      builder.create<fir::StoreOp>(loc, deallocatedBox, box.getAddr());
+    }
+  }
+
+  /// Copy Values from the fir.box into the property variables if any.
+  void syncMutablePropertiesFromIRBox() {
+    if (!box.isDescribedByVariables())
+      return;
+    llvm::SmallVector<mlir::Value> lbounds;
+    llvm::SmallVector<mlir::Value> extents;
+    llvm::SmallVector<mlir::Value> lengths;
+    auto addr =
+        MutablePropertyReader{builder, loc, box, /*forceIRBoxRead=*/true}.read(
+            lbounds, extents, lengths);
+    updateMutableProperties(addr, lbounds, extents, lengths);
+  }
+
+  /// Copy Values from property variables, if any, into the fir.box.
+  void syncIRBoxFromMutableProperties() {
+    if (!box.isDescribedByVariables())
+      return;
+    llvm::SmallVector<mlir::Value> lbounds;
+    llvm::SmallVector<mlir::Value> extents;
+    llvm::SmallVector<mlir::Value> lengths;
+    auto addr = MutablePropertyReader{builder, loc, box}.read(lbounds, extents,
+                                                              lengths);
+    updateIRBox(addr, lbounds, extents, lengths);
+  }
+
+private:
+  /// Update the IR box (fir.ref<fir.box<T>>) of the MutableBoxValue.
+  void updateIRBox(mlir::Value addr, mlir::ValueRange lbounds,
+                   mlir::ValueRange extents, mlir::ValueRange lengths) {
+    mlir::Value shape;
+    if (!extents.empty()) {
+      if (lbounds.empty()) {
+        auto shapeType =
+            fir::ShapeType::get(builder.getContext(), extents.size());
+        shape = builder.create<fir::ShapeOp>(loc, shapeType, extents);
+      } else {
+        llvm::SmallVector<mlir::Value> shapeShiftBounds;
+        for (auto [lb, extent] : llvm::zip(lbounds, extents)) {
+          shapeShiftBounds.emplace_back(lb);
+          shapeShiftBounds.emplace_back(extent);
+        }
+        auto shapeShiftType =
+            fir::ShapeShiftType::get(builder.getContext(), extents.size());
+        shape = builder.create<fir::ShapeShiftOp>(loc, shapeShiftType,
+                                                  shapeShiftBounds);
+      }
+    }
+    mlir::Value emptySlice;
+    // Ignore lengths if already constant in the box type (this would trigger an
+    // error in the embox).
+    llvm::SmallVector<mlir::Value> cleanedLengths;
+    mlir::Value irBox;
+    if (addr.getType().isa<fir::BoxType>()) {
+      // The entity is already boxed.
+      irBox = builder.createConvert(loc, box.getBoxTy(), addr);
+    } else {
+      auto cleanedAddr = addr;
+      if (auto charTy = box.getEleTy().dyn_cast<fir::CharacterType>()) {
+        // Cast address to box type so that both input and output type have
+        // unknown or constant lengths.
+        auto bt = box.getBaseTy();
+        auto addrTy = addr.getType();
+        auto type = addrTy.isa<fir::HeapType>()      ? fir::HeapType::get(bt)
+                    : addrTy.isa<fir::PointerType>() ? fir::PointerType::get(bt)
+                                                     : builder.getRefType(bt);
+        cleanedAddr = builder.createConvert(loc, type, addr);
+        if (charTy.getLen() == fir::CharacterType::unknownLen())
+          cleanedLengths.append(lengths.begin(), lengths.end());
+      } else if (box.isDerivedWithLengthParameters()) {
+        TODO(loc, "updating mutablebox of derived type with length parameters");
+        cleanedLengths = lengths;
+      }
+      irBox = builder.create<fir::EmboxOp>(loc, box.getBoxTy(), cleanedAddr,
+                                           shape, emptySlice, cleanedLengths);
+    }
+    builder.create<fir::StoreOp>(loc, irBox, box.getAddr());
+  }
+
+  /// Update the set of property variables of the MutableBoxValue.
+  void updateMutableProperties(mlir::Value addr, mlir::ValueRange lbounds,
+                               mlir::ValueRange extents,
+                               mlir::ValueRange lengths) {
+    auto castAndStore = [&](mlir::Value val, mlir::Value addr) {
+      auto type = fir::dyn_cast_ptrEleTy(addr.getType());
+      builder.create<fir::StoreOp>(loc, builder.createConvert(loc, type, val),
+                                   addr);
+    };
+    const auto &mutableProperties = box.getMutableProperties();
+    castAndStore(addr, mutableProperties.addr);
+    for (auto [extent, extentVar] :
+         llvm::zip(extents, mutableProperties.extents))
+      castAndStore(extent, extentVar);
+    if (!mutableProperties.lbounds.empty()) {
+      if (lbounds.empty()) {
+        auto one =
+            builder.createIntegerConstant(loc, builder.getIndexType(), 1);
+        for (auto lboundVar : mutableProperties.lbounds)
+          castAndStore(one, lboundVar);
+      } else {
+        for (auto [lbound, lboundVar] :
+             llvm::zip(lbounds, mutableProperties.lbounds))
+          castAndStore(lbound, lboundVar);
+      }
+    }
+    if (box.isCharacter())
+      // llvm::zip account for the fact that the length only needs to be stored
+      // when it is specified in the allocation and deferred in the
+      // MutableBoxValue.
+      for (auto [len, lenVar] :
+           llvm::zip(lengths, mutableProperties.deferredParams))
+        castAndStore(len, lenVar);
+    else if (box.isDerivedWithLengthParameters())
+      TODO(loc, "update allocatable derived type length parameters");
+  }
+  fir::FirOpBuilder &builder;
+  mlir::Location loc;
+  fir::MutableBoxValue box;
+};
+
+} // namespace
+
+mlir::Value
+fir::factory::createUnallocatedBox(fir::FirOpBuilder &builder,
+                                   mlir::Location loc, mlir::Type boxType,
+                                   mlir::ValueRange nonDeferredParams) {
+  auto heapType = boxType.dyn_cast<fir::BoxType>().getEleTy();
+  auto type = fir::dyn_cast_ptrEleTy(heapType);
+  auto eleTy = type;
+  if (auto seqType = eleTy.dyn_cast<fir::SequenceType>())
+    eleTy = seqType.getEleTy();
+  if (auto recTy = eleTy.dyn_cast<fir::RecordType>())
+    if (recTy.getNumLenParams() > 0)
+      TODO(loc, "creating unallocated fir.box of derived type with length "
+                "parameters");
+  auto nullAddr = builder.createNullConstant(loc, heapType);
+  mlir::Value shape;
+  if (auto seqTy = type.dyn_cast<fir::SequenceType>()) {
+    auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0);
+    llvm::SmallVector<mlir::Value> extents(seqTy.getDimension(), zero);
+    shape = builder.createShape(
+        loc, fir::ArrayBoxValue{nullAddr, extents, /*lbounds=*/llvm::None});
+  }
+  // Provide dummy length parameters if they are dynamic. If a length parameter
+  // is deferred. it is set to zero here and will be set on allocation.
+  llvm::SmallVector<mlir::Value> lenParams;
+  if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
+    if (charTy.getLen() == fir::CharacterType::unknownLen()) {
+      if (!nonDeferredParams.empty()) {
+        lenParams.push_back(nonDeferredParams[0]);
+      } else {
+        auto zero = builder.createIntegerConstant(
+            loc, builder.getCharacterLengthType(), 0);
+        lenParams.push_back(zero);
+      }
+    }
+  }
+  mlir::Value emptySlice;
+  return builder.create<fir::EmboxOp>(loc, boxType, nullAddr, shape, emptySlice,
+                                      lenParams);
+}
+
+fir::MutableBoxValue
+fir::factory::createTempMutableBox(fir::FirOpBuilder &builder,
+                                   mlir::Location loc, mlir::Type type,
+                                   llvm::StringRef name) {
+  auto boxType = fir::BoxType::get(fir::HeapType::get(type));
+  auto boxAddr = builder.createTemporary(loc, boxType, name);
+  auto box =
+      fir::MutableBoxValue(boxAddr, /*nonDeferredParams=*/mlir::ValueRange(),
+                           /*mutableProperties=*/{});
+  MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus();
+  return box;
+}
+
+/// Helper to decide if a MutableBoxValue must be read to an BoxValue or
+/// can be read to a reified box value.
+static bool readToBoxValue(const fir::MutableBoxValue &box,
+                           bool mayBePolymorphic) {
+  // If this is described by a set of local variables, the value
+  // should not be tracked as a fir.box.
+  if (box.isDescribedByVariables())
+    return false;
+  // Polymorphism might be a source of discontiguity, even on allocatables.
+  // Track value as fir.box
+  if ((box.isDerived() && mayBePolymorphic) || box.isUnlimitedPolymorphic())
+    return true;
+  // Intrinsic alloctables are contiguous, no need to track the value by
+  // fir.box.
+  if (box.isAllocatable() || box.rank() == 0)
+    return false;
+  // Pointer are known to be contiguous at compile time iff they have the
+  // CONTIGUOUS attribute.
+  return !fir::valueHasFirAttribute(box.getAddr(),
+                                    fir::getContiguousAttrName());
+}
+
+fir::ExtendedValue
+fir::factory::genMutableBoxRead(fir::FirOpBuilder &builder, mlir::Location loc,
+                                const fir::MutableBoxValue &box,
+                                bool mayBePolymorphic) {
+  if (box.hasAssumedRank())
+    TODO(loc, "Assumed rank allocatables or pointers");
+  llvm::SmallVector<mlir::Value> lbounds;
+  llvm::SmallVector<mlir::Value> extents;
+  llvm::SmallVector<mlir::Value> lengths;
+  if (readToBoxValue(box, mayBePolymorphic)) {
+    auto reader = MutablePropertyReader(builder, loc, box);
+    reader.getLowerBounds(lbounds);
+    return fir::BoxValue{reader.getIrBox(), lbounds,
+                         box.nonDeferredLenParams()};
+  }
+  // Contiguous intrinsic type entity: all the data can be extracted from the
+  // fir.box.
+  auto addr =
+      MutablePropertyReader(builder, loc, box).read(lbounds, extents, lengths);
+  auto rank = box.rank();
+  if (box.isCharacter()) {
+    auto len = lengths.empty() ? mlir::Value{} : lengths[0];
+    if (rank)
+      return fir::CharArrayBoxValue{addr, len, extents, lbounds};
+    return fir::CharBoxValue{addr, len};
+  }
+  if (rank)
+    return fir::ArrayBoxValue{addr, extents, lbounds};
+  return addr;
+}
+
+mlir::Value
+fir::factory::genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder,
+                                             mlir::Location loc,
+                                             const fir::MutableBoxValue &box) {
+  auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();
+  return builder.genIsNotNull(loc, addr);
+}
+
+/// Generate finalizer call and inlined free. This does not check that the
+/// address was allocated.
+static void genFinalizeAndFree(fir::FirOpBuilder &builder, mlir::Location loc,
+                               mlir::Value addr) {
+  // TODO: call finalizer if any.
+
+  // A heap (ALLOCATABLE) object may have been converted to a ptr (POINTER),
+  // so make sure the heap type is restored before deallocation.
+  auto cast = builder.createConvert(
+      loc, fir::HeapType::get(fir::dyn_cast_ptrEleTy(addr.getType())), addr);
+  builder.create<fir::FreeMemOp>(loc, cast);
+}
+
+void fir::factory::genFinalization(fir::FirOpBuilder &builder,
+                                   mlir::Location loc,
+                                   const fir::MutableBoxValue &box) {
+  auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();
+  auto isAllocated = builder.genIsNotNull(loc, addr);
+  auto ifOp = builder.create<fir::IfOp>(loc, isAllocated,
+                                        /*withElseRegion=*/false);
+  auto insPt = builder.saveInsertionPoint();
+  builder.setInsertionPointToStart(&ifOp.thenRegion().front());
+  genFinalizeAndFree(builder, loc, addr);
+  builder.restoreInsertionPoint(insPt);
+}
+
+//===----------------------------------------------------------------------===//
+// MutableBoxValue writing interface implementation
+//===----------------------------------------------------------------------===//
+
+void fir::factory::associateMutableBox(fir::FirOpBuilder &builder,
+                                       mlir::Location loc,
+                                       const fir::MutableBoxValue &box,
+                                       const fir::ExtendedValue &source,
+                                       mlir::ValueRange lbounds) {
+  MutablePropertyWriter writer(builder, loc, box);
+  source.match(
+      [&](const fir::UnboxedValue &addr) {
+        writer.updateMutableBox(addr, /*lbounds=*/llvm::None,
+                                /*extents=*/llvm::None, /*lengths=*/llvm::None);
+      },
+      [&](const fir::CharBoxValue &ch) {
+        writer.updateMutableBox(ch.getAddr(), /*lbounds=*/llvm::None,
+                                /*extents=*/llvm::None, {ch.getLen()});
+      },
+      [&](const fir::ArrayBoxValue &arr) {
+        writer.updateMutableBox(arr.getAddr(),
+                                lbounds.empty() ? arr.getLBounds() : lbounds,
+                                arr.getExtents(), /*lengths=*/llvm::None);
+      },
+      [&](const fir::CharArrayBoxValue &arr) {
+        writer.updateMutableBox(arr.getAddr(),
+                                lbounds.empty() ? arr.getLBounds() : lbounds,
+                                arr.getExtents(), {arr.getLen()});
+      },
+      [&](const fir::BoxValue &arr) {
+        // Rebox array fir.box to the pointer type and apply potential new lower
+        // bounds.
+        mlir::ValueRange newLbounds = lbounds.empty()
+                                          ? mlir::ValueRange{arr.getLBounds()}
+                                          : mlir::ValueRange{lbounds};
+        if (box.isDescribedByVariables()) {
+          // LHS is a contiguous pointer described by local variables. Open RHS
+          // fir.box to update the LHS.
+          auto rawAddr = builder.create<fir::BoxAddrOp>(loc, arr.getMemTy(),
+                                                        arr.getAddr());
+          auto extents = fir::factory::getExtents(builder, loc, source);
+          llvm::SmallVector<mlir::Value> lenParams;
+          if (arr.isCharacter()) {
+            lenParams.emplace_back(
+                fir::factory::readCharLen(builder, loc, source));
+          } else if (arr.isDerivedWithLengthParameters()) {
+            TODO(loc, "pointer assignment to derived with length parameters");
+          }
+          writer.updateMutableBox(rawAddr, newLbounds, extents, lenParams);
+        } else {
+          mlir::Value shift;
+          if (!newLbounds.empty()) {
+            auto shiftType =
+                fir::ShiftType::get(builder.getContext(), newLbounds.size());
+            shift = builder.create<fir::ShiftOp>(loc, shiftType, newLbounds);
+          }
+          auto reboxed =
+              builder.create<fir::ReboxOp>(loc, box.getBoxTy(), arr.getAddr(),
+                                           shift, /*slice=*/mlir::Value());
+          writer.updateWithIrBox(reboxed);
+        }
+      },
+      [&](const fir::MutableBoxValue &) {
+        // No point implementing this, if right-hand side is a
+        // pointer/allocatable, the related MutableBoxValue has been read into
+        // another ExtendedValue category.
+        fir::emitFatalError(loc,
+                            "Cannot write MutableBox to another MutableBox");
+      },
+      [&](const fir::ProcBoxValue &) {
+        TODO(loc, "Procedure pointer assignment");
+      });
+}
+
+void fir::factory::associateMutableBoxWithRemap(
+    fir::FirOpBuilder &builder, mlir::Location loc,
+    const fir::MutableBoxValue &box, const fir::ExtendedValue &source,
+    mlir::ValueRange lbounds, mlir::ValueRange ubounds) {
+  // Compute new extents
+  llvm::SmallVector<mlir::Value> extents;
+  auto idxTy = builder.getIndexType();
+  if (!lbounds.empty()) {
+    auto one = builder.createIntegerConstant(loc, idxTy, 1);
+    for (auto [lb, ub] : llvm::zip(lbounds, ubounds)) {
+      auto lbi = builder.createConvert(loc, idxTy, lb);
+      auto ubi = builder.createConvert(loc, idxTy, ub);
+      auto diff = builder.create<arith::SubIOp>(loc, idxTy, ubi, lbi);
+      extents.emplace_back(
+          builder.create<arith::AddIOp>(loc, idxTy, diff, one));
+    }
+  } else {
+    // lbounds are default. Upper bounds and extents are the same.
+    for (auto ub : ubounds) {
+      auto cast = builder.createConvert(loc, idxTy, ub);
+      extents.emplace_back(cast);
+    }
+  }
+  const auto newRank = extents.size();
+  auto cast = [&](mlir::Value addr) -> mlir::Value {
+    // Cast base addr to new sequence type.
+    auto ty = fir::dyn_cast_ptrEleTy(addr.getType());
+    if (auto seqTy = ty.dyn_cast<fir::SequenceType>()) {
+      fir::SequenceType::Shape shape(newRank,
+                                     fir::SequenceType::getUnknownExtent());
+      ty = fir::SequenceType::get(shape, seqTy.getEleTy());
+    }
+    return builder.createConvert(loc, builder.getRefType(ty), addr);
+  };
+  MutablePropertyWriter writer(builder, loc, box);
+  source.match(
+      [&](const fir::UnboxedValue &addr) {
+        writer.updateMutableBox(cast(addr), lbounds, extents,
+                                /*lengths=*/llvm::None);
+      },
+      [&](const fir::CharBoxValue &ch) {
+        writer.updateMutableBox(cast(ch.getAddr()), lbounds, extents,
+                                {ch.getLen()});
+      },
+      [&](const fir::ArrayBoxValue &arr) {
+        writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents,
+                                /*lengths=*/llvm::None);
+      },
+      [&](const fir::CharArrayBoxValue &arr) {
+        writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents,
+                                {arr.getLen()});
+      },
+      [&](const fir::BoxValue &arr) {
+        // Rebox right-hand side fir.box with a new shape and type.
+        if (box.isDescribedByVariables()) {
+          // LHS is a contiguous pointer described by local variables. Open RHS
+          // fir.box to update the LHS.
+          auto rawAddr = builder.create<fir::BoxAddrOp>(loc, arr.getMemTy(),
+                                                        arr.getAddr());
+          llvm::SmallVector<mlir::Value> lenParams;
+          if (arr.isCharacter()) {
+            lenParams.emplace_back(
+                fir::factory::readCharLen(builder, loc, source));
+          } else if (arr.isDerivedWithLengthParameters()) {
+            TODO(loc, "pointer assignment to derived with length parameters");
+          }
+          writer.updateMutableBox(rawAddr, lbounds, extents, lenParams);
+        } else {
+          auto shapeType =
+              fir::ShapeShiftType::get(builder.getContext(), extents.size());
+          llvm::SmallVector<mlir::Value> shapeArgs;
+          auto idxTy = builder.getIndexType();
+          for (auto [lbnd, ext] : llvm::zip(lbounds, extents)) {
+            auto lb = builder.createConvert(loc, idxTy, lbnd);
+            shapeArgs.push_back(lb);
+            shapeArgs.push_back(ext);
+          }
+          auto shape =
+              builder.create<fir::ShapeShiftOp>(loc, shapeType, shapeArgs);
+          auto reboxed =
+              builder.create<fir::ReboxOp>(loc, box.getBoxTy(), arr.getAddr(),
+                                           shape, /*slice=*/mlir::Value());
+          writer.updateWithIrBox(reboxed);
+        }
+      },
+      [&](const fir::MutableBoxValue &) {
+        // No point implementing this, if right-hand side is a pointer or
+        // allocatable, the related MutableBoxValue has already been read into
+        // another ExtendedValue category.
+        fir::emitFatalError(loc,
+                            "Cannot write MutableBox to another MutableBox");
+      },
+      [&](const fir::ProcBoxValue &) {
+        TODO(loc, "Procedure pointer assignment");
+      });
+}
+
+void fir::factory::disassociateMutableBox(fir::FirOpBuilder &builder,
+                                          mlir::Location loc,
+                                          const fir::MutableBoxValue &box) {
+  MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus();
+}
+
+void fir::factory::genInlinedAllocation(fir::FirOpBuilder &builder,
+                                        mlir::Location loc,
+                                        const fir::MutableBoxValue &box,
+                                        mlir::ValueRange lbounds,
+                                        mlir::ValueRange extents,
+                                        mlir::ValueRange lenParams,
+                                        llvm::StringRef allocName) {
+  auto idxTy = builder.getIndexType();
+  llvm::SmallVector<mlir::Value> lengths;
+  if (auto charTy = box.getEleTy().dyn_cast<fir::CharacterType>()) {
+    if (charTy.getLen() == fir::CharacterType::unknownLen()) {
+      if (box.hasNonDeferredLenParams())
+        lengths.emplace_back(
+            builder.createConvert(loc, idxTy, box.nonDeferredLenParams()[0]));
+      else if (!lenParams.empty())
+        lengths.emplace_back(builder.createConvert(loc, idxTy, lenParams[0]));
+      else
+        fir::emitFatalError(
+            loc, "could not deduce character lengths in character allocation");
+    }
+  }
+  mlir::Value heap = builder.create<fir::AllocMemOp>(
+      loc, box.getBaseTy(), allocName, lengths, extents);
+  // TODO: run initializer if any. Currently, there is no way to know this is
+  // required here.
+  MutablePropertyWriter{builder, loc, box}.updateMutableBox(heap, lbounds,
+                                                            extents, lengths);
+}
+
+void fir::factory::genInlinedDeallocate(fir::FirOpBuilder &builder,
+                                        mlir::Location loc,
+                                        const fir::MutableBoxValue &box) {
+  auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress();
+  genFinalizeAndFree(builder, loc, addr);
+  MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus();
+}
+
+void fir::factory::genReallocIfNeeded(fir::FirOpBuilder &builder,
+                                      mlir::Location loc,
+                                      const fir::MutableBoxValue &box,
+                                      mlir::ValueRange lbounds,
+                                      mlir::ValueRange shape,
+                                      mlir::ValueRange lengthParams) {
+  // Implement 10.2.1.3 point 3 logic when lhs is an array.
+  auto reader = MutablePropertyReader(builder, loc, box);
+  auto addr = reader.readBaseAddress();
+  auto isAllocated = builder.genIsNotNull(loc, addr);
+  builder.genIfThenElse(loc, isAllocated)
+      .genThen([&]() {
+        // The box is allocated. Check if it must be reallocated and reallocate.
+        mlir::Value mustReallocate = builder.createBool(loc, false);
+        auto compareProperty = [&](mlir::Value previous, mlir::Value required) {
+          auto castPrevious =
+              builder.createConvert(loc, required.getType(), previous);
+          // reallocate = reallocate || previous != required
+          auto cmp = builder.create<arith::CmpIOp>(
+              loc, arith::CmpIPredicate::ne, castPrevious, required);
+          mustReallocate =
+              builder.create<mlir::SelectOp>(loc, cmp, cmp, mustReallocate);
+        };
+        llvm::SmallVector<mlir::Value> previousLbounds;
+        llvm::SmallVector<mlir::Value> previousExtents =
+            reader.readShape(&previousLbounds);
+        if (!shape.empty())
+          for (auto [previousExtent, requested] :
+               llvm::zip(previousExtents, shape))
+            compareProperty(previousExtent, requested);
+
+        if (box.isCharacter() && !box.hasNonDeferredLenParams()) {
+          // When the allocatable length is not deferred, it must not be
+          // reallocated in case of length mismatch, instead, padding/trimming
+          // will ocur in later assignment to it.
+          assert(!lengthParams.empty() &&
+                 "must provide length parameters for character");
+          compareProperty(reader.readCharacterLength(), lengthParams[0]);
+        } else if (box.isDerivedWithLengthParameters()) {
+          TODO(loc,
+               "automatic allocation of derived type allocatable with length "
+               "parameters");
+        }
+        builder.genIfThen(loc, mustReallocate)
+            .genThen([&]() {
+              // If shape or length mismatch, deallocate and reallocate.
+              genFinalizeAndFree(builder, loc, addr);
+              // When rhs is a scalar, keep the previous shape
+              auto extents =
+                  shape.empty() ? mlir::ValueRange(previousExtents) : shape;
+              auto lbs =
+                  shape.empty() ? mlir::ValueRange(previousLbounds) : lbounds;
+              genInlinedAllocation(builder, loc, box, lbs, extents,
+                                   lengthParams, ".auto.alloc");
+            })
+            .end();
+      })
+      .genElse([&]() {
+        // The box is not yet allocated, simply allocate it.
+        if (shape.empty() && box.rank() != 0) {
+          // TODO:
+          // runtime error: right hand side must be allocated if right hand
+          // side is a scalar and the box is an array.
+        } else {
+          genInlinedAllocation(builder, loc, box, lbounds, shape, lengthParams,
+                               ".auto.alloc");
+        }
+      })
+      .end();
+}
+
+//===----------------------------------------------------------------------===//
+// MutableBoxValue syncing implementation
+//===----------------------------------------------------------------------===//
+
+/// Depending on the implementation, allocatable/pointer descriptor and the
+/// MutableBoxValue need to be synced before and after calls passing the
+/// descriptor. These calls will generate the syncing if needed and be no-op
+mlir::Value fir::factory::getMutableIRBox(fir::FirOpBuilder &builder,
+                                          mlir::Location loc,
+                                          const fir::MutableBoxValue &box) {
+  MutablePropertyWriter{builder, loc, box}.syncIRBoxFromMutableProperties();
+  return box.getAddr();
+}
+void fir::factory::syncMutableBoxFromIRBox(fir::FirOpBuilder &builder,
+                                           mlir::Location loc,
+                                           const fir::MutableBoxValue &box) {
+  MutablePropertyWriter{builder, loc, box}.syncMutablePropertiesFromIRBox();
+}

flang/lib/Optimizer/Builder/Runtime/Assign.cpp

+//===-- Assign.cpp -- generate assignment runtime API calls ---------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Builder/Runtime/Assign.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Runtime/assign.h"
+
+using namespace Fortran::runtime;
+
+void fir::runtime::genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
+                             mlir::Value destBox, mlir::Value sourceBox) {
+  auto func = fir::runtime::getRuntimeFunc<mkRTKey(Assign)>(loc, builder);
+  auto fTy = func.getType();
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
+  auto args = fir::runtime::createArguments(builder, loc, fTy, destBox,
+                                            sourceBox, sourceFile, sourceLine);
+  builder.create<fir::CallOp>(loc, func, args);
+}

flang/lib/Optimizer/Dialect/FIROps.cpp

static mlir::LogicalResult verify(fir::GenTypeDescOp &op) {
   }
   return mlir::success();
 }
 
 //===----------------------------------------------------------------------===//
 // GlobalOp
 //===----------------------------------------------------------------------===//
 
+mlir::Type fir::GlobalOp::resultType() {
+  return wrapAllocaResultType(getType());
+}
+
 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 mlir::failure();
     mlir::StringAttr linkAttr = builder.getStringAttr(linkage);
static mlir::ArrayAttr collectAsAttributes(mlir::MLIRContext *ctxt,
   assert(!attrs.empty());
   return mlir::ArrayAttr::get(ctxt, attrs);
 }
 
 //===----------------------------------------------------------------------===//
 // GlobalLenOp
 //===----------------------------------------------------------------------===//
 
-mlir::Type fir::GlobalOp::resultType() {
-  return wrapAllocaResultType(getType());
-}
-
 static mlir::ParseResult parseGlobalLenOp(mlir::OpAsmParser &parser,
                                           mlir::OperationState &result) {
   llvm::StringRef fieldName;
   if (failed(parser.parseOptionalKeyword(&fieldName))) {
     mlir::StringAttr fieldAttr;
     if (parser.parseAttribute(fieldAttr, fir::GlobalLenOp::lenParamAttrName(),
                               result.attributes))
       return mlir::failure();

flang/lib/Optimizer/Dialect/FIRType.cpp

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) &&
            llvm::all_of(funcType.getResults(), isa_fir_or_std_type);
   return isa_fir_type(t) || isa_std_type(t);
 }
 
 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(); })
+      .Case<fir::ReferenceType, fir::PointerType, fir::HeapType,
+            fir::LLVMPointerType>([](auto p) { return p.getEleTy(); })
       .Default([](mlir::Type) { return mlir::Type{}; });
 }
 
 mlir::Type dyn_cast_ptrOrBoxEleTy(mlir::Type t) {
   return llvm::TypeSwitch<mlir::Type, mlir::Type>(t)
-      .Case<fir::ReferenceType, fir::PointerType, fir::HeapType>(
-          [](auto p) { return p.getEleTy(); })
+      .Case<fir::ReferenceType, fir::PointerType, fir::HeapType,
+            fir::LLVMPointerType>([](auto p) { return p.getEleTy(); })
       .Case<fir::BoxType>([](auto p) {
         auto eleTy = p.getEleTy();
         if (auto ty = fir::dyn_cast_ptrEleTy(eleTy))
           return ty;
         return eleTy;
       })
       .Default([](mlir::Type) { return mlir::Type{}; });
 }
mlir::Type fir::LogicalType::parse(mlir::DialectAsmParser &parser) {
   return parseKindSingleton<fir::LogicalType>(parser);
 }
 
 void fir::LogicalType::print(mlir::DialectAsmPrinter &printer) const {
   printer << getMnemonic() << "<" << getFKind() << '>';
 }
 
 //===----------------------------------------------------------------------===//
+// LLVMPointerType
+//===----------------------------------------------------------------------===//
+
+// `llvm_ptr` `<` type `>`
+mlir::Type fir::LLVMPointerType::parse(mlir::DialectAsmParser &parser) {
+  return parseTypeSingleton<fir::LLVMPointerType>(parser);
+}
+
+void fir::LLVMPointerType::print(mlir::DialectAsmPrinter &printer) const {
+  printer << getMnemonic() << "<" << getEleTy() << '>';
+}
+
+//===----------------------------------------------------------------------===//
 // PointerType
 //===----------------------------------------------------------------------===//
 
 // `ptr` `<` type `>`
 mlir::Type fir::PointerType::parse(mlir::DialectAsmParser &parser) {
   return parseTypeSingleton<fir::PointerType>(parser);
 }
 

 
 //===----------------------------------------------------------------------===//
 // FIROpsDialect
 //===----------------------------------------------------------------------===//
 
 void FIROpsDialect::registerTypes() {
   addTypes<BoxType, BoxCharType, BoxProcType, CharacterType, fir::ComplexType,
            FieldType, HeapType, fir::IntegerType, LenType, LogicalType,
-           PointerType, RealType, RecordType, ReferenceType, SequenceType,
-           ShapeType, ShapeShiftType, ShiftType, SliceType, TypeDescType,
-           fir::VectorType>();
+           LLVMPointerType, PointerType, RealType, RecordType, ReferenceType,
+           SequenceType, ShapeType, ShapeShiftType, ShiftType, SliceType,
+           TypeDescType, fir::VectorType>();
 }

flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp

+//===-- ArrayValueCopy.cpp ------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "PassDetail.h"
+#include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Dialect/FIRDialect.h"
+#include "flang/Optimizer/Support/FIRContext.h"
+#include "flang/Optimizer/Transforms/Factory.h"
+#include "flang/Optimizer/Transforms/Passes.h"
+#include "mlir/Dialect/SCF/SCF.h"
+#include "mlir/Transforms/DialectConversion.h"
+#include "llvm/Support/Debug.h"
+
+#define DEBUG_TYPE "flang-array-value-copy"
+
+using namespace fir;
+
+using OperationUseMapT = llvm::DenseMap<mlir::Operation *, mlir::Operation *>;
+
+namespace {
+
+/// Array copy analysis.
+/// Perform an interference analysis between array values.
+///
+/// Lowering will generate a sequence of the following form.
+/// ```mlir
+///   %a_1 = fir.array_load %array_1(%shape) : ...
+///   ...
+///   %a_j = fir.array_load %array_j(%shape) : ...
+///   ...
+///   %a_n = fir.array_load %array_n(%shape) : ...
+///     ...
+///     %v_i = fir.array_fetch %a_i, ...
+///     %a_j1 = fir.array_update %a_j, ...
+///     ...
+///   fir.array_merge_store %a_j, %a_jn to %array_j : ...
+/// ```
+///
+/// The analysis is to determine if there are any conflicts. A conflict is when
+/// one the following cases occurs.
+///
+/// 1. There is an `array_update` to an array value, a_j, such that a_j was
+/// loaded from the same array memory reference (array_j) but with a different
+/// shape as the other array values a_i, where i != j. [Possible overlapping
+/// arrays.]
+///
+/// 2. There is either an array_fetch or array_update of a_j with a different
+/// set of index values. [Possible loop-carried dependence.]
+///
+/// If none of the array values overlap in storage and the accesses are not
+/// loop-carried, then the arrays are conflict-free and no copies are required.
+class ArrayCopyAnalysis {
+public:
+  using ConflictSetT = llvm::SmallPtrSet<mlir::Operation *, 16>;
+  using UseSetT = llvm::SmallPtrSet<mlir::OpOperand *, 8>;
+  using LoadMapSetsT = llvm::DenseMap<mlir::Operation *, UseSetT>;
+
+  ArrayCopyAnalysis(mlir::Operation *op) : operation{op} {
+    construct(op->getRegions());
+  }
+
+  mlir::Operation *getOperation() const { return operation; }
+
+  /// Return true iff the `array_merge_store` has potential conflicts.
+  bool hasPotentialConflict(mlir::Operation *op) const {
+    LLVM_DEBUG(llvm::dbgs()
+               << "looking for a conflict on " << *op
+               << " and the set has a total of " << conflicts.size() << '\n');
+    return conflicts.contains(op);
+  }
+
+  /// Return the use map. The use map maps array fetch and update operations
+  /// back to the array load that is the original source of the array value.
+  const OperationUseMapT &getUseMap() const { return useMap; }
+
+  /// For ArrayLoad `load`, return the transitive set of all OpOperands.
+  UseSetT getLoadUseSet(mlir::Operation *load) const {
+    assert(loadMapSets.count(load) && "analysis missed an array load?");
+    return loadMapSets.lookup(load);
+  }
+
+  /// Get all the array value operations that use the original array value
+  /// as passed to `store`.
+  void arrayAccesses(llvm::SmallVectorImpl<mlir::Operation *> &accesses,
+                     ArrayLoadOp load);
+
+private:
+  void construct(mlir::MutableArrayRef<mlir::Region> regions);
+
+  mlir::Operation *operation; // operation that analysis ran upon
+  ConflictSetT conflicts;     // set of conflicts (loads and merge stores)
+  OperationUseMapT useMap;
+  LoadMapSetsT loadMapSets;
+};
+} // namespace
+
+namespace {
+/// Helper class to collect all array operations that produced an array value.
+class ReachCollector {
+public:
+  ReachCollector(llvm::SmallVectorImpl<mlir::Operation *> &reach,
+                 mlir::Region *loopRegion)
+      : reach{reach}, loopRegion{loopRegion} {}
+
+  void collectArrayAccessFrom(mlir::Operation *op, mlir::ValueRange range) {
+    if (range.empty()) {
+      collectArrayAccessFrom(op, mlir::Value{});
+      return;
+    }
+    for (auto v : range)
+      collectArrayAccessFrom(v);
+  }
+
+  void collectArrayAccessFrom(mlir::Operation *op, mlir::Value val) {
+    // `val` is defined by an Op, process the defining Op.
+    // If `val` is defined by a region containing Op, we want to drill down
+    // and through that Op's region(s).
+    LLVM_DEBUG(llvm::dbgs() << "popset: " << *op << '\n');
+    auto popFn = [&](auto rop) {
+      assert(val && "op must have a result value");
+      auto resNum = val.cast<mlir::OpResult>().getResultNumber();
+      llvm::SmallVector<mlir::Value> results;
+      rop.resultToSourceOps(results, resNum);
+      for (auto u : results)
+        collectArrayAccessFrom(u);
+    };
+    if (auto rop = mlir::dyn_cast<DoLoopOp>(op)) {
+      popFn(rop);
+      return;
+    }
+    if (auto rop = mlir::dyn_cast<IterWhileOp>(op)) {
+      popFn(rop);
+      return;
+    }
+    if (auto rop = mlir::dyn_cast<fir::IfOp>(op)) {
+      popFn(rop);
+      return;
+    }
+    if (auto box = mlir::dyn_cast<EmboxOp>(op)) {
+      for (auto *user : box.memref().getUsers())
+        if (user != op)
+          collectArrayAccessFrom(user, user->getResults());
+      return;
+    }
+    if (auto mergeStore = mlir::dyn_cast<ArrayMergeStoreOp>(op)) {
+      if (opIsInsideLoops(mergeStore))
+        collectArrayAccessFrom(mergeStore.sequence());
+      return;
+    }
+
+    if (mlir::isa<AllocaOp, AllocMemOp>(op)) {
+      // Look for any stores inside the loops, and collect an array operation
+      // that produced the value being stored to it.
+      for (auto *user : op->getUsers())
+        if (auto store = mlir::dyn_cast<fir::StoreOp>(user))
+          if (opIsInsideLoops(store))
+            collectArrayAccessFrom(store.value());
+      return;
+    }
+
+    // Otherwise, Op does not contain a region so just chase its operands.
+    if (mlir::isa<ArrayLoadOp, ArrayUpdateOp, ArrayModifyOp, ArrayFetchOp>(
+            op)) {
+      LLVM_DEBUG(llvm::dbgs() << "add " << *op << " to reachable set\n");
+      reach.emplace_back(op);
+    }
+    // Array modify assignment is performed on the result. So the analysis
+    // must look at the what is done with the result.
+    if (mlir::isa<ArrayModifyOp>(op))
+      for (auto *user : op->getResult(0).getUsers())
+        followUsers(user);
+
+    for (auto u : op->getOperands())
+      collectArrayAccessFrom(u);
+  }
+
+  void collectArrayAccessFrom(mlir::BlockArgument ba) {
+    auto *parent = ba.getOwner()->getParentOp();
+    // If inside an Op holding a region, the block argument corresponds to an
+    // argument passed to the containing Op.
+    auto popFn = [&](auto rop) {
+      collectArrayAccessFrom(rop.blockArgToSourceOp(ba.getArgNumber()));
+    };
+    if (auto rop = mlir::dyn_cast<DoLoopOp>(parent)) {
+      popFn(rop);
+      return;
+    }
+    if (auto rop = mlir::dyn_cast<IterWhileOp>(parent)) {
+      popFn(rop);
+      return;
+    }
+    // Otherwise, a block argument is provided via the pred blocks.
+    for (auto *pred : ba.getOwner()->getPredecessors()) {
+      auto u = pred->getTerminator()->getOperand(ba.getArgNumber());
+      collectArrayAccessFrom(u);
+    }
+  }
+
+  // Recursively trace operands to find all array operations relating to the
+  // values merged.
+  void collectArrayAccessFrom(mlir::Value val) {
+    if (!val || visited.contains(val))
+      return;
+    visited.insert(val);
+
+    // Process a block argument.
+    if (auto ba = val.dyn_cast<mlir::BlockArgument>()) {
+      collectArrayAccessFrom(ba);
+      return;
+    }
+
+    // Process an Op.
+    if (auto *op = val.getDefiningOp()) {
+      collectArrayAccessFrom(op, val);
+      return;
+    }
+
+    fir::emitFatalError(val.getLoc(), "unhandled value");
+  }
+
+  /// Return all ops that produce the array value that is stored into the
+  /// `array_merge_store`.
+  static void reachingValues(llvm::SmallVectorImpl<mlir::Operation *> &reach,
+                             mlir::Value seq) {
+    reach.clear();
+    mlir::Region *loopRegion = nullptr;
+    if (auto doLoop =
+            mlir::dyn_cast_or_null<fir::DoLoopOp>(seq.getDefiningOp()))
+      loopRegion = &doLoop->getRegion(0);
+    ReachCollector collector(reach, loopRegion);
+    collector.collectArrayAccessFrom(seq);
+  }
+
+private:
+  /// Is \op inside the loop nest region ?
+  /// FIXME: replace this structural dependence with graph properties.
+  bool opIsInsideLoops(mlir::Operation *op) const {
+    auto *region = op->getParentRegion();
+    while (region) {
+      if (region == loopRegion)
+        return true;
+      region = region->getParentRegion();
+    }
+    return false;
+  }
+
+  /// Recursively trace the use of an operation results, calling
+  /// collectArrayAccessFrom on the direct and indirect user operands.
+  void followUsers(mlir::Operation *op) {
+    for (auto userOperand : op->getOperands())
+      collectArrayAccessFrom(userOperand);
+    // Go through potential converts/coordinate_op.
+    for (auto indirectUser : op->getUsers())
+      followUsers(indirectUser);
+  }
+
+  llvm::SmallVectorImpl<mlir::Operation *> &reach;
+  llvm::SmallPtrSet<mlir::Value, 16> visited;
+  /// Region of the loops nest that produced the array value.
+  mlir::Region *loopRegion;
+};
+} // namespace
+
+/// Find all the array operations that access the array value that is loaded by
+/// the array load operation, `load`.
+void ArrayCopyAnalysis::arrayAccesses(
+    llvm::SmallVectorImpl<mlir::Operation *> &accesses, ArrayLoadOp load) {
+  accesses.clear();
+  auto lmIter = loadMapSets.find(load);
+  if (lmIter != loadMapSets.end()) {
+    for (auto *opnd : lmIter->second) {
+      auto *owner = opnd->getOwner();
+      if (mlir::isa<ArrayFetchOp, ArrayUpdateOp, ArrayModifyOp>(owner))
+        accesses.push_back(owner);
+    }
+    return;
+  }
+
+  UseSetT visited;
+  llvm::SmallVector<mlir::OpOperand *> queue; // uses of ArrayLoad[orig]
+
+  auto appendToQueue = [&](mlir::Value val) {
+    for (auto &use : val.getUses())
+      if (!visited.count(&use)) {
+        visited.insert(&use);
+        queue.push_back(&use);
+      }
+  };
+
+  // Build the set of uses of `original`.
+  // let USES = { uses of original fir.load }
+  appendToQueue(load);
+
+  // Process the worklist until done.
+  while (!queue.empty()) {
+    auto *operand = queue.pop_back_val();
+    auto *owner = operand->getOwner();
+    if (!owner)
+      continue;
+    auto structuredLoop = [&](auto ro) {
+      if (auto blockArg = ro.iterArgToBlockArg(operand->get())) {
+        auto arg = blockArg.getArgNumber();
+        auto output = ro.getResult(ro.finalValue() ? arg : arg - 1);
+        appendToQueue(output);
+        appendToQueue(blockArg);
+      }
+    };
+    auto branchOp = [&](mlir::Block *dest, auto operands) {
+      for (auto i : llvm::enumerate(operands))
+        if (operand->get() == i.value()) {
+          auto blockArg = dest->getArgument(i.index());
+          appendToQueue(blockArg);
+        }
+    };
+    // Thread uses into structured loop bodies and return value uses.
+    if (auto ro = mlir::dyn_cast<DoLoopOp>(owner)) {
+      structuredLoop(ro);
+    } else if (auto ro = mlir::dyn_cast<IterWhileOp>(owner)) {
+      structuredLoop(ro);
+    } else if (auto rs = mlir::dyn_cast<ResultOp>(owner)) {
+      // Thread any uses of fir.if that return the marked array value.
+      auto *parent = rs->getParentRegion()->getParentOp();
+      if (auto ifOp = mlir::dyn_cast<fir::IfOp>(parent))
+        appendToQueue(ifOp.getResult(operand->getOperandNumber()));
+    } else if (mlir::isa<ArrayFetchOp>(owner)) {
+      // Keep track of array value fetches.
+      LLVM_DEBUG(llvm::dbgs()
+                 << "add fetch {" << *owner << "} to array value set\n");
+      accesses.push_back(owner);
+    } else if (auto update = mlir::dyn_cast<ArrayUpdateOp>(owner)) {
+      // Keep track of array value updates and thread the return value uses.
+      LLVM_DEBUG(llvm::dbgs()
+                 << "add update {" << *owner << "} to array value set\n");
+      accesses.push_back(owner);
+      appendToQueue(update.getResult());
+    } else if (auto update = mlir::dyn_cast<ArrayModifyOp>(owner)) {
+      // Keep track of array value modification and thread the return value
+      // uses.
+      LLVM_DEBUG(llvm::dbgs()
+                 << "add modify {" << *owner << "} to array value set\n");
+      accesses.push_back(owner);
+      appendToQueue(update.getResult(1));
+    } else if (auto br = mlir::dyn_cast<mlir::BranchOp>(owner)) {
+      branchOp(br.getDest(), br.destOperands());
+    } else if (auto br = mlir::dyn_cast<mlir::CondBranchOp>(owner)) {
+      branchOp(br.getTrueDest(), br.getTrueOperands());
+      branchOp(br.getFalseDest(), br.getFalseOperands());
+    } else if (mlir::isa<ArrayMergeStoreOp>(owner)) {
+      // do nothing
+    } else {
+      llvm::report_fatal_error("array value reached unexpected op");
+    }
+  }
+  loadMapSets.insert({load, visited});
+}
+
+/// Is there a conflict between the array value that was updated and to be
+/// stored to `st` and the set of arrays loaded (`reach`) and used to compute
+/// the updated value?
+static bool conflictOnLoad(llvm::ArrayRef<mlir::Operation *> reach,
+                           ArrayMergeStoreOp st) {
+  mlir::Value load;
+  auto addr = st.memref();
+  auto stEleTy = fir::dyn_cast_ptrOrBoxEleTy(addr.getType());
+  for (auto *op : reach)
+    if (auto ld = mlir::dyn_cast<ArrayLoadOp>(op)) {
+      auto ldTy = ld.memref().getType();
+      if (auto boxTy = ldTy.dyn_cast<fir::BoxType>())
+        ldTy = boxTy.getEleTy();
+      if (ldTy.isa<fir::PointerType>() && stEleTy == dyn_cast_ptrEleTy(ldTy))
+        return true;
+      if (ld.memref() == addr) {
+        if (ld.getResult() != st.original())
+          return true;
+        if (load)
+          return true;
+        load = ld;
+      }
+    }
+  return false;
+}
+
+static bool conflictOnMerge(llvm::ArrayRef<mlir::Operation *> accesses) {
+  if (accesses.size() < 2)
+    return false;
+  llvm::SmallVector<mlir::Value> indices;
+  LLVM_DEBUG(llvm::dbgs() << "check merge conflict on with " << accesses.size()
+                          << " accesses on the list\n");
+  for (auto *op : accesses) {
+    llvm::SmallVector<mlir::Value> compareVector;
+    if (auto u = mlir::dyn_cast<ArrayUpdateOp>(op)) {
+      if (indices.empty()) {
+        indices = u.indices();
+        continue;
+      }
+      compareVector = u.indices();
+    } else if (auto f = mlir::dyn_cast<ArrayModifyOp>(op)) {
+      if (indices.empty()) {
+        indices = f.indices();
+        continue;
+      }
+      compareVector = f.indices();
+    } else if (auto f = mlir::dyn_cast<ArrayFetchOp>(op)) {
+      if (indices.empty()) {
+        indices = f.indices();
+        continue;
+      }
+      compareVector = f.indices();
+    } else {
+      mlir::emitError(op->getLoc(), "unexpected operation in analysis");
+    }
+    if (compareVector.size() != indices.size() ||
+        llvm::any_of(llvm::zip(compareVector, indices), [&](auto pair) {
+          return std::get<0>(pair) != std::get<1>(pair);
+        }))
+      return true;
+    LLVM_DEBUG(llvm::dbgs() << "vectors compare equal\n");
+  }
+  return false;
+}
+
+// Are either of types of conflicts present?
+inline bool conflictDetected(llvm::ArrayRef<mlir::Operation *> reach,
+                             llvm::ArrayRef<mlir::Operation *> accesses,
+                             ArrayMergeStoreOp st) {
+  return conflictOnLoad(reach, st) || conflictOnMerge(accesses);
+}
+
+/// Constructor of the array copy analysis.
+/// This performs the analysis and saves the intermediate results.
+void ArrayCopyAnalysis::construct(mlir::MutableArrayRef<mlir::Region> regions) {
+  for (auto &region : regions)
+    for (auto &block : region.getBlocks())
+      for (auto &op : block.getOperations()) {
+        if (op.getNumRegions())
+          construct(op.getRegions());
+        if (auto st = mlir::dyn_cast<fir::ArrayMergeStoreOp>(op)) {
+          llvm::SmallVector<Operation *> values;
+          ReachCollector::reachingValues(values, st.sequence());
+          llvm::SmallVector<Operation *> accesses;
+          arrayAccesses(accesses,
+                        mlir::cast<ArrayLoadOp>(st.original().getDefiningOp()));
+          if (conflictDetected(values, accesses, st)) {
+            LLVM_DEBUG(llvm::dbgs()
+                       << "CONFLICT: copies required for " << st << '\n'
+                       << "   adding conflicts on: " << op << " and "
+                       << st.original() << '\n');
+            conflicts.insert(&op);
+            conflicts.insert(st.original().getDefiningOp());
+          }
+          auto *ld = st.original().getDefiningOp();
+          LLVM_DEBUG(llvm::dbgs()
+                     << "map: adding {" << *ld << " -> " << st << "}\n");
+          useMap.insert({ld, &op});
+        } else if (auto load = mlir::dyn_cast<ArrayLoadOp>(op)) {
+          llvm::SmallVector<mlir::Operation *> accesses;
+          arrayAccesses(accesses, load);
+          LLVM_DEBUG(llvm::dbgs() << "process load: " << load
+                                  << ", accesses: " << accesses.size() << '\n');
+          for (auto *acc : accesses) {
+            LLVM_DEBUG(llvm::dbgs() << " access: " << *acc << '\n');
+            if (mlir::isa<ArrayFetchOp, ArrayUpdateOp, ArrayModifyOp>(acc)) {
+              if (useMap.count(acc)) {
+                mlir::emitError(
+                    load.getLoc(),
+                    "The parallel semantics of multiple array_merge_stores per "
+                    "array_load are not supported.");
+                continue;
+              }
+              LLVM_DEBUG(llvm::dbgs() << "map: adding {" << *acc << "} -> {"
+                                      << load << "}\n");
+              useMap.insert({acc, &op});
+            }
+          }
+        }
+      }
+}
+
+namespace {
+class ArrayLoadConversion : public mlir::OpRewritePattern<ArrayLoadOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(ArrayLoadOp load,
+                  mlir::PatternRewriter &rewriter) const override {
+    LLVM_DEBUG(llvm::dbgs() << "replace load " << load << " with undef.\n");
+    rewriter.replaceOpWithNewOp<UndefOp>(load, load.getType());
+    return mlir::success();
+  }
+};
+
+class ArrayMergeStoreConversion
+    : public mlir::OpRewritePattern<ArrayMergeStoreOp> {
+public:
+  using OpRewritePattern::OpRewritePattern;
+
+  mlir::LogicalResult
+  matchAndRewrite(ArrayMergeStoreOp store,
+                  mlir::PatternRewriter &rewriter) const override {
+    LLVM_DEBUG(llvm::dbgs() << "marking store " << store << " as dead.\n");
+    rewriter.eraseOp(store);
+    return mlir::success();
+  }
+};
+} // namespace
+
+static mlir::Type getEleTy(mlir::Type ty) {
+  if (auto t = dyn_cast_ptrEleTy(ty))
+    ty = t;
+  if (auto t = ty.dyn_cast<SequenceType>())
+    ty = t.getEleTy();
+  // FIXME: keep ptr/heap/ref information.
+  return ReferenceType::get(ty);
+}
+
+// Extract extents from the ShapeOp/ShapeShiftOp into the result vector.
+static void getExtents(llvm::SmallVectorImpl<mlir::Value> &result,
+                       mlir::Value shape) {
+  auto *shapeOp = shape.getDefiningOp();
+  if (auto s = mlir::dyn_cast<fir::ShapeOp>(shapeOp)) {
+    auto e = s.getExtents();
+    result.insert(result.end(), e.begin(), e.end());
+    return;
+  }
+  if (auto s = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp)) {
+    auto e = s.getExtents();
+    result.insert(result.end(), e.begin(), e.end());
+    return;
+  }
+  llvm::report_fatal_error("not a fir.shape/fir.shape_shift op");
+}
+
+// Place the extents of the array loaded by an ArrayLoadOp into the result
+// vector and return a ShapeOp/ShapeShiftOp with the corresponding extents. If
+// the ArrayLoadOp is loading a fir.box, code will be generated to read the
+// extents from the fir.box, and a the retunred ShapeOp is built with the read
+// extents.
+// Otherwise, the extents will be extracted from the ShapeOp/ShapeShiftOp
+// argument of the ArrayLoadOp that is returned.
+static mlir::Value
+getOrReadExtentsAndShapeOp(mlir::Location loc, mlir::PatternRewriter &rewriter,
+                           fir::ArrayLoadOp loadOp,
+                           llvm::SmallVectorImpl<mlir::Value> &result) {
+  assert(result.empty());
+  if (auto boxTy = loadOp.memref().getType().dyn_cast<fir::BoxType>()) {
+    auto rank = fir::dyn_cast_ptrOrBoxEleTy(boxTy)
+                    .cast<fir::SequenceType>()
+                    .getDimension();
+    auto idxTy = rewriter.getIndexType();
+    for (decltype(rank) dim = 0; dim < rank; ++dim) {
+      auto dimVal = rewriter.create<arith::ConstantIndexOp>(loc, dim);
+      auto dimInfo = rewriter.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+                                                     loadOp.memref(), dimVal);
+      result.emplace_back(dimInfo.getResult(1));
+    }
+    auto shapeType = fir::ShapeType::get(rewriter.getContext(), rank);
+    return rewriter.create<fir::ShapeOp>(loc, shapeType, result);
+  }
+  getExtents(result, loadOp.shape());
+  return loadOp.shape();
+}
+
+static mlir::Type toRefType(mlir::Type ty) {
+  if (fir::isa_ref_type(ty))
+    return ty;
+  return fir::ReferenceType::get(ty);
+}
+
+static mlir::Value
+genCoorOp(mlir::PatternRewriter &rewriter, mlir::Location loc, mlir::Type eleTy,
+          mlir::Type resTy, mlir::Value alloc, mlir::Value shape,
+          mlir::Value slice, mlir::ValueRange indices,
+          mlir::ValueRange typeparams, bool skipOrig = false) {
+  llvm::SmallVector<mlir::Value> originated;
+  if (skipOrig)
+    originated.assign(indices.begin(), indices.end());
+  else
+    originated = fir::factory::originateIndices(loc, rewriter, alloc.getType(),
+                                                shape, indices);
+  auto seqTy = fir::dyn_cast_ptrOrBoxEleTy(alloc.getType());
+  assert(seqTy && seqTy.isa<fir::SequenceType>());
+  const auto dimension = seqTy.cast<fir::SequenceType>().getDimension();
+  mlir::Value result = rewriter.create<fir::ArrayCoorOp>(
+      loc, eleTy, alloc, shape, slice,
+      llvm::ArrayRef<mlir::Value>{originated}.take_front(dimension),
+      typeparams);
+  if (dimension < originated.size())
+    result = rewriter.create<fir::CoordinateOp>(
+        loc, resTy, result,
+        llvm::ArrayRef<mlir::Value>{originated}.drop_front(dimension));
+  return result;
+}
+
+namespace {
+/// Conversion of fir.array_update and fir.array_modify Ops.
+/// If there is a conflict for the update, then we need to perform a
+/// copy-in/copy-out to preserve the original values of the array. If there is
+/// no conflict, then it is save to eschew making any copies.
+template <typename ArrayOp>
+class ArrayUpdateConversionBase : public mlir::OpRewritePattern<ArrayOp> {
+public:
+  explicit ArrayUpdateConversionBase(mlir::MLIRContext *ctx,
+                                     const ArrayCopyAnalysis &a,
+                                     const OperationUseMapT &m)
+      : mlir::OpRewritePattern<ArrayOp>{ctx}, analysis{a}, useMap{m} {}
+
+  static llvm::SmallVector<mlir::Value> recoverTypeParams(mlir::Value val) {
+    auto *op = val.getDefiningOp();
+    if (!fir::hasDynamicSize(fir::dyn_cast_ptrEleTy(val.getType())))
+      return {};
+    if (auto co = mlir::dyn_cast<fir::ConvertOp>(op))
+      return recoverTypeParams(co.value());
+    if (auto ao = mlir::dyn_cast<fir::ArrayFetchOp>(op))
+      return {ao.typeparams().begin(), ao.typeparams().end()};
+    if (auto ao = mlir::dyn_cast<fir::ArrayUpdateOp>(op))
+      return {ao.typeparams().begin(), ao.typeparams().end()};
+    if (auto ao = mlir::dyn_cast<fir::ArrayModifyOp>(op))
+      return {ao.typeparams().begin(), ao.typeparams().end()};
+    if (auto ao = mlir::dyn_cast<fir::ArrayLoadOp>(op))
+      return {ao.typeparams().begin(), ao.typeparams().end()};
+    if (auto ao = mlir::dyn_cast<fir::ArrayCoorOp>(op))
+      return {ao.typeparams().begin(), ao.typeparams().end()};
+    if (auto ao = mlir::dyn_cast<fir::AllocaOp>(op))
+      return {ao.typeparams().begin(), ao.typeparams().end()};
+    if (auto ao = mlir::dyn_cast<fir::AllocMemOp>(op))
+      return {ao.typeparams().begin(), ao.typeparams().end()};
+    llvm::report_fatal_error("unexpected buffer");
+  }
+
+  static mlir::Value recoverCharLen(mlir::Value val) {
+    auto params = recoverTypeParams(val);
+    return params.empty() ? mlir::Value{} : params[0];
+  }
+
+  void genArrayCopy(mlir::Location loc, mlir::PatternRewriter &rewriter,
+                    mlir::Value dst, mlir::Value src, mlir::Value shapeOp,
+                    mlir::Type arrTy) const {
+    auto insPt = rewriter.saveInsertionPoint();
+    llvm::SmallVector<mlir::Value> indices;
+    llvm::SmallVector<mlir::Value> extents;
+    getExtents(extents, shapeOp);
+    // Build loop nest from column to row.
+    for (auto sh : llvm::reverse(extents)) {
+      auto idxTy = rewriter.getIndexType();
+      auto ubi = rewriter.create<fir::ConvertOp>(loc, idxTy, sh);
+      auto zero = rewriter.create<arith::ConstantIndexOp>(loc, 0);
+      auto one = rewriter.create<arith::ConstantIndexOp>(loc, 1);
+      auto ub = rewriter.create<arith::SubIOp>(loc, idxTy, ubi, one);
+      auto loop = rewriter.create<fir::DoLoopOp>(loc, zero, ub, one);
+      rewriter.setInsertionPointToStart(loop.getBody());
+      indices.push_back(loop.getInductionVar());
+    }
+    // Reverse the indices so they are in column-major order.
+    std::reverse(indices.begin(), indices.end());
+    auto ty = getEleTy(arrTy);
+    auto fromAddr = rewriter.create<fir::ArrayCoorOp>(
+        loc, ty, src, shapeOp, mlir::Value{},
+        fir::factory::originateIndices(loc, rewriter, src.getType(), shapeOp,
+                                       indices),
+        mlir::ValueRange{});
+    auto load = rewriter.create<fir::LoadOp>(loc, fromAddr);
+    auto toAddr = rewriter.create<fir::ArrayCoorOp>(
+        loc, ty, dst, shapeOp, mlir::Value{},
+        fir::factory::originateIndices(loc, rewriter, dst.getType(), shapeOp,
+                                       indices),
+        mlir::ValueRange{});
+    rewriter.create<fir::StoreOp>(loc, load, toAddr);
+    rewriter.restoreInsertionPoint(insPt);
+  }
+
+  /// Copy the RHS element into the LHS and insert copy-in/copy-out between a
+  /// temp and the LHS if the analysis found potential overlaps between the RHS
+  /// and LHS arrays. The element copy generator must be provided through \p
+  /// assignElement. \p update must be the ArrayUpdateOp or the ArrayModifyOp.
+  /// Returns the address of the LHS element inside the loop and the LHS
+  /// ArrayLoad result.
+  std::pair<mlir::Value, mlir::Value>
+  materializeAssignment(mlir::Location loc, mlir::PatternRewriter &rewriter,
+                        ArrayOp update,
+                        const std::function<void(mlir::Value)> &assignElement,
+                        mlir::Type lhsEltRefType) const {
+    auto *op = update.getOperation();
+    auto *loadOp = useMap.lookup(op);
+    auto load = mlir::cast<ArrayLoadOp>(loadOp);
+    LLVM_DEBUG(llvm::outs() << "does " << load << " have a conflict?\n");
+    if (analysis.hasPotentialConflict(loadOp)) {
+      // If there is a conflict between the arrays, then we copy the lhs array
+      // to a temporary, update the temporary, and copy the temporary back to
+      // the lhs array. This yields Fortran's copy-in copy-out array semantics.
+      LLVM_DEBUG(llvm::outs() << "Yes, conflict was found\n");
+      rewriter.setInsertionPoint(loadOp);
+      // Copy in.
+      llvm::SmallVector<mlir::Value> extents;
+      auto shapeOp = getOrReadExtentsAndShapeOp(loc, rewriter, load, extents);
+      auto allocmem = rewriter.create<AllocMemOp>(
+          loc, dyn_cast_ptrOrBoxEleTy(load.memref().getType()),
+          load.typeparams(), extents);
+      genArrayCopy(load.getLoc(), rewriter, allocmem, load.memref(), shapeOp,
+                   load.getType());
+      rewriter.setInsertionPoint(op);
+      auto coor = genCoorOp(
+          rewriter, loc, getEleTy(load.getType()), lhsEltRefType, allocmem,
+          shapeOp, load.slice(), update.indices(), load.typeparams(),
+          update->hasAttr(fir::factory::attrFortranArrayOffsets()));
+      assignElement(coor);
+      auto *storeOp = useMap.lookup(loadOp);
+      auto store = mlir::cast<ArrayMergeStoreOp>(storeOp);
+      rewriter.setInsertionPoint(storeOp);
+      // Copy out.
+      genArrayCopy(store.getLoc(), rewriter, store.memref(), allocmem, shapeOp,
+                   load.getType());
+      rewriter.create<FreeMemOp>(loc, allocmem);
+      return {coor, load.getResult()};
+    }
+    // Otherwise, when there is no conflict (a possible loop-carried
+    // dependence), the lhs array can be updated in place.
+    LLVM_DEBUG(llvm::outs() << "No, conflict wasn't found\n");
+    rewriter.setInsertionPoint(op);
+    auto coorTy = getEleTy(load.getType());
+    auto coor = genCoorOp(
+        rewriter, loc, coorTy, lhsEltRefType, load.memref(), load.shape(),
+        load.slice(), update.indices(), load.typeparams(),
+        update->hasAttr(fir::factory::attrFortranArrayOffsets()));
+    assignElement(coor);
+    return {coor, load.getResult()};
+  }
+
+private:
+  const ArrayCopyAnalysis &analysis;
+  const OperationUseMapT &useMap;
+};
+
+class ArrayUpdateConversion : public ArrayUpdateConversionBase<ArrayUpdateOp> {
+public:
+  explicit ArrayUpdateConversion(mlir::MLIRContext *ctx,
+                                 const ArrayCopyAnalysis &a,
+                                 const OperationUseMapT &m)
+      : ArrayUpdateConversionBase{ctx, a, m} {}
+
+  mlir::LogicalResult
+  matchAndRewrite(ArrayUpdateOp update,
+                  mlir::PatternRewriter &rewriter) const override {
+    auto loc = update.getLoc();
+    auto assignElement = [&](mlir::Value coor) {
+      auto input = update.merge();
+      if (auto inEleTy = fir::dyn_cast_ptrEleTy(input.getType())) {
+        [[maybe_unused]] auto outEleTy =
+            fir::unwrapSequenceType(update.getType());
+        if (auto inChrTy = inEleTy.dyn_cast<fir::CharacterType>()) {
+          assert(outEleTy.isa<fir::CharacterType>());
+          fir::factory::genCharacterCopy(input, recoverCharLen(input), coor,
+                                         recoverCharLen(coor), rewriter, loc);
+        } else if (inEleTy.isa<fir::RecordType>()) {
+          fir::FirOpBuilder builder(
+              rewriter,
+              fir::getKindMapping(update->getParentOfType<mlir::ModuleOp>()));
+          if (!update.typeparams().empty()) {
+            auto boxTy = fir::BoxType::get(inEleTy);
+            mlir::Value emptyShape, emptySlice;
+            auto lhs = rewriter.create<EmboxOp>(
+                loc, boxTy, coor, emptyShape, emptySlice, update.typeparams());
+            auto rhs = rewriter.create<EmboxOp>(
+                loc, boxTy, input, emptyShape, emptySlice, update.typeparams());
+            fir::factory::genRecordAssignment(builder, loc, fir::BoxValue(lhs),
+                                              fir::BoxValue(rhs));
+          } else {
+            fir::factory::genRecordAssignment(builder, loc, coor, input);
+          }
+        } else {
+          llvm::report_fatal_error("not a legal reference type");
+        }
+      } else {
+        rewriter.create<fir::StoreOp>(loc, input, coor);
+      }
+    };
+    auto lhsEltRefType = toRefType(update.merge().getType());
+    auto [_, lhsLoadResult] = materializeAssignment(
+        loc, rewriter, update, assignElement, lhsEltRefType);
+    update.replaceAllUsesWith(lhsLoadResult);
+    rewriter.replaceOp(update, lhsLoadResult);
+    return mlir::success();
+  }
+};
+
+class ArrayModifyConversion : public ArrayUpdateConversionBase<ArrayModifyOp> {
+public:
+  explicit ArrayModifyConversion(mlir::MLIRContext *ctx,
+                                 const ArrayCopyAnalysis &a,
+                                 const OperationUseMapT &m)
+      : ArrayUpdateConversionBase{ctx, a, m} {}
+
+  mlir::LogicalResult
+  matchAndRewrite(ArrayModifyOp modify,
+                  mlir::PatternRewriter &rewriter) const override {
+    auto loc = modify.getLoc();
+    auto assignElement = [](mlir::Value) {
+      // Assignment already materialized by lowering using lhs element address.
+    };
+    auto lhsEltRefType = modify.getResult(0).getType();
+    auto [lhsEltCoor, lhsLoadResult] = materializeAssignment(
+        loc, rewriter, modify, assignElement, lhsEltRefType);
+    modify.replaceAllUsesWith(mlir::ValueRange{lhsEltCoor, lhsLoadResult});
+    rewriter.replaceOp(modify, mlir::ValueRange{lhsEltCoor, lhsLoadResult});
+    return mlir::success();
+  }
+};
+
+class ArrayFetchConversion : public mlir::OpRewritePattern<ArrayFetchOp> {
+public:
+  explicit ArrayFetchConversion(mlir::MLIRContext *ctx,
+                                const OperationUseMapT &m)
+      : OpRewritePattern{ctx}, useMap{m} {}
+
+  mlir::LogicalResult
+  matchAndRewrite(ArrayFetchOp fetch,
+                  mlir::PatternRewriter &rewriter) const override {
+    auto *op = fetch.getOperation();
+    rewriter.setInsertionPoint(op);
+    auto load = mlir::cast<ArrayLoadOp>(useMap.lookup(op));
+    auto loc = fetch.getLoc();
+    auto coor =
+        genCoorOp(rewriter, loc, getEleTy(load.getType()),
+                  toRefType(fetch.getType()), load.memref(), load.shape(),
+                  load.slice(), fetch.indices(), load.typeparams(),
+                  fetch->hasAttr(fir::factory::attrFortranArrayOffsets()));
+    if (fir::isa_ref_type(fetch.getType()))
+      rewriter.replaceOp(fetch, coor);
+    else
+      rewriter.replaceOpWithNewOp<fir::LoadOp>(fetch, coor);
+    return mlir::success();
+  }
+
+private:
+  const OperationUseMapT &useMap;
+};
+} // namespace
+
+namespace {
+class ArrayValueCopyConverter
+    : public ArrayValueCopyBase<ArrayValueCopyConverter> {
+public:
+  void runOnFunction() override {
+    auto func = getFunction();
+    LLVM_DEBUG(llvm::dbgs() << "\n\narray-value-copy pass on function '"
+                            << func.getName() << "'\n");
+    auto *context = &getContext();
+
+    // Perform the conflict analysis.
+    auto &analysis = getAnalysis<ArrayCopyAnalysis>();
+    const auto &useMap = analysis.getUseMap();
+
+    mlir::OwningRewritePatternList patterns1(context);
+    patterns1.insert<ArrayFetchConversion>(context, useMap);
+    patterns1.insert<ArrayUpdateConversion>(context, analysis, useMap);
+    patterns1.insert<ArrayModifyConversion>(context, analysis, useMap);
+    mlir::ConversionTarget target(*context);
+    target.addLegalDialect<FIROpsDialect, mlir::scf::SCFDialect,
+                           mlir::arith::ArithmeticDialect,
+                           mlir::StandardOpsDialect>();
+    target.addIllegalOp<ArrayFetchOp, ArrayUpdateOp, ArrayModifyOp>();
+    // Rewrite the array fetch and array update ops.
+    if (mlir::failed(
+            mlir::applyPartialConversion(func, target, std::move(patterns1)))) {
+      mlir::emitError(mlir::UnknownLoc::get(context),
+                      "failure in array-value-copy pass, phase 1");
+      signalPassFailure();
+    }
+
+    mlir::OwningRewritePatternList patterns2(context);
+    patterns2.insert<ArrayLoadConversion>(context);
+    patterns2.insert<ArrayMergeStoreConversion>(context);
+    target.addIllegalOp<ArrayLoadOp, ArrayMergeStoreOp>();
+    if (mlir::failed(
+            mlir::applyPartialConversion(func, target, std::move(patterns2)))) {
+      mlir::emitError(mlir::UnknownLoc::get(context),
+                      "failure in array-value-copy pass, phase 2");
+      signalPassFailure();
+    }
+  }
+};
+} // namespace
+
+std::unique_ptr<mlir::Pass> fir::createArrayValueCopyPass() {
+  return std::make_unique<ArrayValueCopyConverter>();
+}

flang/lib/Optimizer/Transforms/CMakeLists.txt

 add_flang_library(FIRTransforms
   AbstractResult.cpp
   AffinePromotion.cpp
   AffineDemotion.cpp
   CharacterConversion.cpp
+  ArrayValueCopy.cpp
   Inliner.cpp
   ExternalNameConversion.cpp
   RewriteLoop.cpp
 
   DEPENDS
+  FIRBuilder
   FIRDialect
   FIRSupport
   FIROptTransformsPassIncGen
   RewritePatternsIncGen
 
   LINK_LIBS
+  FIRBuilder
   FIRDialect
   MLIRAffineToStandard
   MLIRLLVMIR
   MLIROpenACC
   MLIROpenMP
   FIRSupport
 )

flang/test/Fir/array-modify.f90

+// Test array-copy-value pass (copy elision) with fir.array_modify
+// RUN: fir-opt %s --array-value-copy | FileCheck %s
+
+// Test user_defined_assignment(arg0(:), arg1(:))
+func @no_overlap(%arg0: !fir.ref<!fir.array<100xf32>>, %arg1: !fir.ref<!fir.array<100xf32>>) {
+  %c100 = arith.constant 100 : index
+  %c99 = arith.constant 99 : index
+  %c1 = arith.constant 1 : index
+  %c0 = arith.constant 0 : index
+  %0 = fir.alloca f32
+  %1 = fir.shape %c100 : (index) -> !fir.shape<1>
+  %2 = fir.array_load %arg0(%1) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
+  %3 = fir.array_load %arg1(%1) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
+  %4 = fir.do_loop %arg2 = %c0 to %c99 step %c1 unordered iter_args(%arg3 = %2) -> (!fir.array<100xf32>) {
+    %5 = fir.array_fetch %3, %arg2 : (!fir.array<100xf32>, index) -> f32
+    %6:2 = fir.array_modify %arg3, %arg2 : (!fir.array<100xf32>, index) -> (!fir.ref<f32>, !fir.array<100xf32>)
+    fir.store %5 to %0 : !fir.ref<f32>
+    fir.call @user_defined_assignment(%6#0, %0) : (!fir.ref<f32>, !fir.ref<f32>) -> ()
+    fir.result %6#1 : !fir.array<100xf32>
+  }
+  fir.array_merge_store %2, %4 to %arg0 : !fir.array<100xf32>, !fir.array<100xf32>, !fir.ref<!fir.array<100xf32>>
+  return
+}
+// CHECK-LABEL:   func @no_overlap(
+// CHECK-SAME:                     %[[VAL_0:.*]]: !fir.ref<!fir.array<100xf32>>,
+// CHECK-SAME:                     %[[VAL_1:.*]]: !fir.ref<!fir.array<100xf32>>) {
+// CHECK-DAG:           %[[VAL_2:.*]] = arith.constant 100 : index
+// CHECK-DAG:           %[[VAL_3:.*]] = arith.constant 99 : index
+// CHECK-DAG:           %[[VAL_4:.*]] = arith.constant 1 : index
+// CHECK-DAG:           %[[VAL_5:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_6:.*]] = fir.alloca f32
+// CHECK:           %[[VAL_7:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_8:.*]] = fir.undefined !fir.array<100xf32>
+// CHECK:           %[[VAL_9:.*]] = fir.undefined !fir.array<100xf32>
+// CHECK:           %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_5]] to %[[VAL_3]] step %[[VAL_4]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array<100xf32>) {
+// CHECK:             %[[VAL_13:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_14:.*]] = arith.addi %[[VAL_11]], %[[VAL_13]] : index
+// CHECK:             %[[VAL_15:.*]] = fir.array_coor %[[VAL_1]](%[[VAL_7]]) %[[VAL_14]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, index) -> !fir.ref<f32>
+// CHECK:             %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ref<f32>
+// CHECK:             %[[VAL_17:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_18:.*]] = arith.addi %[[VAL_11]], %[[VAL_17]] : index
+// CHECK:             %[[VAL_19:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) %[[VAL_18]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, index) -> !fir.ref<f32>
+// CHECK:             fir.store %[[VAL_16]] to %[[VAL_6]] : !fir.ref<f32>
+// CHECK:             fir.call @user_defined_assignment(%[[VAL_19]], %[[VAL_6]]) : (!fir.ref<f32>, !fir.ref<f32>) -> ()
+// CHECK:             fir.result %[[VAL_8]] : !fir.array<100xf32>
+// CHECK:           }
+// CHECK:           return
+// CHECK:         }
+
+
+// Test user_defined_assignment(arg0(:), arg0(100:1:-1))
+func @overlap(%arg0: !fir.ref<!fir.array<100xf32>>) {
+  %c100 = arith.constant 100 : index
+  %c99 = arith.constant 99 : index
+  %c1 = arith.constant 1 : index
+  %c-1 = arith.constant -1 : index
+  %c0 = arith.constant 0 : index
+  %0 = fir.alloca f32
+  %1 = fir.shape %c100 : (index) -> !fir.shape<1>
+  %2 = fir.array_load %arg0(%1) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
+  %3 = fir.slice %c100, %c1, %c-1 : (index, index, index) -> !fir.slice<1>
+  %4 = fir.array_load %arg0(%1) [%3] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.array<100xf32>
+  %5 = fir.do_loop %arg1 = %c0 to %c99 step %c1 unordered iter_args(%arg2 = %2) -> (!fir.array<100xf32>) {
+    %6 = fir.array_fetch %4, %arg1 : (!fir.array<100xf32>, index) -> f32
+    %7:2 = fir.array_modify %arg2, %arg1 : (!fir.array<100xf32>, index) -> (!fir.ref<f32>, !fir.array<100xf32>)
+    fir.store %6 to %0 : !fir.ref<f32>
+    fir.call @user_defined_assignment(%7#0, %0) : (!fir.ref<f32>, !fir.ref<f32>) -> ()
+    fir.result %7#1 : !fir.array<100xf32>
+  }
+  fir.array_merge_store %2, %5 to %arg0 : !fir.array<100xf32>, !fir.array<100xf32>, !fir.ref<!fir.array<100xf32>>
+  return
+}
+// CHECK-LABEL:   func @overlap(
+// CHECK-SAME:                  %[[VAL_0:.*]]: !fir.ref<!fir.array<100xf32>>) {
+// CHECK-DAG:           %[[VAL_1:.*]] = arith.constant 100 : index
+// CHECK-DAG:           %[[VAL_2:.*]] = arith.constant 99 : index
+// CHECK-DAG:           %[[VAL_3:.*]] = arith.constant 1 : index
+// CHECK-DAG:           %[[VAL_4:.*]] = arith.constant -1 : index
+// CHECK-DAG:           %[[VAL_5:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_6:.*]] = fir.alloca f32
+// CHECK:           %[[VAL_7:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+// CHECK:           %[[VAL_8:.*]] = fir.allocmem !fir.array<100xf32>, %[[VAL_1]]
+// CHECK:           %[[VAL_9:.*]] = fir.convert %[[VAL_1]] : (index) -> index
+// CHECK:           %[[VAL_10:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_11:.*]] = arith.constant 1 : index
+// CHECK:           %[[VAL_12:.*]] = arith.subi %[[VAL_9]], %[[VAL_11]] : index
+// CHECK:           fir.do_loop %[[VAL_13:.*]] = %[[VAL_10]] to %[[VAL_12]] step %[[VAL_11]] {
+// CHECK:             %[[VAL_14:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_15:.*]] = arith.addi %[[VAL_13]], %[[VAL_14]] : index
+// CHECK:             %[[VAL_16:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) %[[VAL_15]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, index) -> !fir.ref<f32>
+// CHECK:             %[[VAL_17:.*]] = fir.load %[[VAL_16]] : !fir.ref<f32>
+// CHECK:             %[[VAL_18:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_19:.*]] = arith.addi %[[VAL_13]], %[[VAL_18]] : index
+// CHECK:             %[[VAL_20:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_7]]) %[[VAL_19]] : (!fir.heap<!fir.array<100xf32>>, !fir.shape<1>, index) -> !fir.ref<f32>
+// CHECK:             fir.store %[[VAL_17]] to %[[VAL_20]] : !fir.ref<f32>
+// CHECK:           }
+// CHECK:           %[[VAL_21:.*]] = fir.undefined !fir.array<100xf32>
+// CHECK:           %[[VAL_22:.*]] = fir.slice %[[VAL_1]], %[[VAL_3]], %[[VAL_4]] : (index, index, index) -> !fir.slice<1>
+// CHECK:           %[[VAL_23:.*]] = fir.undefined !fir.array<100xf32>
+// CHECK:           %[[VAL_24:.*]] = fir.do_loop %[[VAL_25:.*]] = %[[VAL_5]] to %[[VAL_2]] step %[[VAL_3]] unordered iter_args(%[[VAL_26:.*]] = %[[VAL_21]]) -> (!fir.array<100xf32>) {
+// CHECK:             %[[VAL_27:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_28:.*]] = arith.addi %[[VAL_25]], %[[VAL_27]] : index
+// CHECK:             %[[VAL_29:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) {{\[}}%[[VAL_22]]] %[[VAL_28]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref<f32>
+// CHECK:             %[[VAL_30:.*]] = fir.load %[[VAL_29]] : !fir.ref<f32>
+// CHECK:             %[[VAL_31:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_32:.*]] = arith.addi %[[VAL_25]], %[[VAL_31]] : index
+// CHECK:             %[[VAL_33:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_7]]) %[[VAL_32]] : (!fir.heap<!fir.array<100xf32>>, !fir.shape<1>, index) -> !fir.ref<f32>
+// CHECK:             fir.store %[[VAL_30]] to %[[VAL_6]] : !fir.ref<f32>
+// CHECK:             fir.call @user_defined_assignment(%[[VAL_33]], %[[VAL_6]]) : (!fir.ref<f32>, !fir.ref<f32>) -> ()
+// CHECK:             fir.result %[[VAL_21]] : !fir.array<100xf32>
+// CHECK:           }
+// CHECK:           %[[VAL_34:.*]] = fir.convert %[[VAL_1]] : (index) -> index
+// CHECK:           %[[VAL_35:.*]] = arith.constant 0 : index
+// CHECK:           %[[VAL_36:.*]] = arith.constant 1 : index
+// CHECK:           %[[VAL_37:.*]] = arith.subi %[[VAL_34]], %[[VAL_36]] : index
+// CHECK:           fir.do_loop %[[VAL_38:.*]] = %[[VAL_35]] to %[[VAL_37]] step %[[VAL_36]] {
+// CHECK:             %[[VAL_39:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_40:.*]] = arith.addi %[[VAL_38]], %[[VAL_39]] : index
+// CHECK:             %[[VAL_41:.*]] = fir.array_coor %[[VAL_8]](%[[VAL_7]]) %[[VAL_40]] : (!fir.heap<!fir.array<100xf32>>, !fir.shape<1>, index) -> !fir.ref<f32>
+// CHECK:             %[[VAL_42:.*]] = fir.load %[[VAL_41]] : !fir.ref<f32>
+// CHECK:             %[[VAL_43:.*]] = arith.constant 1 : index
+// CHECK:             %[[VAL_44:.*]] = arith.addi %[[VAL_38]], %[[VAL_43]] : index
+// CHECK:             %[[VAL_45:.*]] = fir.array_coor %[[VAL_0]](%[[VAL_7]]) %[[VAL_44]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, index) -> !fir.ref<f32>
+// CHECK:             fir.store %[[VAL_42]] to %[[VAL_45]] : !fir.ref<f32>
+// CHECK:           }
+// CHECK:           fir.freemem %[[VAL_8]] : !fir.heap<!fir.array<100xf32>>
+// CHECK:           return
+// CHECK:         }
+
+func private @user_defined_assignment(!fir.ref<f32>, !fir.ref<f32>)

flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp

 }
 
 TEST_F(FIRBuilderTest, createRealZeroConstant) {
   auto builder = getBuilder();
   auto ctx = builder.getContext();
   auto loc = builder.getUnknownLoc();
   auto realTy = mlir::FloatType::getF64(ctx);
   auto cst = builder.createRealZeroConstant(loc, realTy);
-  EXPECT_TRUE(mlir::isa<mlir::arith::ConstantOp>(cst.getDefiningOp()));
-  auto cstOp = dyn_cast<mlir::arith::ConstantOp>(cst.getDefiningOp());
+  EXPECT_TRUE(mlir::isa<ConstantOp>(cst.getDefiningOp()));
+  auto cstOp = dyn_cast<ConstantOp>(cst.getDefiningOp());
   EXPECT_EQ(realTy, cstOp.getType());
   EXPECT_EQ(0u, cstOp.value().cast<FloatAttr>().getValue().convertToDouble());
 }
 
 TEST_F(FIRBuilderTest, createBool) {
   auto builder = getBuilder();
   auto loc = builder.getUnknownLoc();
   auto b = builder.createBool(loc, false);