1//===-- FIROps.td - FIR operation definitions --------------*- tablegen -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8///
9/// \file
10/// Definition of the FIR dialect operations
11///
12//===----------------------------------------------------------------------===//
13
14#ifndef FORTRAN_DIALECT_FIR_OPS
15#define FORTRAN_DIALECT_FIR_OPS
16
17include "mlir/IR/SymbolInterfaces.td"
18include "mlir/Interfaces/CallInterfaces.td"
19include "mlir/Interfaces/ControlFlowInterfaces.td"
20include "mlir/Interfaces/LoopLikeInterface.td"
21include "mlir/Interfaces/SideEffectInterfaces.td"
22include "flang/Optimizer/Dialect/FIRTypes.td"
23
24// Base class for FIR operations.
25// All operations automatically get a prefix of "fir.".
26class fir_Op<string mnemonic, list<OpTrait> traits>
27  : Op<fir_Dialect, mnemonic, traits>;
28
29// Base class for FIR operations that take a single argument
30class fir_SimpleOp<string mnemonic, list<OpTrait> traits>
31  : fir_Op<mnemonic, traits> {
32
33  let assemblyFormat = [{
34    operands attr-dict `:` functional-type(operands, results)
35  }];
36}
37
38def fir_OneResultOpBuilder : OpBuilder<(ins
39    "mlir::Type":$resultType,
40    "mlir::ValueRange":$operands,
41    CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes),
42  [{
43    if (resultType)
44      $_state.addTypes(resultType);
45    $_state.addOperands(operands);
46    $_state.addAttributes(attributes);
47  }]>;
48
49// Base class of FIR operations that return 1 result
50class fir_OneResultOp<string mnemonic, list<OpTrait> traits = []> :
51    fir_Op<mnemonic, traits>, Results<(outs fir_Type:$res)> {
52  let builders = [fir_OneResultOpBuilder];
53}
54
55// Base class of FIR operations that have 1 argument and return 1 result
56class fir_SimpleOneResultOp<string mnemonic, list<OpTrait> traits = []> :
57    fir_SimpleOp<mnemonic, traits> {
58  let builders = [fir_OneResultOpBuilder];
59}
60
61//===----------------------------------------------------------------------===//
62// Memory SSA operations
63//===----------------------------------------------------------------------===//
64
65def fir_AllocaOp : fir_Op<"alloca", [AttrSizedOperandSegments,
66    MemoryEffects<[MemAlloc<AutomaticAllocationScopeResource>]>]> {
67  let summary = "allocate storage for a temporary on the stack given a type";
68  let description = [{
69    This primitive operation is used to allocate an object on the stack.  A
70    reference to the object of type `!fir.ref<T>` is returned.  The returned
71    object has an undefined/uninitialized state.  The allocation can be given
72    an optional name.  The allocation may have a dynamic repetition count
73    for allocating a sequence of locations for the specified type.
74
75    ```mlir
76      %c = ... : i64
77      %x = fir.alloca i32
78      %y = fir.alloca !fir.array<8 x i64>
79      %z = fir.alloca f32, %c
80
81      %i = ... : i16
82      %j = ... : i32
83      %w = fir.alloca !fir.type<PT(len1:i16, len2:i32)> (%i, %j : i16, i32)
84    ```
85
86    Note that in the case of `%z`, a contiguous block of memory is allocated
87    and its size is a runtime multiple of a 32-bit REAL value.
88
89    In the case of `%w`, the arguments `%i` and `%j` are LEN parameters
90    (`len1`, `len2`) to the type `PT`.
91
92    Finally, the operation is undefined if the ssa-value `%c` is negative.
93
94    Fortran Semantics:
95    There is no language mechanism in Fortran to allocate space on the stack
96    like C's `alloca()` function. Therefore fir.alloca is not control-flow
97    dependent. However, the lifetime of a stack allocation is often limited to
98    a small region and a legal implementation may reuse stack storage in other
99    regions when there is no conflict. For example, take the following code
100    fragment.
101
102    ```fortran
103      CALL foo(1)
104      CALL foo(2)
105      CALL foo(3)
106    ```
107
108    A legal implementation can allocate a stack slot and initialize it with the
109    constant `1`, then pass that by reference to foo. Likewise for the second
110    and third calls to foo, each stack slot being initialized accordingly. It is
111    also a conforming implementation to reuse the same stack slot for all three
112    calls, just initializing each in turn. This is possible  as the lifetime of
113    the copy of each constant need not exceed that of the CALL statement.
114    Indeed, a user would likely expect a good Fortran compiler to perform such
115    an optimization.
116
117    Until Fortran 2018, procedures defaulted to non-recursive. A legal
118    implementation could therefore convert stack allocations to global
119    allocations. Such a conversion effectively adds the SAVE attribute to all
120    variables.
121
122    Some temporary entities (large arrays) probably should not be stack
123    allocated as stack space can often be limited. A legal implementation can
124    convert these large stack allocations to heap allocations regardless of
125    whether the procedure is recursive or not.
126
127    The pinned attribute is used to flag fir.alloca operation in a specific
128    region and avoid them being hoisted in an alloca hoisting pass.
129  }];
130
131  let arguments = (ins
132    TypeAttr:$in_type,
133    OptionalAttr<StrAttr>:$uniq_name,
134    OptionalAttr<StrAttr>:$bindc_name,
135    UnitAttr:$pinned,
136    Variadic<AnyIntegerType>:$typeparams,
137    Variadic<AnyIntegerType>:$shape
138  );
139
140  let results = (outs fir_ReferenceType);
141
142  let parser =
143      "return parseAllocatableOp(wrapAllocaResultType, parser, result);";
144  let printer = "printAllocatableOp(p, (*this));";
145
146  let builders = [
147    OpBuilder<(ins "mlir::Type":$inType, "llvm::StringRef":$uniqName,
148      "llvm::StringRef":$bindcName, CArg<"mlir::ValueRange", "{}">:$typeparams,
149       CArg<"mlir::ValueRange", "{}">:$shape,
150       CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
151     OpBuilder<(ins "mlir::Type":$inType, "llvm::StringRef":$uniqName,
152       "llvm::StringRef":$bindcName, "bool":$pinned,
153       CArg<"mlir::ValueRange", "{}">:$typeparams,
154       CArg<"mlir::ValueRange", "{}">:$shape,
155       CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
156       OpBuilder<(ins "mlir::Type":$inType, "llvm::StringRef":$uniqName,
157       CArg<"mlir::ValueRange", "{}">:$typeparams,
158       CArg<"mlir::ValueRange", "{}">:$shape,
159       CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
160     OpBuilder<(ins "mlir::Type":$inType, "llvm::StringRef":$uniqName,
161       "bool":$pinned, CArg<"mlir::ValueRange", "{}">:$typeparams,
162       CArg<"mlir::ValueRange", "{}">:$shape,
163       CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
164     OpBuilder<(ins "mlir::Type":$inType, "bool":$pinned,
165       CArg<"mlir::ValueRange", "{}">:$typeparams,
166       CArg<"mlir::ValueRange", "{}">:$shape,
167       CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
168     OpBuilder<(ins "mlir::Type":$inType,
169       CArg<"mlir::ValueRange", "{}">:$typeparams,
170       CArg<"mlir::ValueRange", "{}">:$shape,
171       CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>];
172
173  let verifier = [{ return ::verify(*this); }];
174
175  let extraClassDeclaration = [{
176    mlir::Type getAllocatedType();
177    bool hasLenParams() { return !typeparams().empty(); }
178    bool hasShapeOperands() { return !shape().empty(); }
179    unsigned numLenParams() { return typeparams().size(); }
180    operand_range getLenParams() { return typeparams(); }
181    unsigned numShapeOperands() { return shape().size(); }
182    operand_range getShapeOperands() { return shape(); }
183    static mlir::Type getRefTy(mlir::Type ty);
184    mlir::Type getInType() { return in_type(); }
185  }];
186}
187
188def fir_AllocMemOp : fir_Op<"allocmem",
189    [MemoryEffects<[MemAlloc<DefaultResource>]>, AttrSizedOperandSegments]> {
190  let summary = "allocate storage on the heap for an object of a given type";
191
192  let description = [{
193    Creates a heap memory reference suitable for storing a value of the
194    given type, T.  The heap refernce returned has type `!fir.heap<T>`.
195    The memory object is in an undefined state.  `allocmem` operations must
196    be paired with `freemem` operations to avoid memory leaks.
197
198    ```mlir
199      %0 = fir.allocmem !fir.array<10 x f32>
200      fir.freemem %0 : !fir.heap<!fir.array<10 x f32>>
201    ```
202  }];
203
204  let arguments = (ins
205    TypeAttr:$in_type,
206    OptionalAttr<StrAttr>:$uniq_name,
207    OptionalAttr<StrAttr>:$bindc_name,
208    Variadic<AnyIntegerType>:$typeparams,
209    Variadic<AnyIntegerType>:$shape
210  );
211  let results = (outs fir_HeapType);
212
213  let parser =
214      "return parseAllocatableOp(wrapAllocMemResultType, parser, result);";
215  let printer = "printAllocatableOp(p, (*this));";
216
217  let builders = [
218    OpBuilder<(ins "mlir::Type":$in_type, "llvm::StringRef":$uniq_name,
219      "llvm::StringRef":$bindc_name, CArg<"mlir::ValueRange", "{}">:$typeparams,
220      CArg<"mlir::ValueRange", "{}">:$shape,
221      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
222    OpBuilder<(ins "mlir::Type":$in_type, "llvm::StringRef":$uniq_name,
223      CArg<"mlir::ValueRange", "{}">:$typeparams,
224      CArg<"mlir::ValueRange", "{}">:$shape,
225      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
226    OpBuilder<(ins "mlir::Type":$in_type,
227      CArg<"mlir::ValueRange", "{}">:$typeparams,
228      CArg<"mlir::ValueRange", "{}">:$shape,
229      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>];
230
231  let verifier = [{ return ::verify(*this); }];
232
233  let extraClassDeclaration = [{
234    mlir::Type getAllocatedType();
235    bool hasLenParams() { return !typeparams().empty(); }
236    bool hasShapeOperands() { return !shape().empty(); }
237    unsigned numLenParams() { return typeparams().size(); }
238    operand_range getLenParams() { return typeparams(); }
239    unsigned numShapeOperands() { return shape().size(); }
240    operand_range getShapeOperands() { return shape(); }
241    static mlir::Type getRefTy(mlir::Type ty);
242    mlir::Type getInType() { return in_type(); }
243  }];
244}
245
246def fir_FreeMemOp : fir_Op<"freemem", [MemoryEffects<[MemFree]>]> {
247  let summary = "free a heap object";
248
249  let description = [{
250    Deallocates a heap memory reference that was allocated by an `allocmem`.
251    The memory object that is deallocated is placed in an undefined state
252    after `fir.freemem`.  Optimizations may treat the loading of an object
253    in the undefined state as undefined behavior.  This includes aliasing
254    references, such as the result of an `fir.embox`.
255
256    ```mlir
257      %21 = fir.allocmem !fir.type<ZT(p:i32){field:i32}>
258      ...
259      fir.freemem %21 : !fir.heap<!fir.type<ZT>>
260    ```
261  }];
262
263  let arguments = (ins Arg<fir_HeapType, "", [MemFree]>:$heapref);
264
265  let assemblyFormat = "$heapref attr-dict `:` type($heapref)";
266}
267
268def fir_LoadOp : fir_OneResultOp<"load"> {
269  let summary = "load a value from a memory reference";
270  let description = [{
271    Load a value from a memory reference into an ssa-value (virtual register).
272    Produces an immutable ssa-value of the referent type. A memory reference
273    has type `!fir.ref<T>`, `!fir.heap<T>`, or `!fir.ptr<T>`.
274
275    ```mlir
276      %a = fir.alloca i32
277      %l = fir.load %a : !fir.ref<i32>
278    ```
279
280    The ssa-value has an undefined value if the memory reference is undefined
281    or null.
282  }];
283
284  let arguments = (ins Arg<AnyReferenceLike, "", [MemRead]>:$memref);
285
286  let builders = [OpBuilder<(ins "mlir::Value":$refVal)>];
287
288  let parser = "return parseLoadOp(parser, result);";
289
290  let printer = "::print(p, *this);";
291
292  let extraClassDeclaration = [{
293    static mlir::ParseResult getElementOf(mlir::Type &ele, mlir::Type ref);
294  }];
295}
296
297def fir_CharConvertOp : fir_Op<"char_convert", []> {
298  let summary = [{
299    Primitive to convert an entity of type CHARACTER from one KIND to a
300    different KIND.
301  }];
302
303  let description = [{
304    Copy a CHARACTER (must be in memory) of KIND _k1_ to a CHARACTER (also must
305    be in memory) of KIND _k2_ where _k1_ != _k2_ and the buffers do not
306    overlap. This latter restriction is unchecked, as the Fortran language
307    definition eliminates the overlapping in memory case.
308
309    The number of code points copied is specified explicitly as the second
310    argument. The length of the !fir.char type is ignored.
311
312    ```mlir
313      fir.char_convert %1 for %2 to %3 : !fir.ref<!fir.char<1,?>>, i32,
314          !fir.ref<!fir.char<2,20>>
315    ```
316
317    Should future support for encodings other than ASCII be supported, codegen
318    can generate a call to a runtime helper routine which will map the code
319    points from UTF-8 to UCS-2, for example. Such remappings may not always
320    be possible as they may involve the creation of more code points than the
321    `count` limit. These details are left as future to-dos.
322  }];
323
324  let arguments = (ins
325    Arg<AnyReferenceLike, "", [MemRead]>:$from,
326    AnyIntegerType:$count,
327    Arg<AnyReferenceLike, "", [MemWrite]>:$to
328  );
329
330  let assemblyFormat = [{
331    $from `for` $count `to` $to attr-dict `:` type(operands)
332  }];
333
334  let verifier = "return ::verify(*this);";
335}
336
337def fir_StoreOp : fir_Op<"store", []> {
338  let summary = "store an SSA-value to a memory location";
339
340  let description = [{
341    Store an ssa-value (virtual register) to a memory reference.  The stored
342    value must be of the same type as the referent type of the memory
343    reference.
344
345    ```mlir
346      %v = ... : f64
347      %p = ... : !fir.ptr<f64>
348      fir.store %v to %p : !fir.ptr<f64>
349    ```
350
351    The above store changes the value to which the pointer is pointing and not
352    the pointer itself. The operation is undefined if the memory reference,
353    `%p`, is undefined or null.
354  }];
355
356  let arguments = (ins AnyType:$value,
357                   Arg<AnyReferenceLike, "", [MemWrite]>:$memref);
358
359  let parser = "return parseStoreOp(parser, result);";
360
361  let printer = "::print(p, *this);";
362
363  let verifier = "return ::verify(*this);";
364
365  let extraClassDeclaration = [{
366    static mlir::Type elementType(mlir::Type refType);
367  }];
368}
369
370def fir_SaveResultOp : fir_Op<"save_result", [AttrSizedOperandSegments]> {
371  let summary = [{
372    save an array, box, or record function result SSA-value to a memory location
373  }];
374
375  let description = [{
376    Save the result of a function returning an array, box, or record type value
377    into a memory location given the shape and length parameters of the result.
378
379    Function results of type fir.box, fir.array, or fir.rec are abstract values
380    that require a storage to be manipulated on the caller side. This operation
381    allows associating such abstract result to a storage. In later lowering of
382    the function interfaces, this storage might be used to pass the result in
383    memory.
384
385    For arrays, result, it is required to provide the shape of the result. For
386    character arrays and derived types with length parameters, the length
387    parameter values must be provided.
388
389    The fir.save_result associated to a function call must immediately follow
390    the call and be in the same block.
391
392    ```mlir
393      %buffer = fir.alloca fir.array<?xf32>, %c100
394      %shape = fir.shape %c100
395      %array_result = fir.call @foo() : () -> fir.array<?xf32>
396      fir.save_result %array_result to %buffer(%shape)
397      %coor = fir.array_coor %buffer%(%shape), %c5
398      %fifth_element = fir.load %coor : f32
399    ```
400
401    The above fir.save_result allows saving a fir.array function result into
402    a buffer to later access its 5th element.
403
404  }];
405
406  let arguments = (ins ArrayOrBoxOrRecord:$value,
407                   Arg<AnyReferenceLike, "", [MemWrite]>:$memref,
408                   Optional<AnyShapeType>:$shape,
409                   Variadic<AnyIntegerType>:$typeparams);
410
411  let assemblyFormat = [{
412    $value `to` $memref (`(` $shape^ `)`)? (`typeparams` $typeparams^)?
413    attr-dict `:` type(operands)
414  }];
415
416  let verifier = [{ return ::verify(*this); }];
417}
418
419def fir_UndefOp : fir_OneResultOp<"undefined", [NoSideEffect]> {
420  let summary = "explicit undefined value of some type";
421  let description = [{
422    Constructs an ssa-value of the specified type with an undefined value.
423    This operation is typically created internally by the mem2reg conversion
424    pass. An undefined value can be of any type except `!fir.ref<T>`.
425
426    ```mlir
427      %a = fir.undefined !fir.array<10 x !fir.type<T>>
428    ```
429
430    The example creates an array shaped ssa value. The array is rank 1, extent
431    10, and each element has type `!fir.type<T>`.
432  }];
433
434  let results = (outs AnyType:$intype);
435
436  let assemblyFormat = "type($intype) attr-dict";
437
438  let verifier = [{
439    // allow `undef : ref<T>` since it is a possible from transformations
440    return mlir::success();
441  }];
442}
443
444def fir_ZeroOp : fir_OneResultOp<"zero_bits", [NoSideEffect]> {
445  let summary = "explicit polymorphic zero value of some type";
446  let description = [{
447    Constructs an ssa-value of the specified type with a value of zero for all
448    bits.
449
450    ```mlir
451      %a = fir.zero_bits !fir.box<!fir.array<10 x !fir.type<T>>>
452    ```
453
454    The example creates a value of type box where all bits are zero.
455  }];
456
457  let results = (outs AnyType:$intype);
458
459  let assemblyFormat = "type($intype) attr-dict";
460}
461
462//===----------------------------------------------------------------------===//
463// Terminator operations
464//===----------------------------------------------------------------------===//
465
466class fir_SwitchTerminatorOp<string mnemonic, list<OpTrait> traits = []> :
467    fir_Op<mnemonic, !listconcat(traits, [AttrSizedOperandSegments,
468    DeclareOpInterfaceMethods<BranchOpInterface>, Terminator])> {
469
470  let arguments = (ins
471    AnyType:$selector,
472    Variadic<AnyType>:$compareArgs,
473    Variadic<AnyType>:$targetArgs
474  );
475
476  let results = (outs);
477
478  let successors = (successor VariadicSuccessor<AnySuccessor>:$targets);
479
480  string extraSwitchClassDeclaration = [{
481    using Conditions = mlir::Value;
482
483    static constexpr llvm::StringRef getCasesAttr() { return "case_tags"; }
484
485    // The number of destination conditions that may be tested
486    unsigned getNumConditions() {
487      return (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).size();
488    }
489
490    // The selector is the value being tested to determine the destination
491    mlir::Value getSelector() { return selector(); }
492    mlir::Value getSelector(llvm::ArrayRef<mlir::Value> operands) {
493      return operands[0];
494    }
495
496    // The number of blocks that may be branched to
497    unsigned getNumDest() { return (*this)->getNumSuccessors(); }
498
499    llvm::Optional<mlir::OperandRange> getCompareOperands(unsigned cond);
500    llvm::Optional<llvm::ArrayRef<mlir::Value>> getCompareOperands(
501        llvm::ArrayRef<mlir::Value> operands, unsigned cond);
502
503    llvm::Optional<llvm::ArrayRef<mlir::Value>> getSuccessorOperands(
504        llvm::ArrayRef<mlir::Value> operands, unsigned cond);
505    using BranchOpInterfaceTrait::getSuccessorOperands;
506
507    // Helper function to deal with Optional operand forms
508    void printSuccessorAtIndex(mlir::OpAsmPrinter &p, unsigned i) {
509      auto *succ = getSuccessor(i);
510      auto ops = getSuccessorOperands(i);
511      if (ops.hasValue())
512        p.printSuccessorAndUseList(succ, ops.getValue());
513      else
514        p.printSuccessor(succ);
515    }
516
517    unsigned targetOffsetSize();
518  }];
519}
520
521class fir_IntegralSwitchTerminatorOp<string mnemonic,
522    list<OpTrait> traits = []> : fir_SwitchTerminatorOp<mnemonic, traits> {
523
524  let skipDefaultBuilders = 1;
525  let builders = [OpBuilder<(ins "mlir::Value":$selector,
526    "llvm::ArrayRef<int64_t>":$compareOperands,
527    "llvm::ArrayRef<mlir::Block *>":$destinations,
528    CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
529    CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes),
530    [{
531      $_state.addOperands(selector);
532      llvm::SmallVector<mlir::Attribute> ivalues;
533      for (auto iv : compareOperands)
534        ivalues.push_back($_builder.getI64IntegerAttr(iv));
535      ivalues.push_back($_builder.getUnitAttr());
536      $_state.addAttribute(getCasesAttr(), $_builder.getArrayAttr(ivalues));
537      const auto count = destinations.size();
538      for (auto d : destinations)
539        $_state.addSuccessors(d);
540      const auto opCount = destOperands.size();
541      llvm::SmallVector<int32_t> argOffs;
542      int32_t sumArgs = 0;
543      for (std::remove_const_t<decltype(count)> i = 0; i != count; ++i) {
544        if (i < opCount) {
545          $_state.addOperands(destOperands[i]);
546          const auto argSz = destOperands[i].size();
547          argOffs.push_back(argSz);
548          sumArgs += argSz;
549        } else {
550          argOffs.push_back(0);
551        }
552      }
553      $_state.addAttribute(getOperandSegmentSizeAttr(),
554        $_builder.getI32VectorAttr({1, 0, sumArgs}));
555      $_state.addAttribute(getTargetOffsetAttr(),
556        $_builder.getI32VectorAttr(argOffs));
557      $_state.addAttributes(attributes);
558    }]
559  >];
560
561  let parser = [{
562    mlir::OpAsmParser::OperandType selector;
563    mlir::Type type;
564    if (parseSelector(parser, result, selector, type))
565      return mlir::failure();
566
567    llvm::SmallVector<mlir::Attribute> ivalues;
568    llvm::SmallVector<mlir::Block *> dests;
569    llvm::SmallVector<llvm::SmallVector<mlir::Value>> destArgs;
570    while (true) {
571      mlir::Attribute ivalue; // Integer or Unit
572      mlir::Block *dest;
573      llvm::SmallVector<mlir::Value> destArg;
574      mlir::NamedAttrList temp;
575      if (parser.parseAttribute(ivalue, "i", temp) ||
576          parser.parseComma() ||
577          parser.parseSuccessorAndUseList(dest, destArg))
578        return mlir::failure();
579      ivalues.push_back(ivalue);
580      dests.push_back(dest);
581      destArgs.push_back(destArg);
582      if (!parser.parseOptionalRSquare())
583        break;
584      if (parser.parseComma())
585        return mlir::failure();
586    }
587    auto &bld = parser.getBuilder();
588    result.addAttribute(getCasesAttr(), bld.getArrayAttr(ivalues));
589    llvm::SmallVector<int32_t> argOffs;
590    int32_t sumArgs = 0;
591    const auto count = dests.size();
592    for (std::remove_const_t<decltype(count)> i = 0; i != count; ++i) {
593      result.addSuccessors(dests[i]);
594      result.addOperands(destArgs[i]);
595      auto argSize = destArgs[i].size();
596      argOffs.push_back(argSize);
597      sumArgs += argSize;
598    }
599    result.addAttribute(getOperandSegmentSizeAttr(),
600                        bld.getI32VectorAttr({1, 0, sumArgs}));
601    result.addAttribute(getTargetOffsetAttr(), bld.getI32VectorAttr(argOffs));
602    return mlir::success();
603  }];
604
605  let printer = [{
606    p << ' ';
607    p.printOperand(getSelector());
608    p << " : " << getSelector().getType() << " [";
609    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
610    auto count = getNumConditions();
611    for (decltype(count) i = 0; i != count; ++i) {
612      if (i)
613        p << ", ";
614      auto &attr = cases[i];
615      if (auto intAttr = attr.dyn_cast_or_null<mlir::IntegerAttr>())
616        p << intAttr.getValue();
617      else
618        p.printAttribute(attr);
619      p << ", ";
620      printSuccessorAtIndex(p, i);
621    }
622    p << ']';
623    p.printOptionalAttrDict((*this)->getAttrs(), {getCasesAttr(), getCompareOffsetAttr(),
624        getTargetOffsetAttr(), getOperandSegmentSizeAttr()});
625  }];
626
627  let verifier = [{
628    if (!(getSelector().getType().isa<mlir::IntegerType>() ||
629          getSelector().getType().isa<mlir::IndexType>() ||
630          getSelector().getType().isa<fir::IntegerType>()))
631      return emitOpError("must be an integer");
632    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
633    auto count = getNumDest();
634    if (count == 0)
635      return emitOpError("must have at least one successor");
636    if (getNumConditions() != count)
637      return emitOpError("number of cases and targets don't match");
638    if (targetOffsetSize() != count)
639      return emitOpError("incorrect number of successor operand groups");
640    for (decltype(count) i = 0; i != count; ++i) {
641      auto &attr = cases[i];
642      if (!(attr.isa<mlir::IntegerAttr>() || attr.isa<mlir::UnitAttr>()))
643        return emitOpError("invalid case alternative");
644    }
645    return mlir::success();
646  }];
647
648  let extraClassDeclaration = extraSwitchClassDeclaration;
649}
650
651def fir_SelectOp : fir_IntegralSwitchTerminatorOp<"select"> {
652  let summary = "a multiway branch";
653
654  let description = [{
655    A multiway branch terminator with similar semantics to C's `switch`
656    statement.  A selector value is matched against a list of constants
657    of the same type for a match.  When a match is found, control is
658    transferred to the corresponding basic block.  A `select` must have
659    at least one basic block with a corresponding `unit` match, and
660    that block will be selected when all other conditions fail to match.
661
662    ```mlir
663      fir.select %arg:i32 [1, ^bb1(%0 : i32),
664                           2, ^bb2(%2,%arg,%arg2 : i32,i32,i32),
665                          -3, ^bb3(%arg2,%2 : i32,i32),
666                           4, ^bb4(%1 : i32),
667                        unit, ^bb5]
668    ```
669  }];
670}
671
672def fir_SelectRankOp : fir_IntegralSwitchTerminatorOp<"select_rank"> {
673  let summary = "Fortran's SELECT RANK statement";
674
675  let description = [{
676    Similar to `select`, `select_rank` provides a way to express Fortran's
677    SELECT RANK construct.  In this case, the rank of the selector value
678    is matched against constants of integer type.  The structure is the
679    same as `select`, but `select_rank` determines the rank of the selector
680    variable at runtime to determine the best match.
681
682    ```mlir
683      fir.select_rank %arg:i32 [1, ^bb1(%0 : i32),
684                                2, ^bb2(%2,%arg,%arg2 : i32,i32,i32),
685                                3, ^bb3(%arg2,%2 : i32,i32),
686                               -1, ^bb4(%1 : i32),
687                             unit, ^bb5]
688    ```
689  }];
690}
691
692def fir_SelectCaseOp : fir_SwitchTerminatorOp<"select_case"> {
693  let summary = "Fortran's SELECT CASE statement";
694
695  let description = [{
696    Similar to `select`, `select_case` provides a way to express Fortran's
697    SELECT CASE construct.  In this case, the selector value is matched
698    against variables (not just constants) and ranges.  The structure is
699    the same as `select`, but `select_case` allows for the expression of
700    more complex match conditions.
701
702    ```mlir
703      fir.select_case %arg : i32 [
704            #fir.point, %0, ^bb1(%0 : i32),
705            #fir.lower, %1, ^bb2(%2,%arg,%arg2,%1 : i32,i32,i32,i32),
706            #fir.interval, %2, %3, ^bb3(%2,%arg2 : i32,i32),
707            #fir.upper, %arg, ^bb4(%1 : i32),
708            unit, ^bb5]
709    ```
710  }];
711
712  let skipDefaultBuilders = 1;
713  let builders = [
714    OpBuilder<(ins "mlir::Value":$selector,
715      "llvm::ArrayRef<mlir::Attribute>":$compareAttrs,
716      "llvm::ArrayRef<mlir::ValueRange>":$cmpOperands,
717      "llvm::ArrayRef<mlir::Block *>":$destinations,
718      CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
719      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>,
720    OpBuilder<(ins "mlir::Value":$selector,
721      "llvm::ArrayRef<mlir::Attribute>":$compareAttrs,
722      "llvm::ArrayRef<mlir::Value>":$cmpOpList,
723      "llvm::ArrayRef<mlir::Block *>":$destinations,
724      CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
725      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>];
726
727  let parser = "return parseSelectCase(parser, result);";
728
729  let printer = "::print(p, *this);";
730
731  let verifier = "return ::verify(*this);";
732
733  let extraClassDeclaration = extraSwitchClassDeclaration#[{
734    unsigned compareOffsetSize();
735  }];
736}
737
738def fir_SelectTypeOp : fir_SwitchTerminatorOp<"select_type"> {
739  let summary = "Fortran's SELECT TYPE statement";
740
741  let description = [{
742    Similar to `select`, `select_type` provides a way to express Fortran's
743    SELECT TYPE construct.  In this case, the type of the selector value
744    is matched against a list of type descriptors.  The structure is the
745    same as `select`, but `select_type` determines the type of the selector
746    variable at runtime to determine the best match.
747
748    ```mlir
749      fir.select_type %arg : !fir.box<()> [
750          #fir.instance<!fir.type<type1>>, ^bb1(%0 : i32),
751          #fir.instance<!fir.type<type2>>, ^bb2(%2 : i32),
752          #fir.subsumed<!fir.type<type3>>, ^bb3(%2 : i32),
753          #fir.instance<!fir.type<type4>>, ^bb4(%1,%3 : i32,f32),
754          unit, ^bb5]
755    ```
756  }];
757
758  let skipDefaultBuilders = 1;
759  let builders = [OpBuilder<(ins "mlir::Value":$selector,
760    "llvm::ArrayRef<mlir::Attribute>":$typeOperands,
761    "llvm::ArrayRef<mlir::Block *>":$destinations,
762    CArg<"llvm::ArrayRef<mlir::ValueRange>", "{}">:$destOperands,
763    CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>];
764
765  let parser = "return parseSelectType(parser, result);";
766
767  let printer = "::print(p, *this);";
768
769  let verifier = "return ::verify(*this);";
770
771  let extraClassDeclaration = extraSwitchClassDeclaration;
772}
773
774def fir_UnreachableOp : fir_Op<"unreachable", [Terminator]> {
775  let summary = "the unreachable instruction";
776
777  let description = [{
778    Terminates a basic block with the assertion that the end of the block
779    will never be reached at runtime.  This instruction can be used
780    immediately after a call to the Fortran runtime to terminate the
781    program, for example.  This instruction corresponds to the LLVM IR
782    instruction `unreachable`.
783
784    ```mlir
785      fir.unreachable
786    ```
787  }];
788
789  let parser = "return mlir::success();";
790
791  let printer = "";
792}
793
794def fir_FirEndOp : fir_Op<"end", [Terminator]> {
795  let summary = "the end instruction";
796
797  let description = [{
798    The end terminator is a special terminator used inside various FIR
799    operations that have regions.  End is thus the custom invisible terminator
800    for these operations.  It is implicit and need not appear in the textual
801    representation.
802  }];
803}
804
805def fir_HasValueOp : fir_Op<"has_value", [Terminator, HasParent<"GlobalOp">]> {
806  let summary = "terminator for GlobalOp";
807  let description = [{
808    The terminator for a GlobalOp with a body.
809
810    ```mlir
811      global @variable : tuple<i32, f32> {
812        %0 = constant 45 : i32
813        %1 = constant 100.0 : f32
814        %2 = fir.undefined tuple<i32, f32>
815        %3 = constant 0 : index
816        %4 = fir.insert_value %2, %0, %3 : (tuple<i32, f32>, i32, index) -> tuple<i32, f32>
817        %5 = constant 1 : index
818        %6 = fir.insert_value %4, %1, %5 : (tuple<i32, f32>, f32, index) -> tuple<i32, f32>
819        fir.has_value %6 : tuple<i32, f32>
820      }
821    ```
822  }];
823
824  let arguments = (ins AnyType:$resval);
825
826  let assemblyFormat = "$resval attr-dict `:` type($resval)";
827}
828
829//===------------------------------------------------------------------------===//
830// Operations on !fir.box<T> type objects
831//===------------------------------------------------------------------------===//
832
833def fir_EmboxOp : fir_Op<"embox", [NoSideEffect, AttrSizedOperandSegments]> {
834  let summary = "boxes a given reference and (optional) dimension information";
835
836  let description = [{
837    Create a boxed reference value. In Fortran, the implementation can require
838    extra information about an entity, such as its type, rank, etc.  This
839    auxilliary information is packaged and abstracted as a value with box type
840    by the calling routine. (In Fortran, these are called descriptors.)
841
842    ```mlir
843      %c1 = constant 1 : index
844      %c10 = constant 10 : index
845      %5 = ... : !fir.ref<!fir.array<10 x i32>>
846      %6 = fir.embox %5 : (!fir.ref<!fir.array<10 x i32>>) -> !fir.box<!fir.array<10 x i32>>
847    ```
848
849    The descriptor tuple may contain additional implementation-specific
850    information through the use of additional attributes.
851    Specifically,
852        - shape: emboxing an array may require shape information (an array's
853          lower bounds and extents may not be known until runtime),
854        - slice: an array section can be described with a slice triple,
855        - typeparams: for emboxing a derived type with LEN type parameters,
856        - accessMap: unused/experimental.
857  }];
858
859  let arguments = (ins
860    AnyReferenceLike:$memref,
861    Optional<AnyShapeType>:$shape,
862    Optional<fir_SliceType>:$slice,
863    Variadic<AnyIntegerType>:$typeparams,
864    OptionalAttr<AffineMapAttr>:$accessMap
865  );
866
867  let results = (outs fir_BoxType);
868
869  let builders = [
870    OpBuilder<(ins "llvm::ArrayRef<mlir::Type>":$resultTypes,
871      "mlir::Value":$memref, CArg<"mlir::Value", "{}">:$shape,
872      CArg<"mlir::Value", "{}">:$slice,
873      CArg<"mlir::ValueRange", "{}">:$typeparams),
874    [{ return build($_builder, $_state, resultTypes, memref, shape, slice,
875                    typeparams, mlir::AffineMapAttr{}); }]>
876  ];
877
878  let assemblyFormat = [{
879    $memref (`(` $shape^ `)`)? (`[` $slice^ `]`)? (`typeparams` $typeparams^)?
880      (`map` $accessMap^)? attr-dict `:` functional-type(operands, results)
881  }];
882
883  let verifier = "return ::verify(*this);";
884
885  let extraClassDeclaration = [{
886    mlir::Value getShape() { return shape(); }
887    mlir::Value getSlice() { return slice(); }
888    bool hasLenParams() { return !typeparams().empty(); }
889    unsigned numLenParams() { return typeparams().size(); }
890  }];
891}
892
893def fir_ReboxOp : fir_Op<"rebox", [NoSideEffect, AttrSizedOperandSegments]> {
894  let summary = "create a box given another box and (optional) dimension information";
895
896  let description = [{
897    Create a new boxed reference value from another box. This is meant to be used
898    when the taking a reference to part of a boxed value, or to an entire boxed value with
899    new shape or type information.
900
901    The new extra information can be:
902      - new shape information (new lower bounds, new rank, or new extents.
903        New rank/extents can only be provided if the original fir.box is
904        contiguous in all dimension but maybe the first one). The shape
905        operand must be provided to set new shape information.
906      - new type (only for derived types). It is possible to set the dynamic type
907        of the new box to one of the parent types of the input box dynamic type.
908        Type parameters cannot be changed. This change is reflected in the requested
909        result type of the new box.
910
911    A slice argument can be provided to build a reference to part of a boxed value.
912    In this case, the shape operand must be absent or be a fir.shift that can be
913    used to provide a non default origin for the slice.
914
915    The following example illustrates creating a fir.box for x(10:33:2)
916    where x is described by a fir.box and has non default lower bounds,
917    and then applying a new 2-dimension shape to this fir.box.
918
919    ```mlir
920      %0 = fir.slice %c10, %c33, %c2 : (index, index, index) -> !fir.slice<1>
921      %1 = fir.shift %c0 : (index) -> !fir.shift<1>
922      %2 = fir.rebox %x(%1) [%0] : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
923      %3 = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
924      %4 = fir.rebox %2(%3) : (!fir.box<!fir.array<?xf32>>, !fir.shape<2>) -> !fir.box<!fir.array<?x?xf32>>
925    ```
926
927  }];
928
929  let arguments = (ins
930    fir_BoxType:$box,
931    Optional<AnyShapeOrShiftType>:$shape,
932    Optional<fir_SliceType>:$slice
933  );
934
935  let results = (outs fir_BoxType);
936
937  let assemblyFormat = [{
938    $box (`(` $shape^ `)`)? (`[` $slice^ `]`)? attr-dict `:` functional-type(operands, results)
939  }];
940
941  let verifier = "return ::verify(*this);";
942}
943
944def fir_EmboxCharOp : fir_Op<"emboxchar", [NoSideEffect]> {
945  let summary = "boxes a given CHARACTER reference and its LEN parameter";
946
947  let description = [{
948    Create a boxed CHARACTER value. The CHARACTER type has the LEN type
949    parameter, the value of which may only be known at runtime.  Therefore,
950    a variable of type CHARACTER has both its data reference as well as a
951    LEN type parameter.
952
953    ```fortran
954      CHARACTER(LEN=10) :: var
955    ```
956    ```mlir
957      %4 = ...         : !fir.ref<!fir.array<10 x !fir.char<1>>>
958      %5 = constant 10 : i32
959      %6 = fir.emboxchar %4, %5 : (!fir.ref<!fir.array<10 x !fir.char<1>>>, i32) -> !fir.boxchar<1>
960    ```
961
962    In the above `%4` is a memory reference to a buffer of 10 CHARACTER units.
963    This buffer and its LEN value (10) are wrapped into a pair in `%6`.
964  }];
965
966  let arguments = (ins AnyReferenceLike:$memref, AnyIntegerLike:$len);
967
968  let results = (outs fir_BoxCharType);
969
970  let assemblyFormat = [{
971    $memref `,` $len attr-dict `:` functional-type(operands, results)
972  }];
973
974  let verifier = "return ::verify(*this);";
975}
976
977def fir_EmboxProcOp : fir_Op<"emboxproc", [NoSideEffect]> {
978  let summary = "boxes a given procedure and optional host context";
979
980  let description = [{
981    Creates an abstract encapsulation of a PROCEDURE POINTER along with an
982    optional pointer to a host instance context. If the pointer is not to an
983    internal procedure or the internal procedure does not need a host context
984    then the form takes only the procedure's symbol.
985
986    ```mlir
987      %0 = fir.emboxproc @f : ((i32) -> i32) -> !fir.boxproc<(i32) -> i32>
988    ```
989
990    An internal procedure requiring a host instance for correct execution uses
991    the second form. The closure of the host procedure's state is passed as a
992    reference to a tuple. It is the responsibility of the host to manage the
993    context's values accordingly, up to and including inhibiting register
994    promotion of local values.
995
996    ```mlir
997      %4 = ... : !fir.ref<tuple<i32, i32>>
998      %5 = fir.emboxproc @g, %4 : ((i32) -> i32, !fir.ref<tuple<i32, i32>>) -> !fir.boxproc<(i32) -> i32>
999    ```
1000  }];
1001
1002  let arguments = (ins SymbolRefAttr:$funcname, AnyReferenceLike:$host);
1003
1004  let results = (outs fir_BoxProcType);
1005
1006  let parser = "return parseEmboxProcOp(parser, result);";
1007
1008  let printer = "::print(p, *this);";
1009
1010  let verifier = "return ::verify(*this);";
1011}
1012
1013def fir_UnboxOp : fir_SimpleOp<"unbox", [NoSideEffect]> {
1014  let summary = "unbox the boxed value into a tuple value";
1015
1016  let description = [{
1017    Unbox a boxed value into a result of multiple values from the box's
1018    component data.  The values are, minimally, a reference to the data of the
1019    entity, the byte-size of one element, the rank, the type descriptor, a set
1020    of flags (packed in an integer, and an array of dimension information (of
1021    size rank).
1022
1023    ```mlir
1024      %40   = ... : !fir.box<!fir.type<T>>
1025      %41:6 = fir.unbox %40 : (!fir.box<!fir.type<T>>) -> (!fir.ref<!fir.type<T>>, i32, i32, !fir.tdesc<!fir.type<T>>, i32, !fir.array<? x index>)
1026    ```
1027  }];
1028
1029  let arguments = (ins fir_BoxType:$box);
1030
1031  let results = (outs
1032    fir_ReferenceType,  // pointer to data
1033    AnyIntegerLike,     // size of a data element
1034    AnyIntegerLike,     // rank of data
1035    fir_TypeDescType,   // abstract type descriptor
1036    AnyIntegerLike,     // attribute flags (bitfields)
1037    fir_SequenceType    // dimension information (if any)
1038  );
1039}
1040
1041def fir_UnboxCharOp : fir_SimpleOp<"unboxchar", [NoSideEffect]> {
1042  let summary = "unbox a boxchar value into a pair value";
1043
1044  let description = [{
1045    Unboxes a value of `boxchar` type into a pair consisting of a memory
1046    reference to the CHARACTER data and the LEN type parameter.
1047
1048    ```mlir
1049      %45   = ... : !fir.boxchar<1>
1050      %46:2 = fir.unboxchar %45 : (!fir.boxchar<1>) -> (!fir.ref<!fir.character<1>>, i32)
1051    ```
1052  }];
1053
1054  let arguments = (ins fir_BoxCharType:$boxchar);
1055
1056  let results = (outs fir_ReferenceType, AnyIntegerLike);
1057}
1058
1059def fir_UnboxProcOp : fir_SimpleOp<"unboxproc", [NoSideEffect]> {
1060  let summary = "unbox a boxproc value into a pair value";
1061
1062  let description = [{
1063    Unboxes a value of `boxproc` type into a pair consisting of a procedure
1064    pointer and a pointer to a host context.
1065
1066    ```mlir
1067      %47   = ... : !fir.boxproc<() -> i32>
1068      %48:2 = fir.unboxproc %47 : (!fir.ref<() -> i32>, !fir.ref<tuple<f32, i32>>)
1069    ```
1070  }];
1071
1072  let verifier = "return ::verify(*this);";
1073
1074  let arguments = (ins fir_BoxProcType:$boxproc);
1075
1076  let results = (outs FunctionType, fir_ReferenceType:$refTuple);
1077}
1078
1079def fir_BoxAddrOp : fir_SimpleOneResultOp<"box_addr", [NoSideEffect]> {
1080  let summary = "return a memory reference to the boxed value";
1081
1082  let description = [{
1083    This operator is overloaded to work with values of type `box`,
1084    `boxchar`, and `boxproc`.  The result for each of these
1085    cases, respectively, is the address of the data, the address of the
1086    `CHARACTER` data, and the address of the procedure.
1087
1088    ```mlir
1089      %51 = fir.box_addr %box : (!fir.box<f64>) -> !fir.ref<f64>
1090      %52 = fir.box_addr %boxchar : (!fir.boxchar<1>) -> !fir.ref<!fir.char<1>>
1091      %53 = fir.box_addr %boxproc : (!fir.boxproc<!P>) -> !fir.ref<!P>
1092    ```
1093  }];
1094
1095  let arguments = (ins fir_BoxType:$val);
1096
1097  let results = (outs AnyReferenceLike);
1098
1099  let hasFolder = 1;
1100}
1101
1102def fir_BoxCharLenOp : fir_SimpleOp<"boxchar_len", [NoSideEffect]> {
1103  let summary = "return the LEN type parameter from a boxchar value";
1104
1105  let description = [{
1106    Extracts the LEN type parameter from a `boxchar` value.
1107
1108    ```mlir
1109      %45 = ... : !boxchar<1>  // CHARACTER(20)
1110      %59 = fir.boxchar_len %45 : (!fir.boxchar<1>) -> i64  // len=20
1111    ```
1112  }];
1113
1114  let arguments = (ins fir_BoxCharType:$val);
1115
1116  let results = (outs AnyIntegerLike);
1117
1118  let hasFolder = 1;
1119}
1120
1121def fir_BoxDimsOp : fir_Op<"box_dims", [NoSideEffect]> {
1122  let summary = "return the dynamic dimension information for the boxed value";
1123
1124  let description = [{
1125    Returns the triple of lower bound, extent, and stride for `dim` dimension
1126    of `val`, which must have a `box` type.  The dimensions are enumerated from
1127    left to right from 0 to rank-1. This operation has undefined behavior if
1128    `dim` is out of bounds.
1129
1130    ```mlir
1131      %c1   = constant 0 : i32
1132      %52:3 = fir.box_dims %40, %c1 : (!fir.box<!fir.array<*:f64>>, i32) -> (index, index, index)
1133    ```
1134
1135    The above is a request to return the left most row (at index 0) triple from
1136    the box. The triple will be the lower bound, extent, and byte-stride, which
1137    are the values encoded in a standard descriptor.
1138  }];
1139
1140  let arguments = (ins fir_BoxType:$val, AnyIntegerLike:$dim);
1141
1142  let results = (outs Index, Index, Index);
1143
1144  let assemblyFormat = [{
1145    $val `,` $dim attr-dict `:` functional-type(operands, results)
1146  }];
1147
1148  let extraClassDeclaration = [{
1149    mlir::Type getTupleType();
1150  }];
1151}
1152
1153def fir_BoxEleSizeOp : fir_SimpleOneResultOp<"box_elesize", [NoSideEffect]> {
1154  let summary = "return the size of an element of the boxed value";
1155
1156  let description = [{
1157    Returns the size of an element in an entity of `box` type.  This size may
1158    not be known until runtime.
1159
1160    ```mlir
1161      %53 = fir.box_elesize %40 : (!fir.box<f32>, i32) -> i32  // size=4
1162      %54 = fir.box_elesize %40 : (!fir.box<!fir.array<*:f32>>, i32) -> i32
1163    ```
1164
1165    In the above example, `%53` may box an array of REAL values while `%54`
1166    must box an array of REAL values (with dynamic rank and extent).
1167  }];
1168
1169  let arguments = (ins fir_BoxType:$val);
1170
1171  let results = (outs AnyIntegerLike);
1172}
1173
1174def fir_BoxIsAllocOp : fir_SimpleOp<"box_isalloc", [NoSideEffect]> {
1175  let summary = "is the boxed value an ALLOCATABLE?";
1176
1177  let description = [{
1178    Determine if the boxed value was from an ALLOCATABLE entity. This will
1179    return true if the originating box value was from a `fir.embox` op
1180    with a mem-ref value that had the type !fir.heap<T>.
1181
1182    ```mlir
1183      %r = ... : !fir.heap<i64>
1184      %b = fir.embox %r : (!fir.heap<i64>) -> !fir.box<i64>
1185      %a = fir.box_isalloc %b : (!fir.box<i64>) -> i1  // true
1186    ```
1187
1188    The canonical descriptor implementation will carry a flag to record if the
1189    variable is an `ALLOCATABLE`.
1190  }];
1191
1192  let arguments = (ins fir_BoxType:$val);
1193
1194  let results = (outs BoolLike);
1195}
1196
1197def fir_BoxIsArrayOp : fir_SimpleOp<"box_isarray", [NoSideEffect]> {
1198  let summary = "is the boxed value an array?";
1199
1200  let description = [{
1201    Determine if the boxed value has a positive (> 0) rank. This will return
1202    true if the originating box value was from a fir.embox with a memory
1203    reference value that had the type !fir.array<T> and/or a shape argument.
1204
1205    ```mlir
1206      %r = ... : !fir.ref<i64>
1207      %c_100 = constant 100 : index
1208      %d = fir.shape %c_100 : (index) -> !fir.shape<1>
1209      %b = fir.embox %r(%d) : (!fir.ref<i64>, !fir.shape<1>) -> !fir.box<i64>
1210      %a = fir.box_isarray %b : (!fir.box<i64>) -> i1  // true
1211    ```
1212  }];
1213
1214  let arguments = (ins fir_BoxType:$val);
1215
1216  let results = (outs BoolLike);
1217}
1218
1219def fir_BoxIsPtrOp : fir_SimpleOp<"box_isptr", [NoSideEffect]> {
1220  let summary = "is the boxed value a POINTER?";
1221
1222  let description = [{
1223    Determine if the boxed value was from a POINTER entity.
1224
1225    ```mlir
1226      %p = ... : !fir.ptr<i64>
1227      %b = fir.embox %p : (!fir.ptr<i64>) -> !fir.box<i64>
1228      %a = fir.box_isptr %b : (!fir.box<i64>) -> i1  // true
1229    ```
1230  }];
1231
1232  let arguments = (ins fir_BoxType:$val);
1233
1234  let results = (outs BoolLike);
1235}
1236
1237def fir_BoxProcHostOp : fir_SimpleOp<"boxproc_host", [NoSideEffect]> {
1238  let summary = "returns the host instance pointer (or null)";
1239
1240  let description = [{
1241    Extract the host context pointer from a boxproc value.
1242
1243    ```mlir
1244      %8 = ... : !fir.boxproc<(!fir.ref<!fir.type<T>>) -> i32>
1245      %9 = fir.boxproc_host %8 : (!fir.boxproc<(!fir.ref<!fir.type<T>>) -> i32>) -> !fir.ref<tuple<i32, i32>>
1246    ```
1247
1248    In the example, the reference to the closure over the host procedure's
1249    variables is returned. This allows an internal procedure to access the
1250    host's variables. It is up to lowering to determine the contract between
1251    the host and the internal procedure.
1252  }];
1253
1254  let arguments = (ins fir_BoxProcType:$val);
1255
1256  let results = (outs fir_ReferenceType);
1257}
1258
1259def fir_BoxRankOp : fir_SimpleOneResultOp<"box_rank", [NoSideEffect]> {
1260  let summary = "return the number of dimensions for the boxed value";
1261
1262  let description = [{
1263    Return the rank of a value of `box` type.  If the value is scalar, the
1264    rank is 0.
1265
1266    ```mlir
1267      %57 = fir.box_rank %40 : (!fir.box<!fir.array<*:f64>>) -> i32
1268      %58 = fir.box_rank %41 : (!fir.box<f64>) -> i32
1269    ```
1270
1271    The example `%57` shows how one would determine the rank of an array that
1272    has deferred rank at runtime. This rank should be at least 1. In %58, the
1273    descriptor may be either an array or a scalar, so the value is nonnegative.
1274  }];
1275
1276  let arguments = (ins fir_BoxType:$val);
1277
1278  let results = (outs AnyIntegerType);
1279}
1280
1281def fir_BoxTypeDescOp : fir_SimpleOneResultOp<"box_tdesc", [NoSideEffect]> {
1282  let summary = "return the type descriptor for the boxed value";
1283
1284  let description = [{
1285    Return the opaque type descriptor of a value of `box` type. A type
1286    descriptor is an implementation defined value that fully describes a type
1287    to the Fortran runtime.
1288
1289    ```mlir
1290      %7 = fir.box_tdesc %41 : (!fir.box<f64>) -> !fir.tdesc<f64>
1291    ```
1292  }];
1293
1294  let arguments = (ins fir_BoxType:$val);
1295
1296  let results = (outs fir_TypeDescType);
1297}
1298
1299//===----------------------------------------------------------------------===//
1300// Array value operations
1301//===----------------------------------------------------------------------===//
1302
1303// Array value operations are used to capture the semantics of
1304// Fortran's array expressions in FIR. An abstract array expression is
1305// evaluated in the following way.
1306//
1307//  1. Determination of the iteration space under which the assignment
1308//     expression is to be evaluated. The iteration space may be implicit
1309//     (from the shape of the result array) or explicit (defined by the user).
1310//  2. If there are masking expressions, evaluate (and cache) the
1311//     masking expression for the iteration space (from 1).
1312//  3. The rhs of the assignment is evaluated for the iteration space. If
1313//     masking expressions were present then the rhs is only evaluated where
1314//     the mask was computed to be true. The entire rhs is completely evaluated
1315//     before any results are stored to the lhs.
1316//  4. Each of the result values computed in the previous step are merged back
1317//     to the lhs array's storage.
1318//
1319// The model (in pseudo-code) is thus:
1320//
1321//   !- Load the arrays in the expression
1322//   %10 = array_load A
1323//   %11 = array_load B
1324//   !- optional: compute mask values
1325//   %masks = allocmem array<??xlogical>
1326//   do_loop_nest %i = ... {
1327//     %masks[i] = ...
1328//   }
1329//   !- Compute every element value "A = B ..."
1330//   do_loop_nest %i = ... {
1331//     if (%masks[i]) {
1332//       array_fetch %11, ...       !- B(...)
1333//       %20 = ...                  !- element-by-element computation
1334//       array_update %10, %20, ... !- A(...) = ...
1335//     }
1336//   }
1337//   !- Merge the new and old values into the memory for "A"
1338//   array_merge_store <updated A> to <A's address>
1339
1340def fir_ArrayLoadOp : fir_Op<"array_load", [AttrSizedOperandSegments]> {
1341
1342  let summary = "Load an array as a value.";
1343
1344  let description = [{
1345    Load an entire array as a single SSA value.
1346
1347    ```fortran
1348      real :: a(o:n,p:m)
1349      ...
1350      ... = ... a ...
1351    ```
1352
1353    One can use `fir.array_load` to produce an ssa-value that captures an
1354    immutable value of the entire array `a`, as in the Fortran array expression
1355    shown above. Subsequent changes to the memory containing the array do not
1356    alter its composite value. This operation let's one load an array as a
1357    value while applying a runtime shape, shift, or slice to the memory
1358    reference, and its semantics guarantee immutability.
1359
1360    ```mlir
1361      %s = fir.shape_shift %o, %n, %p, %m : (index, index, index, index) -> !fir.shape<2>
1362      // load the entire array 'a'
1363      %v = fir.array_load %a(%s) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.array<?x?xf32>
1364      // a fir.store here into array %a does not change %v
1365    ```
1366  }];
1367
1368  let arguments = (ins
1369    Arg<AnyRefOrBox, "", [MemRead]>:$memref,
1370    Optional<AnyShapeOrShiftType>:$shape,
1371    Optional<fir_SliceType>:$slice,
1372    Variadic<AnyIntegerType>:$typeparams
1373  );
1374
1375  let results = (outs fir_SequenceType);
1376
1377  let assemblyFormat = [{
1378    $memref (`(`$shape^`)`)? (`[`$slice^`]`)? (`typeparams` $typeparams^)?
1379        attr-dict `:` functional-type(operands, results)
1380  }];
1381
1382  let verifier = "return ::verify(*this);";
1383
1384  let extraClassDeclaration = [{
1385    std::vector<mlir::Value> getExtents();
1386  }];
1387}
1388
1389def fir_ArrayFetchOp : fir_Op<"array_fetch", [AttrSizedOperandSegments,
1390    NoSideEffect]> {
1391
1392  let summary = "Fetch the value of an element of an array value";
1393
1394  let description = [{
1395    Fetch the value of an element in an array value.
1396
1397    ```fortran
1398      real :: a(n,m)
1399      ...
1400      ... a ...
1401      ... a(r,s+1) ...
1402    ```
1403
1404    One can use `fir.array_fetch` to fetch the (implied) value of `a(i,j)` in
1405    an array expression as shown above. It can also be used to extract the
1406    element `a(r,s+1)` in the second expression.
1407
1408    ```mlir
1409      %s = fir.shape %n, %m : (index, index) -> !fir.shape<2>
1410      // load the entire array 'a'
1411      %v = fir.array_load %a(%s) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.array<?x?xf32>
1412      // fetch the value of one of the array value's elements
1413      %1 = fir.array_fetch %v, %i, %j : (!fir.array<?x?xf32>, index, index) -> f32
1414    ```
1415
1416    It is only possible to use `array_fetch` on an `array_load` result value.
1417  }];
1418
1419  let arguments = (ins
1420    fir_SequenceType:$sequence,
1421    Variadic<AnyCoordinateType>:$indices,
1422    Variadic<AnyIntegerType>:$typeparams
1423  );
1424
1425  let results = (outs AnyType:$element);
1426
1427  let assemblyFormat = [{
1428    $sequence `,` $indices (`typeparams` $typeparams^)? attr-dict `:`
1429      functional-type(operands, results)
1430  }];
1431
1432  let verifier = "return ::verify(*this);";
1433}
1434
1435def fir_ArrayUpdateOp : fir_Op<"array_update", [AttrSizedOperandSegments,
1436    NoSideEffect]> {
1437
1438  let summary = "Update the value of an element of an array value";
1439
1440  let description = [{
1441    Updates the value of an element in an array value. A new array value is
1442    returned where all element values of the input array are identical except
1443    for the selected element which is the value passed in the update.
1444
1445    ```fortran
1446      real :: a(n,m)
1447      ...
1448      a = ...
1449    ```
1450
1451    One can use `fir.array_update` to update the (implied) value of `a(i,j)`
1452    in an array expression as shown above.
1453
1454    ```mlir
1455      %s = fir.shape %n, %m : (index, index) -> !fir.shape<2>
1456      // load the entire array 'a'
1457      %v = fir.array_load %a(%s) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.array<?x?xf32>
1458      // update the value of one of the array value's elements
1459      // %r_{ij} = %f  if (i,j) = (%i,%j),   %v_{ij} otherwise
1460      %r = fir.array_update %v, %f, %i, %j : (!fir.array<?x?xf32>, f32, index, index) -> !fir.array<?x?xf32>
1461      fir.array_merge_store %v, %r to %a : !fir.ref<!fir.array<?x?xf32>>
1462    ```
1463
1464    An array value update behaves as if a mapping function from the indices
1465    to the new value has been added, replacing the previous mapping. These
1466    mappings can be added to the ssa-value, but will not be materialized in
1467    memory until the `fir.array_merge_store` is performed.
1468  }];
1469
1470  let arguments = (ins
1471    fir_SequenceType:$sequence,
1472    AnyType:$merge,
1473    Variadic<AnyCoordinateType>:$indices,
1474    Variadic<AnyIntegerType>:$typeparams
1475  );
1476
1477  let results = (outs fir_SequenceType);
1478
1479  let assemblyFormat = [{
1480    $sequence `,` $merge `,` $indices (`typeparams` $typeparams^)? attr-dict
1481      `:` functional-type(operands, results)
1482  }];
1483
1484  let verifier = "return ::verify(*this);";
1485}
1486
1487def fir_ArrayModifyOp : fir_Op<"array_modify", [AttrSizedOperandSegments,
1488    NoSideEffect]> {
1489  let summary = "Get an address for an array value to modify it.";
1490
1491  let description = [{
1492    Modify the value of an element in an array value through actions done
1493    on the returned address. A new array value is also
1494    returned where all element values of the input array are identical except
1495    for the selected element which is the value after the modification done
1496    on the element address.
1497
1498    ```fortran
1499      real :: a(n)
1500      ...
1501      ! Elemental user defined assignment from type(SomeType) to real.
1502      a = value_of_some_type
1503    ```
1504
1505    One can use `fir.array_modify` to update the (implied) value of `a(i)`
1506    in an array expression as shown above.
1507
1508    ```mlir
1509      %s = fir.shape %n : (index) -> !fir.shape<1>
1510      // Load the entire array 'a'.
1511      %v = fir.array_load %a(%s) : (!fir.ref<!fir.array<?xf32>>, !fir.shape<1>)
1512          -> !fir.array<?xf32>
1513      // Update the value of one of the array value's elements with a user
1514      // defined assignment from %rhs.
1515      %new = fir.do_loop %i = ... (%inner = %v) {
1516        %rhs = ...
1517        %addr, %r = fir.array_modify %inner, %i, %j : (!fir.array<?xf32>,
1518	    index) -> fir.ref<f32>, !fir.array<?xf32>
1519        fir.call @user_def_assign(%addr, %rhs) (fir.ref<f32>,
1520	    fir.ref<!fir.type<SomeType>>) -> ()
1521        fir.result %r : !fir.ref<!fir.array<?xf32>>
1522      }
1523      fir.array_merge_store %v, %new to %a : !fir.ref<!fir.array<?xf32>>
1524    ```
1525
1526    An array value modification behaves as if a mapping function from the indices
1527    to the new value has been added, replacing the previous mapping. These
1528    mappings can be added to the ssa-value, but will not be materialized in
1529    memory until the `fir.array_merge_store` is performed.
1530  }];
1531
1532  let arguments = (ins
1533    fir_SequenceType:$sequence,
1534    Variadic<AnyCoordinateType>:$indices,
1535    Variadic<AnyIntegerType>:$typeparams
1536  );
1537
1538  let results = (outs fir_ReferenceType, fir_SequenceType);
1539
1540  let assemblyFormat = [{
1541    $sequence `,` $indices (`typeparams` $typeparams^)? attr-dict
1542      `:` functional-type(operands, results)
1543  }];
1544
1545  let verifier = [{ return ::verify(*this); }];
1546}
1547
1548def fir_ArrayMergeStoreOp : fir_Op<"array_merge_store",
1549    [AttrSizedOperandSegments]> {
1550
1551  let summary = "Store merged array value to memory.";
1552
1553  let description = [{
1554    Store a merged array value to memory.
1555
1556    ```fortran
1557      real :: a(n,m)
1558      ...
1559      a = ...
1560    ```
1561
1562    One can use `fir.array_merge_store` to merge/copy the value of `a` in an
1563    array expression as shown above.
1564
1565    ```mlir
1566      %v = fir.array_load %a(%shape) : ...
1567      %r = fir.array_update %v, %f, %i, %j : (!fir.array<?x?xf32>, f32, index, index) -> !fir.array<?x?xf32>
1568      fir.array_merge_store %v, %r to %a : !fir.ref<!fir.array<?x?xf32>>
1569    ```
1570
1571    This operation merges the original loaded array value, `%v`, with the
1572    chained updates, `%r`, and stores the result to the array at address, `%a`.
1573  }];
1574
1575  let arguments = (ins
1576    fir_SequenceType:$original,
1577    fir_SequenceType:$sequence,
1578    Arg<AnyRefOrBox, "", [MemWrite]>:$memref,
1579    Optional<fir_SliceType>:$slice,
1580    Variadic<AnyIntegerType>:$typeparams
1581  );
1582
1583  let assemblyFormat = [{
1584    $original `,` $sequence `to` $memref (`[` $slice^ `]`)? (`typeparams`
1585      $typeparams^)? attr-dict `:` type(operands)
1586  }];
1587
1588  let verifier = "return ::verify(*this);";
1589}
1590
1591//===----------------------------------------------------------------------===//
1592// Record and array type operations
1593//===----------------------------------------------------------------------===//
1594
1595def fir_ArrayCoorOp : fir_Op<"array_coor",
1596    [NoSideEffect, AttrSizedOperandSegments]> {
1597
1598  let summary = "Find the coordinate of an element of an array";
1599
1600  let description = [{
1601    Compute the location of an element in an array when the shape of the
1602    array is only known at runtime.
1603
1604    This operation is intended to capture all the runtime values needed to
1605    compute the address of an array reference in a single high-level op. Given
1606    the following Fortran input:
1607
1608    ```fortran
1609      real :: a(n,m)
1610      ...
1611      ... a(i,j) ...
1612    ```
1613
1614    One can use `fir.array_coor` to determine the address of `a(i,j)`.
1615
1616    ```mlir
1617      %s = fir.shape %n, %m : (index, index) -> !fir.shape<2>
1618      %1 = fir.array_coor %a(%s) %i, %j : (!fir.ref<!fir.array<?x?xf32>>, !fir.shape<2>, index, index) -> !fir.ref<f32>
1619    ```
1620  }];
1621
1622  let arguments = (ins
1623    AnyRefOrBox:$memref,
1624    Optional<AnyShapeOrShiftType>:$shape,
1625    Optional<fir_SliceType>:$slice,
1626    Variadic<AnyCoordinateType>:$indices,
1627    Variadic<AnyIntegerType>:$typeparams
1628  );
1629
1630  let results = (outs fir_ReferenceType);
1631
1632  let assemblyFormat = [{
1633    $memref (`(`$shape^`)`)? (`[`$slice^`]`)? $indices (`typeparams`
1634      $typeparams^)? attr-dict `:` functional-type(operands, results)
1635  }];
1636
1637  let verifier = "return ::verify(*this);";
1638}
1639
1640def fir_CoordinateOp : fir_Op<"coordinate_of", [NoSideEffect]> {
1641
1642  let summary = "Finds the coordinate (location) of a value in memory";
1643
1644  let description = [{
1645    Compute the internal coordinate address starting from a boxed value or
1646    unboxed memory reference. Returns a memory reference. When computing the
1647    coordinate of an array element, the rank of the array must be known and
1648    the number of indexing expressions must equal the rank of the array.
1649
1650    This operation will apply the access map from a boxed value implicitly.
1651
1652    Unlike LLVM's GEP instruction, one cannot stride over the outermost
1653    reference; therefore, the leading 0 index must be omitted.
1654
1655    ```mlir
1656      %i = ... : index
1657      %h = ... : !fir.heap<!fir.array<100 x f32>>
1658      %p = fir.coordinate_of %h, %i : (!fir.heap<!fir.array<100 x f32>>, index) -> !fir.ref<f32>
1659    ```
1660
1661    In the example, `%p` will be a pointer to the `%i`-th f32 value in the
1662    array `%h`.
1663  }];
1664
1665  let arguments = (ins
1666    AnyRefOrBox:$ref,
1667    Variadic<AnyCoordinateType>:$coor,
1668    TypeAttr:$baseType
1669  );
1670
1671  let results = (outs fir_ReferenceType);
1672
1673  let parser =  "return parseCoordinateCustom(parser, result);";
1674  let printer = "::print(p, *this);";
1675  let verifier = "return ::verify(*this);";
1676
1677  let builders = [
1678    OpBuilder<(ins "mlir::Type":$resultType,
1679      "mlir::Value":$ref, "mlir::ValueRange":$coor),
1680    [{ return build($_builder, $_state, resultType, ref, coor,
1681           mlir::TypeAttr::get(ref.getType())); }]>,
1682  ];
1683
1684  let extraClassDeclaration = [{
1685    /// Get the type of the base object.
1686    mlir::Type getBaseType() { return baseType(); }
1687  }];
1688}
1689
1690def fir_ExtractValueOp : fir_OneResultOp<"extract_value", [NoSideEffect]> {
1691  let summary = "Extract a value from an aggregate SSA-value";
1692
1693  let description = [{
1694    Extract a value from an entity with a type composed of tuples, arrays,
1695    and/or derived types. Returns the value from entity with the type of the
1696    specified component. Cannot be used on values of `!fir.box` type.
1697    It can also be used to access complex parts and elements of a character
1698    string.
1699
1700    Note that the entity ssa-value must be of compile-time known size in order
1701    to use this operation.
1702
1703    ```mlir
1704      %f = fir.field_index field, !fir.type<X{field:i32}>
1705      %s = ... : !fir.type<X>
1706      %v = fir.extract_value %s, %f : (!fir.type<X>, !fir.field) -> i32
1707    ```
1708  }];
1709
1710  let arguments = (ins
1711    AnyCompositeLike:$adt,
1712    ArrayAttr:$coor
1713  );
1714
1715  let assemblyFormat = [{
1716    $adt `,` $coor attr-dict `:` functional-type(operands, results)
1717  }];
1718
1719  let builders = [
1720    OpBuilder<(ins "mlir::Type":$rty, "mlir::Value":$adt,
1721      "llvm::ArrayRef<mlir::Value>":$vcoor)>
1722  ];
1723}
1724
1725def fir_FieldIndexOp : fir_OneResultOp<"field_index", [NoSideEffect]> {
1726  let summary = "create a field index value from a field identifier";
1727
1728  let description = [{
1729    Generate a field (offset) value from an identifier.  Field values may be
1730    lowered into exact offsets when the layout of a Fortran derived type is
1731    known at compile-time. The type of a field value is `!fir.field` and
1732    these values can be used with the `fir.coordinate_of`, `fir.extract_value`,
1733    or `fir.insert_value` instructions to compute (abstract) addresses of
1734    subobjects.
1735
1736    ```mlir
1737      %f = fir.field_index field, !fir.type<X{field:i32}>
1738    ```
1739  }];
1740
1741  let arguments = (ins
1742    StrAttr:$field_id,
1743    TypeAttr:$on_type,
1744    Variadic<AnyIntegerType>:$typeparams
1745  );
1746
1747  let parser = "return parseFieldIndexOp(parser, result);";
1748
1749  let printer = "::print(p, *this);";
1750
1751  let builders = [OpBuilder<(ins "llvm::StringRef":$fieldName,
1752      "mlir::Type":$recTy, CArg<"mlir::ValueRange","{}">:$operands)>];
1753
1754  let extraClassDeclaration = [{
1755    static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
1756    static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
1757    llvm::StringRef getFieldName() { return field_id(); }
1758  }];
1759}
1760
1761def fir_ShapeOp : fir_Op<"shape", [NoSideEffect]> {
1762
1763  let summary = "generate an abstract shape vector of type `!fir.shape`";
1764
1765  let description = [{
1766    The arguments are an ordered list of integral type values that define the
1767    runtime extent of each dimension of an array. The shape information is
1768    given in the same row-to-column order as Fortran. This abstract shape value
1769    must be applied to a reified object, so all shape information must be
1770    specified.  The extent must be nonnegative.
1771
1772    ```mlir
1773      %d = fir.shape %row_sz, %col_sz : (index, index) -> !fir.shape<2>
1774    ```
1775  }];
1776
1777  let arguments = (ins Variadic<AnyIntegerType>:$extents);
1778
1779  let results = (outs fir_ShapeType);
1780
1781  let assemblyFormat = [{
1782    operands attr-dict `:` functional-type(operands, results)
1783  }];
1784
1785  let verifier = "return ::verify(*this);";
1786
1787  let extraClassDeclaration = [{
1788    std::vector<mlir::Value> getExtents() {
1789      return {extents().begin(), extents().end()};
1790    }
1791  }];
1792}
1793
1794def fir_ShapeShiftOp : fir_Op<"shape_shift", [NoSideEffect]> {
1795
1796  let summary = [{
1797    generate an abstract shape and shift vector of type `!fir.shapeshift`
1798  }];
1799
1800  let description = [{
1801    The arguments are an ordered list of integral type values that is a multiple
1802    of 2 in length. Each such pair is defined as: the lower bound and the
1803    extent for that dimension. The shifted shape information is given in the
1804    same row-to-column order as Fortran. This abstract shifted shape value must
1805    be applied to a reified object, so all shifted shape information must be
1806    specified.  The extent must be nonnegative.
1807
1808    ```mlir
1809      %d = fir.shape_shift %lo, %extent : (index, index) -> !fir.shapeshift<1>
1810    ```
1811  }];
1812
1813  let arguments = (ins Variadic<AnyIntegerType>:$pairs);
1814
1815  let results = (outs fir_ShapeShiftType);
1816
1817  let assemblyFormat = [{
1818    operands attr-dict `:` functional-type(operands, results)
1819  }];
1820
1821  let verifier = "return ::verify(*this);";
1822
1823  let extraClassDeclaration = [{
1824    // Logically unzip the origins from the extent values.
1825    std::vector<mlir::Value> getOrigins() {
1826      std::vector<mlir::Value> result;
1827      for (auto i : llvm::enumerate(pairs()))
1828        if (!(i.index() & 1))
1829          result.push_back(i.value());
1830      return result;
1831    }
1832
1833    // Logically unzip the extents from the origin values.
1834    std::vector<mlir::Value> getExtents() {
1835      std::vector<mlir::Value> result;
1836      for (auto i : llvm::enumerate(pairs()))
1837        if (i.index() & 1)
1838          result.push_back(i.value());
1839      return result;
1840    }
1841  }];
1842}
1843
1844def fir_ShiftOp : fir_Op<"shift", [NoSideEffect]> {
1845
1846  let summary = "generate an abstract shift vector of type `!fir.shift`";
1847
1848  let description = [{
1849    The arguments are an ordered list of integral type values that define the
1850    runtime lower bound of each dimension of an array. The shape information is
1851    given in the same row-to-column order as Fortran. This abstract shift value
1852    must be applied to a reified object, so all shift information must be
1853    specified.
1854
1855    ```mlir
1856      %d = fir.shift %row_lb, %col_lb : (index, index) -> !fir.shift<2>
1857    ```
1858  }];
1859
1860  let arguments = (ins Variadic<AnyIntegerType>:$origins);
1861
1862  let results = (outs fir_ShiftType);
1863
1864  let assemblyFormat = [{
1865    operands attr-dict `:` functional-type(operands, results)
1866  }];
1867
1868  let verifier = "return ::verify(*this);";
1869
1870  let extraClassDeclaration = [{
1871    std::vector<mlir::Value> getOrigins() {
1872      return {origins().begin(), origins().end()};
1873    }
1874  }];
1875}
1876
1877def fir_SliceOp : fir_Op<"slice", [NoSideEffect, AttrSizedOperandSegments]> {
1878
1879  let summary = "generate an abstract slice vector of type `!fir.slice`";
1880
1881  let description = [{
1882    The array slicing arguments are an ordered list of integral type values
1883    that must be a multiple of 3 in length.  Each such triple is defined as:
1884    the lower bound, the upper bound, and the stride for that dimension, as in
1885    Fortran syntax. Both bounds are inclusive. The array slice information is
1886    given in the same row-to-column order as Fortran. This abstract slice value
1887    must be applied to a reified object, so all slice information must be
1888    specified.  The extent must be nonnegative and the stride must not be zero.
1889
1890    ```mlir
1891      %d = fir.slice %lo, %hi, %step : (index, index, index) -> !fir.slice<1>
1892    ```
1893
1894    To support generalized slicing of Fortran's dynamic derived types, a slice
1895    op can be given a component path (narrowing from the product type of the
1896    original array to the specific elemental type of the sliced projection).
1897
1898    ```mlir
1899      %fld = fir.field_index component, !fir.type<t{...component:ct...}>
1900      %d = fir.slice %lo, %hi, %step path %fld : (index, index, index, !fir.field) -> !fir.slice<1>
1901    ```
1902  }];
1903
1904  let arguments = (ins
1905    Variadic<AnyCoordinateType>:$triples,
1906    Variadic<AnyComponentType>:$fields
1907  );
1908
1909  let results = (outs fir_SliceType);
1910
1911  let assemblyFormat = [{
1912    $triples (`path` $fields^)? attr-dict `:` functional-type(operands, results)
1913  }];
1914
1915  let verifier = "return ::verify(*this);";
1916
1917  let extraClassDeclaration = [{
1918    unsigned getOutRank() { return getOutputRank(triples()); }
1919    static unsigned getOutputRank(mlir::ValueRange triples);
1920  }];
1921}
1922
1923def fir_InsertValueOp : fir_OneResultOp<"insert_value", [NoSideEffect]> {
1924  let summary = "insert a new sub-value into a copy of an existing aggregate";
1925
1926  let description = [{
1927    Insert a value into an entity with a type composed of tuples, arrays,
1928    and/or derived types. Returns a new ssa value with the same type as the
1929    original entity. Cannot be used on values of `!fir.box` type.
1930    It can also be used to set complex parts and elements of a character
1931    string.
1932
1933    Note that the entity ssa-value must be of compile-time known size in order
1934    to use this operation.
1935
1936    ```mlir
1937      %a = ... : !fir.array<10xtuple<i32, f32>>
1938      %f = ... : f32
1939      %o = ... : i32
1940      %c = constant 1 : i32
1941      %b = fir.insert_value %a, %f, %o, %c : (!fir.array<10x20xtuple<i32, f32>>, f32, i32, i32) -> !fir.array<10x20xtuple<i32, f32>>
1942    ```
1943  }];
1944
1945  let arguments = (ins AnyCompositeLike:$adt, AnyType:$val, ArrayAttr:$coor);
1946  let results = (outs AnyCompositeLike);
1947
1948  let assemblyFormat = [{
1949    $adt `,` $val `,` $coor attr-dict `:` functional-type(operands, results)
1950  }];
1951
1952  let builders = [
1953    OpBuilder<(ins "mlir::Type":$rty, "mlir::Value":$adt, "mlir::Value":$val,
1954      "llvm::ArrayRef<mlir::Value>":$vcoor)>
1955  ];
1956
1957  let hasCanonicalizer = 1;
1958}
1959
1960def fir_InsertOnRangeOp : fir_OneResultOp<"insert_on_range", [NoSideEffect]> {
1961  let summary = "insert sub-value into a range on an existing sequence";
1962
1963  let description = [{
1964    Insert copies of a value into an entity with an array type.
1965    Returns a new ssa value with the same type as the original entity.
1966    The values are inserted at a contiguous range of indices in Fortran
1967    row-to-column element order as specified by lower and upper bound
1968    coordinates.
1969
1970    ```mlir
1971      %a = fir.undefined !fir.array<10x10xf32>
1972      %c = constant 3.0 : f32
1973      %1 = fir.insert_on_range %a, %c, [0 : index, 7 : index, 0 : index, 2 : index] : (!fir.array<10x10xf32>, f32) -> !fir.array<10x10xf32>
1974    ```
1975
1976    The first 28 elements of %1, with coordinates from (0,0) to (7,2), have
1977    the value 3.0.
1978  }];
1979
1980  let arguments = (ins fir_SequenceType:$seq, AnyType:$val, ArrayAttr:$coor);
1981  let results = (outs fir_SequenceType);
1982
1983  let assemblyFormat = [{
1984    $seq `,` $val `,` $coor attr-dict `:` functional-type(operands, results)
1985  }];
1986
1987  let builders = [
1988    OpBuilder<(ins "mlir::Type":$rty, "mlir::Value":$adt, "mlir::Value":$val,
1989      "llvm::ArrayRef<mlir::Value>":$vcoor)>
1990  ];
1991
1992  let verifier = [{ return ::verify(*this); }];
1993}
1994
1995def fir_LenParamIndexOp : fir_OneResultOp<"len_param_index", [NoSideEffect]> {
1996  let summary =
1997    "create a field index value from a LEN type parameter identifier";
1998
1999  let description = [{
2000    Generate a LEN parameter (offset) value from an LEN parameter identifier.
2001    The type of a LEN parameter value is `!fir.len` and these values can be
2002    used with the `fir.coordinate_of` instructions to compute (abstract)
2003    addresses of LEN parameters.
2004
2005    ```mlir
2006      %e = fir.len_param_index len1, !fir.type<X(len1:i32)>
2007      %p = ... : !fir.box<!fir.type<X>>
2008      %q = fir.coordinate_of %p, %e : (!fir.box<!fir.type<X>>, !fir.len) -> !fir.ref<i32>
2009    ```
2010  }];
2011
2012  let arguments = (ins StrAttr:$field_id, TypeAttr:$on_type);
2013
2014  let parser = "return parseLenParamIndexOp(parser, result);";
2015
2016  let printer = "::print(p, *this);";
2017
2018  let builders = [OpBuilder<(ins "llvm::StringRef":$fieldName,
2019      "mlir::Type":$recTy),
2020    [{
2021      $_state.addAttribute(fieldAttrName(), $_builder.getStringAttr(fieldName));
2022      $_state.addAttribute(typeAttrName(), TypeAttr::get(recTy));
2023    }]
2024  >];
2025
2026  let extraClassDeclaration = [{
2027    static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
2028    static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
2029    mlir::Type getOnType() {
2030      return (*this)->getAttrOfType<TypeAttr>(typeAttrName()).getValue();
2031    }
2032  }];
2033}
2034
2035//===----------------------------------------------------------------------===//
2036// Fortran loops
2037//===----------------------------------------------------------------------===//
2038
2039def fir_ResultOp : fir_Op<"result",
2040    [NoSideEffect, ReturnLike, Terminator,
2041     ParentOneOf<["IfOp", "DoLoopOp", "IterWhileOp"]>]> {
2042  let summary = "special terminator for use in fir region operations";
2043
2044  let description = [{
2045    Result takes a list of ssa-values produced in the block and forwards them
2046    as a result to the operation that owns the region of the block. The
2047    operation can retain the values or return them to its parent block
2048    depending upon its semantics.
2049  }];
2050
2051  let arguments = (ins Variadic<AnyType>:$results);
2052  let builders = [OpBuilder<(ins), [{ /* do nothing */ }]>];
2053
2054  let assemblyFormat = "($results^ `:` type($results))? attr-dict";
2055
2056  let verifier = "return ::verify(*this);";
2057}
2058
2059def FirRegionTerminator : SingleBlockImplicitTerminator<"ResultOp">;
2060
2061class region_Op<string mnemonic, list<OpTrait> traits = []> :
2062    fir_Op<mnemonic,
2063    !listconcat(traits, [FirRegionTerminator, RecursiveSideEffects])> {
2064  let printer = "return ::print(p, *this);";
2065  let verifier = "return ::verify(*this);";
2066  let parser = "return ::parse$cppClass(parser, result);";
2067}
2068
2069def fir_DoLoopOp : region_Op<"do_loop",
2070    [DeclareOpInterfaceMethods<LoopLikeOpInterface>]> {
2071  let summary = "generalized loop operation";
2072  let description = [{
2073    Generalized high-level looping construct. This operation is similar to
2074    MLIR's `scf.for`.
2075
2076    ```mlir
2077      %l = constant 0 : index
2078      %u = constant 9 : index
2079      %s = constant 1 : index
2080      fir.do_loop %i = %l to %u step %s unordered {
2081        %x = fir.convert %i : (index) -> i32
2082        %v = fir.call @compute(%x) : (i32) -> f32
2083        %p = fir.coordinate_of %A, %i : (!fir.ref<!fir.array<?xf32>>, index) -> !fir.ref<f32>
2084        fir.store %v to %p : !fir.ref<f32>
2085      }
2086    ```
2087
2088    The above example iterates over the interval `[%l, %u]`. The unordered
2089    keyword indicates that the iterations can be executed in any order.
2090  }];
2091
2092  let arguments = (ins
2093    Index:$lowerBound,
2094    Index:$upperBound,
2095    Index:$step,
2096    Variadic<AnyType>:$initArgs,
2097    OptionalAttr<UnitAttr>:$unordered,
2098    OptionalAttr<UnitAttr>:$finalValue
2099  );
2100  let results = (outs Variadic<AnyType>:$results);
2101  let regions = (region SizedRegion<1>:$region);
2102
2103  let skipDefaultBuilders = 1;
2104  let builders = [
2105    OpBuilder<(ins "mlir::Value":$lowerBound, "mlir::Value":$upperBound,
2106      "mlir::Value":$step, CArg<"bool", "false">:$unordered,
2107      CArg<"bool", "false">:$finalCountValue,
2108      CArg<"mlir::ValueRange", "llvm::None">:$iterArgs,
2109      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>
2110  ];
2111
2112  let extraClassDeclaration = [{
2113    mlir::Value getInductionVar() { return getBody()->getArgument(0); }
2114    mlir::OpBuilder getBodyBuilder() {
2115      return OpBuilder(getBody(), std::prev(getBody()->end()));
2116    }
2117    mlir::Block::BlockArgListType getRegionIterArgs() {
2118      return getBody()->getArguments().drop_front();
2119    }
2120    mlir::Operation::operand_range getIterOperands() {
2121      return getOperands().drop_front(getNumControlOperands());
2122    }
2123
2124    void setLowerBound(Value bound) { (*this)->setOperand(0, bound); }
2125    void setUpperBound(Value bound) { (*this)->setOperand(1, bound); }
2126    void setStep(Value step) { (*this)->setOperand(2, step); }
2127
2128    /// Number of region arguments for loop-carried values
2129    unsigned getNumRegionIterArgs() {
2130      return getBody()->getNumArguments() - 1;
2131    }
2132    /// Number of operands controlling the loop: lb, ub, step
2133    unsigned getNumControlOperands() { return 3; }
2134    /// Does the operation hold operands for loop-carried values
2135    bool hasIterOperands() {
2136      return (*this)->getNumOperands() > getNumControlOperands();
2137    }
2138    /// Get Number of loop-carried values
2139    unsigned getNumIterOperands() {
2140      return (*this)->getNumOperands() - getNumControlOperands();
2141    }
2142
2143    /// Get the body of the loop
2144    mlir::Block *getBody() { return &region().front(); }
2145
2146    void setUnordered() {
2147      unorderedAttr(mlir::UnitAttr::get(getContext()));
2148    }
2149
2150    mlir::BlockArgument iterArgToBlockArg(mlir::Value iterArg);
2151    void resultToSourceOps(llvm::SmallVectorImpl<mlir::Value> &results,
2152                           unsigned resultNum);
2153    mlir::Value blockArgToSourceOp(unsigned blockArgNum);
2154  }];
2155}
2156
2157def fir_IfOp : region_Op<"if", [NoRegionArguments]> {
2158  let summary = "if-then-else conditional operation";
2159  let description = [{
2160    Used to conditionally execute operations. This operation is the FIR
2161    dialect's version of `loop.if`.
2162
2163    ```mlir
2164      %56 = ... : i1
2165      %78 = ... : !fir.ref<!T>
2166      fir.if %56 {
2167        fir.store %76 to %78 : !fir.ref<!T>
2168      } else {
2169        fir.store %77 to %78 : !fir.ref<!T>
2170      }
2171    ```
2172  }];
2173
2174  let arguments = (ins I1:$condition);
2175  let results = (outs Variadic<AnyType>:$results);
2176
2177  let regions = (region
2178    SizedRegion<1>:$thenRegion,
2179    AnyRegion:$elseRegion
2180  );
2181
2182  let skipDefaultBuilders = 1;
2183  let builders = [
2184    OpBuilder<(ins "mlir::Value":$cond, "bool":$withElseRegion)>,
2185    OpBuilder<(ins "mlir::TypeRange":$resultTypes, "mlir::Value":$cond,
2186        "bool":$withElseRegion)>
2187  ];
2188
2189  let extraClassDeclaration = [{
2190    mlir::OpBuilder getThenBodyBuilder() {
2191      assert(!thenRegion().empty() && "Unexpected empty 'where' region.");
2192      mlir::Block &body = thenRegion().front();
2193      return mlir::OpBuilder(&body, std::prev(body.end()));
2194    }
2195    mlir::OpBuilder getElseBodyBuilder() {
2196      assert(!elseRegion().empty() && "Unexpected empty 'other' region.");
2197      mlir::Block &body = elseRegion().front();
2198      return mlir::OpBuilder(&body, std::prev(body.end()));
2199    }
2200
2201    void resultToSourceOps(llvm::SmallVectorImpl<mlir::Value> &results,
2202                           unsigned resultNum);
2203  }];
2204}
2205
2206def fir_IterWhileOp : region_Op<"iterate_while",
2207    [DeclareOpInterfaceMethods<LoopLikeOpInterface>]> {
2208  let summary = "DO loop with early exit condition";
2209  let description = [{
2210    This single-entry, single-exit looping construct is useful for lowering
2211    counted loops that can exit early such as, for instance, implied-DO loops.
2212    It is very similar to `fir::DoLoopOp` with the addition that it requires
2213    a single loop-carried bool value that signals an early exit condition to
2214    the operation. A `true` disposition means the next loop iteration should
2215    proceed. A `false` indicates that the `fir.iterate_while` operation should
2216    terminate and return its iteration arguments. This is a degenerate counted
2217    loop in that the loop is not guaranteed to execute all iterations.
2218
2219    An example iterate_while that returns the counter value, the early
2220    termination condition, and an extra loop-carried value is shown here. This
2221    loop counts from %lo to %up (inclusive), stepping by %c1, so long as the
2222    early exit (%ok) is true. The iter_args %sh value is also carried by the
2223    loop. The result triple is the values of %i=phi(%lo,%i+%c1),
2224    %ok=phi(%okIn,%okNew), and %sh=phi(%shIn,%shNew) from the last executed
2225    iteration.
2226
2227    ```mlir
2228      %v:3 = fir.iterate_while (%i = %lo to %up step %c1) and (%ok = %okIn) iter_args(%sh = %shIn) -> (index, i1, i16) {
2229        %shNew = fir.call @bar(%sh) : (i16) -> i16
2230        %okNew = fir.call @foo(%sh) : (i16) -> i1
2231        fir.result %i, %okNew, %shNew : index, i1, i16
2232      }
2233    ```
2234  }];
2235
2236  let arguments = (ins
2237    Index:$lowerBound,
2238    Index:$upperBound,
2239    Index:$step,
2240    I1:$iterateIn,
2241    Variadic<AnyType>:$initArgs,
2242    OptionalAttr<UnitAttr>:$finalValue
2243  );
2244  let results = (outs Variadic<AnyType>:$results);
2245  let regions = (region SizedRegion<1>:$region);
2246
2247  let skipDefaultBuilders = 1;
2248  let builders = [
2249    OpBuilder<(ins "mlir::Value":$lowerBound, "mlir::Value":$upperBound,
2250      "mlir::Value":$step, "mlir::Value":$iterate,
2251      CArg<"bool", "false">:$finalCountValue,
2252      CArg<"mlir::ValueRange", "llvm::None">:$iterArgs,
2253      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attributes)>
2254  ];
2255
2256  let extraClassDeclaration = [{
2257    static constexpr llvm::StringRef getFinalValueAttrName() {
2258      return "finalValue";
2259    }
2260    mlir::Block *getBody() { return &region().front(); }
2261    mlir::Value getIterateVar() { return getBody()->getArgument(1); }
2262    mlir::Value getInductionVar() { return getBody()->getArgument(0); }
2263    mlir::OpBuilder getBodyBuilder() {
2264      return mlir::OpBuilder(getBody(), std::prev(getBody()->end()));
2265    }
2266    mlir::Block::BlockArgListType getRegionIterArgs() {
2267      return getBody()->getArguments().drop_front();
2268    }
2269    mlir::Operation::operand_range getIterOperands() {
2270      return getOperands().drop_front(getNumControlOperands());
2271    }
2272
2273    void setLowerBound(Value bound) { (*this)->setOperand(0, bound); }
2274    void setUpperBound(Value bound) { (*this)->setOperand(1, bound); }
2275    void setStep(mlir::Value step) { (*this)->setOperand(2, step); }
2276
2277    /// Number of region arguments for loop-carried values
2278    unsigned getNumRegionIterArgs() {
2279      return getBody()->getNumArguments() - 1;
2280    }
2281    /// Number of operands controlling the loop
2282    unsigned getNumControlOperands() { return 3; }
2283    /// Does the operation hold operands for loop-carried values
2284    bool hasIterOperands() {
2285      return (*this)->getNumOperands() > getNumControlOperands();
2286    }
2287    /// Get Number of loop-carried values
2288    unsigned getNumIterOperands() {
2289      return (*this)->getNumOperands() - getNumControlOperands();
2290    }
2291
2292    mlir::BlockArgument iterArgToBlockArg(mlir::Value iterArg);
2293    void resultToSourceOps(llvm::SmallVectorImpl<mlir::Value> &results,
2294                           unsigned resultNum);
2295    mlir::Value blockArgToSourceOp(unsigned blockArgNum);
2296  }];
2297}
2298
2299//===----------------------------------------------------------------------===//
2300// Procedure call operations
2301//===----------------------------------------------------------------------===//
2302
2303def fir_CallOp : fir_Op<"call", [CallOpInterface]> {
2304  let summary = "call a procedure";
2305
2306  let description = [{
2307    Call the specified function or function reference.
2308
2309    Provides a custom parser and pretty printer to allow a more readable syntax
2310    in the FIR dialect, e.g. `fir.call @sub(%12)` or `fir.call %20(%22,%23)`.
2311
2312    ```mlir
2313      %a = fir.call %funcref(%arg0) : (!fir.ref<f32>) -> f32
2314      %b = fir.call @function(%arg1, %arg2) : (!fir.ref<f32>, !fir.ref<f32>) -> f32
2315    ```
2316  }];
2317
2318  let arguments = (ins
2319    OptionalAttr<SymbolRefAttr>:$callee,
2320    Variadic<AnyType>:$args
2321  );
2322  let results = (outs Variadic<AnyType>);
2323
2324  let parser = "return parseCallOp(parser, result);";
2325  let printer = "printCallOp(p, *this);";
2326
2327  let builders = [
2328    OpBuilder<(ins "mlir::FuncOp":$callee,
2329        CArg<"mlir::ValueRange", "{}">:$operands)>,
2330    OpBuilder<(ins "mlir::SymbolRefAttr":$callee,
2331        "llvm::ArrayRef<mlir::Type>":$results,
2332        CArg<"mlir::ValueRange", "{}">:$operands)>,
2333    OpBuilder<(ins "llvm::StringRef":$callee,
2334        "llvm::ArrayRef<mlir::Type>":$results,
2335        CArg<"mlir::ValueRange", "{}">:$operands),
2336    [{
2337      build($_builder, $_state,
2338          SymbolRefAttr::get($_builder.getContext(), callee), results,
2339          operands);
2340    }]>];
2341
2342  let extraClassDeclaration = [{
2343    static constexpr StringRef getCalleeAttrName() { return "callee"; }
2344
2345    mlir::FunctionType getFunctionType();
2346
2347    /// Get the argument operands to the called function.
2348    operand_range getArgOperands() {
2349      if ((*this)->getAttrOfType<SymbolRefAttr>(getCalleeAttrName()))
2350        return {arg_operand_begin(), arg_operand_end()};
2351      return {arg_operand_begin() + 1, arg_operand_end()};
2352    }
2353
2354    operand_iterator arg_operand_begin() { return operand_begin(); }
2355    operand_iterator arg_operand_end() { return operand_end(); }
2356
2357    /// Return the callee of this operation.
2358    CallInterfaceCallable getCallableForCallee() {
2359      if (auto calling =
2360          (*this)->getAttrOfType<SymbolRefAttr>(getCalleeAttrName()))
2361        return calling;
2362      return getOperand(0);
2363    }
2364  }];
2365}
2366
2367def fir_DispatchOp : fir_Op<"dispatch", []> {
2368  let summary = "call a type-bound procedure";
2369
2370  let description = [{
2371    Perform a dynamic dispatch on the method name via the dispatch table
2372    associated with the first argument.  The attribute 'pass_arg_pos' can be
2373    used to select a dispatch argument other than the first one.
2374
2375    ```mlir
2376      %r = fir.dispatch methodA(%o) : (!fir.box<none>) -> i32
2377    ```
2378  }];
2379
2380  let arguments = (ins
2381    StrAttr:$method,
2382    fir_BoxType:$object,
2383    Variadic<AnyType>:$args
2384  );
2385
2386  let results = (outs Variadic<AnyType>);
2387
2388  let parser = "return parseDispatchOp(parser, result);";
2389
2390  let printer = "::print(p, *this);";
2391
2392  let extraClassDeclaration = [{
2393    mlir::FunctionType getFunctionType();
2394    operand_range getArgOperands() {
2395      return {arg_operand_begin(), arg_operand_end()};
2396    }
2397    // operand[0] is the object (of box type)
2398    operand_iterator arg_operand_begin() { return operand_begin() + 1; }
2399    operand_iterator arg_operand_end() { return operand_end(); }
2400    static constexpr llvm::StringRef passArgAttrName() {
2401      return "pass_arg_pos";
2402    }
2403    static constexpr llvm::StringRef getMethodAttrName() { return "method"; }
2404    unsigned passArgPos();
2405  }];
2406}
2407
2408// Constant operations that support Fortran
2409
2410def fir_StringLitOp : fir_Op<"string_lit", [NoSideEffect]> {
2411  let summary = "create a string literal constant";
2412
2413  let description = [{
2414    An FIR constant that represents a sequence of characters that correspond
2415    to Fortran's CHARACTER type, including a LEN.  We support CHARACTER values
2416    of different KINDs (different constant sizes).
2417
2418    ```mlir
2419      %1 = fir.string_lit "Hello, World!"(13) : !fir.char<1> // ASCII
2420      %2 = fir.string_lit [158, 2345](2) : !fir.char<2>      // Wide chars
2421    ```
2422  }];
2423
2424  let results = (outs fir_CharacterType);
2425
2426  let parser = "return parseStringLitOp(parser, result);";
2427
2428  let printer = "::print(p, *this);";
2429
2430  let builders = [
2431    OpBuilder<(ins "fir::CharacterType":$inType,
2432      "llvm::StringRef":$value,
2433      CArg<"llvm::Optional<int64_t>", "{}">:$len)>,
2434    OpBuilder<(ins "fir::CharacterType":$inType,
2435      "llvm::ArrayRef<char>":$xlist,
2436      CArg<"llvm::Optional<int64_t>", "{}">:$len)>,
2437    OpBuilder<(ins "fir::CharacterType":$inType,
2438      "llvm::ArrayRef<char16_t>":$xlist,
2439      CArg<"llvm::Optional<int64_t>", "{}">:$len)>,
2440    OpBuilder<(ins "fir::CharacterType":$inType,
2441      "llvm::ArrayRef<char32_t>":$xlist,
2442      CArg<"llvm::Optional<int64_t>", "{}">:$len)>];
2443
2444  let verifier = "return ::verify(*this);";
2445
2446  let extraClassDeclaration = [{
2447    static constexpr const char *size() { return "size"; }
2448    static constexpr const char *value() { return "value"; }
2449    static constexpr const char *xlist() { return "xlist"; }
2450
2451    // Get the LEN attribute of this character constant
2452    mlir::Attribute getSize() { return (*this)->getAttr(size()); }
2453    // Get the string value of this character constant
2454    mlir::Attribute getValue() {
2455      if (auto attr = (*this)->getAttr(value()))
2456        return attr;
2457      return (*this)->getAttr(xlist());
2458    }
2459
2460    /// Is this a wide character literal (1 character > 8 bits)
2461    bool isWideValue();
2462  }];
2463}
2464
2465// Complex operations
2466
2467class fir_ArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2468    fir_Op<mnemonic,
2469           !listconcat(traits, [NoSideEffect, SameOperandsAndResultType])>,
2470    Results<(outs AnyType)> {
2471  let parser = [{
2472    return impl::parseOneResultSameOperandTypeOp(parser, result);
2473  }];
2474
2475  let printer = [{ return printBinaryOp(this->getOperation(), p); }];
2476}
2477
2478class fir_UnaryArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2479      fir_Op<mnemonic,
2480             !listconcat(traits, [NoSideEffect, SameOperandsAndResultType])>,
2481      Results<(outs AnyType)> {
2482  let parser = [{
2483    return impl::parseOneResultSameOperandTypeOp(parser, result);
2484  }];
2485
2486  let printer = [{ return printUnaryOp(this->getOperation(), p); }];
2487}
2488
2489def fir_ConstcOp : fir_Op<"constc", [NoSideEffect]> {
2490  let summary = "create a complex constant";
2491
2492  let description = [{
2493    A complex constant. Similar to the standard dialect complex type, but this
2494    extension allows constants with APFloat values that are not supported in
2495    the standard dialect.
2496  }];
2497
2498  let results = (outs fir_ComplexType);
2499
2500  let parser = "return parseConstcOp(parser, result);";
2501
2502  let printer = "::print(p, *this);";
2503
2504  let verifier = "return ::verify(*this);";
2505
2506  let extraClassDeclaration = [{
2507    static constexpr llvm::StringRef realAttrName() { return "real"; }
2508    static constexpr llvm::StringRef imagAttrName() { return "imaginary"; }
2509
2510    mlir::Attribute getReal() { return (*this)->getAttr(realAttrName()); }
2511    mlir::Attribute getImaginary() { return (*this)->getAttr(imagAttrName()); }
2512  }];
2513}
2514
2515class ComplexUnaryArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2516      fir_UnaryArithmeticOp<mnemonic, traits>,
2517      Arguments<(ins fir_ComplexType:$operand)>;
2518
2519def fir_NegcOp : ComplexUnaryArithmeticOp<"negc">;
2520
2521class ComplexArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2522      fir_ArithmeticOp<mnemonic, traits>,
2523      Arguments<(ins fir_ComplexType:$lhs, fir_ComplexType:$rhs)>;
2524
2525def fir_AddcOp : ComplexArithmeticOp<"addc", [Commutative]>;
2526def fir_SubcOp : ComplexArithmeticOp<"subc">;
2527def fir_MulcOp : ComplexArithmeticOp<"mulc", [Commutative]>;
2528def fir_DivcOp : ComplexArithmeticOp<"divc">;
2529// Pow is a builtin call and not a primitive
2530
2531def fir_CmpcOp : fir_Op<"cmpc",
2532    [NoSideEffect, SameTypeOperands, SameOperandsAndResultShape]> {
2533  let summary = "complex floating-point comparison operator";
2534
2535  let description = [{
2536    A complex comparison to handle complex types found in FIR.
2537  }];
2538
2539  let arguments = (ins fir_ComplexType:$lhs, fir_ComplexType:$rhs);
2540
2541  let results = (outs AnyLogicalLike);
2542
2543  let parser = "return parseCmpcOp(parser, result);";
2544
2545  let printer = "printCmpcOp(p, *this);";
2546
2547  let builders = [OpBuilder<(ins "mlir::CmpFPredicate":$predicate,
2548    "mlir::Value":$lhs, "mlir::Value":$rhs), [{
2549      buildCmpCOp($_builder, $_state, predicate, lhs, rhs);
2550  }]>];
2551
2552  let extraClassDeclaration = [{
2553    static constexpr llvm::StringRef getPredicateAttrName() {
2554      return "predicate";
2555    }
2556
2557    CmpFPredicate getPredicate() {
2558      return (CmpFPredicate)(*this)->getAttrOfType<mlir::IntegerAttr>(
2559          getPredicateAttrName()).getInt();
2560    }
2561
2562    static CmpFPredicate getPredicateByName(llvm::StringRef name);
2563  }];
2564}
2565
2566// Other misc. operations
2567
2568def fir_AddrOfOp : fir_OneResultOp<"address_of", [NoSideEffect]> {
2569  let summary = "convert a symbol to an SSA value";
2570
2571  let description = [{
2572    Convert a symbol (a function or global reference) to an SSA-value to be
2573    used in other Operations. References to Fortran symbols are distinguished
2574    via this operation from other arbitrary constant values.
2575
2576    ```mlir
2577      %p = fir.address_of(@symbol) : !fir.ref<f64>
2578    ```
2579  }];
2580
2581  let arguments = (ins SymbolRefAttr:$symbol);
2582
2583  let results = (outs AnyAddressableLike:$resTy);
2584
2585  let assemblyFormat = "`(` $symbol `)` attr-dict `:` type($resTy)";
2586}
2587
2588def fir_ConvertOp : fir_OneResultOp<"convert", [NoSideEffect]> {
2589  let summary = "encapsulates all Fortran scalar type conversions";
2590
2591  let description = [{
2592    Generalized type conversion. Convert the ssa value from type T to type U.
2593    Not all pairs of types have conversions. When types T and U are the same
2594    type, this instruction is a NOP and may be folded away.
2595
2596    ```mlir
2597      %v = ... : i64
2598      %w = fir.convert %v : (i64) -> i32
2599    ```
2600
2601    The example truncates the value `%v` from an i64 to an i32.
2602  }];
2603
2604  let arguments = (ins AnyType:$value);
2605
2606  let assemblyFormat = [{
2607    $value attr-dict `:` functional-type($value, results)
2608  }];
2609
2610  let hasFolder = 1;
2611
2612  let verifier = "return ::verify(*this);";
2613
2614  let extraClassDeclaration = [{
2615    static bool isIntegerCompatible(mlir::Type ty);
2616    static bool isFloatCompatible(mlir::Type ty);
2617    static bool isPointerCompatible(mlir::Type ty);
2618  }];
2619  let hasCanonicalizer = 1;
2620}
2621
2622def FortranTypeAttr : Attr<And<[CPred<"$_self.isa<TypeAttr>()">,
2623    Or<[CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::CharacterType>()">,
2624        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::ComplexType>()">,
2625        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::IntegerType>()">,
2626        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::LogicalType>()">,
2627        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::RealType>()">,
2628        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::RecordType>()">]>]>,
2629    "Fortran surface type"> {
2630  let storageType = [{ TypeAttr }];
2631  let returnType = "Type";
2632  let convertFromStorage = "$_self.getValue().cast<Type>()";
2633}
2634
2635def fir_GenTypeDescOp : fir_OneResultOp<"gentypedesc", [NoSideEffect]> {
2636  let summary = "generate a type descriptor for a given type";
2637  let description = [{
2638    Generates a constant object that is an abstract type descriptor of the
2639    specified type.  The meta-type of a type descriptor for the type `T`
2640    is `!fir.tdesc<T>`.
2641
2642    ```mlir
2643      !T = type !fir.type<T{...}>
2644      %t = fir.gentypedesc !T  // returns value of !fir.tdesc<!T>
2645    ```
2646  }];
2647
2648  let arguments = (ins FortranTypeAttr:$in_type);
2649
2650  let parser = "return parseGenTypeDescOp(parser, result);";
2651
2652  let printer = "::print(p, *this);";
2653
2654  let builders = [OpBuilder<(ins "mlir::TypeAttr":$inty)>];
2655
2656  let verifier = "return ::verify(*this);";
2657
2658  let extraClassDeclaration = [{
2659    mlir::Type getInType() {
2660      // get the type that the type descriptor describes
2661      return (*this)->getAttrOfType<mlir::TypeAttr>("in_type").getValue();
2662    }
2663  }];
2664}
2665
2666def fir_NoReassocOp : fir_OneResultOp<"no_reassoc",
2667    [NoSideEffect, SameOperandsAndResultType]> {
2668  let summary = "synthetic op to prevent reassociation";
2669  let description = [{
2670    Primitive operation meant to intrusively prevent operator reassociation.
2671    The operation is otherwise a nop and the value returned is the same as the
2672    argument.
2673
2674    The presence of this operation prevents any local optimizations. In the
2675    example below, this would prevent possibly replacing the multiply and add
2676    operations with a single FMA operation.
2677
2678    ```mlir
2679      %98 = mulf %96, %97 : f32
2680      %99 = fir.no_reassoc %98 : f32
2681      %a0 = addf %99, %95 : f32
2682    ```
2683  }];
2684
2685  let arguments = (ins AnyType:$val);
2686
2687  let assemblyFormat = "$val attr-dict `:` type($val)";
2688}
2689
2690class AtMostRegion<int numBlocks> : Region<
2691  CPred<"$_self.getBlocks().size() <= " # numBlocks>,
2692  "region with " # numBlocks # " blocks">;
2693
2694def fir_GlobalOp : fir_Op<"global", [IsolatedFromAbove, Symbol]> {
2695  let summary = "Global data";
2696  let description = [{
2697    A global variable or constant with initial values.
2698
2699    The example creates a global variable (writable) named
2700    `@_QV_Mquark_Vvarble` with some initial values. The initializer should
2701    conform to the variable's type.
2702
2703    ```mlir
2704      fir.global @_QV_Mquark_Vvarble : tuple<i32, f32> {
2705        %1 = constant 1 : i32
2706        %2 = constant 2.0 : f32
2707        %3 = fir.undefined tuple<i32, f32>
2708        %z = constant 0 : index
2709        %o = constant 1 : index
2710        %4 = fir.insert_value %3, %1, %z : (tuple<i32, f32>, i32, index) -> tuple<i32, f32>
2711        %5 = fir.insert_value %4, %2, %o : (tuple<i32, f32>, f32, index) -> tuple<i32, f32>
2712        fir.has_value %5 : tuple<i32, f32>
2713      }
2714    ```
2715  }];
2716
2717  let arguments = (ins
2718    StrAttr:$sym_name,
2719    SymbolRefAttr:$symref,
2720    TypeAttr:$type,
2721    OptionalAttr<AnyAttr>:$initVal,
2722    OptionalAttr<UnitAttr>:$constant,
2723    OptionalAttr<StrAttr>:$linkName
2724  );
2725
2726  let regions = (region AtMostRegion<1>:$region);
2727
2728  let parser = "return parseGlobalOp(parser, result);";
2729
2730  let printer = "::print(p, *this);";
2731
2732  let skipDefaultBuilders = 1;
2733  let builders = [
2734    OpBuilder<(ins "llvm::StringRef":$name, "mlir::Type":$type,
2735      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
2736    OpBuilder<(ins "llvm::StringRef":$name, "bool":$isConstant,
2737      "mlir::Type":$type,
2738      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
2739    OpBuilder<(ins "llvm::StringRef":$name, "mlir::Type":$type,
2740      CArg<"mlir::StringAttr", "{}">:$linkage,
2741      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
2742    OpBuilder<(ins "llvm::StringRef":$name, "bool":$isConstant,
2743      "mlir::Type":$type, CArg<"mlir::StringAttr", "{}">:$linkage,
2744      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
2745    OpBuilder<(ins "llvm::StringRef":$name, "mlir::Type":$type,
2746      "mlir::Attribute":$initVal, CArg<"mlir::StringAttr", "{}">:$linkage,
2747      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
2748    OpBuilder<(ins "llvm::StringRef":$name, "bool":$isConstant,
2749      "mlir::Type":$type, "mlir::Attribute":$initVal,
2750      CArg<"mlir::StringAttr", "{}">:$linkage,
2751      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs)>,
2752  ];
2753
2754  let extraClassDeclaration = [{
2755    static constexpr llvm::StringRef symbolAttrName() { return "symref"; }
2756    static constexpr llvm::StringRef getConstantAttrName() {
2757      return "constant";
2758    }
2759    static constexpr llvm::StringRef linkageAttrName() { return "linkName"; }
2760
2761    /// The printable type of the global
2762    mlir::Type getType() {
2763      return typeAttr().getValue();
2764    }
2765
2766    /// The semantic type of the global
2767    mlir::Type resultType();
2768
2769    /// Return the initializer attribute if it exists, or a null attribute.
2770    Attribute getValueOrNull() { return initVal().getValueOr(Attribute()); }
2771
2772    /// Append the next initializer value to the `GlobalOp` to construct
2773    /// the variable's initial value.
2774    void appendInitialValue(mlir::Operation *op);
2775
2776    /// A GlobalOp has one region.
2777    mlir::Region &getRegion() { return (*this)->getRegion(0); }
2778
2779    /// A GlobalOp has one block.
2780    mlir::Block &getBlock() { return getRegion().front(); }
2781
2782    /// Determine if `linkage` is a supported keyword
2783    static mlir::ParseResult verifyValidLinkage(StringRef linkage);
2784
2785    bool hasInitializationBody() {
2786      return ((*this)->getNumRegions() == 1) && !getRegion().empty() &&
2787        !isa<fir::FirEndOp>(getBlock().front());
2788    }
2789
2790    mlir::FlatSymbolRefAttr getSymbol() {
2791      return mlir::FlatSymbolRefAttr::get(getContext(),
2792          (*this)->getAttrOfType<mlir::StringAttr>(
2793              mlir::SymbolTable::getSymbolAttrName()).getValue());
2794    }
2795  }];
2796}
2797
2798def fir_GlobalLenOp : fir_Op<"global_len", []> {
2799  let summary = "map a LEN parameter to a global";
2800  let description = [{
2801    A global entity (that is not an automatic data object) can have extra LEN
2802    parameter (compile-time) constants associated with the instance's type.
2803    These values can be bound to the global instance used `fir.global_len`.
2804
2805    ```mlir
2806      global @g : !fir.type<t(len1:i32)> {
2807        fir.global_len len1, 10 : i32
2808        %1 = fir.undefined : !fir.type<t(len1:i32)>
2809        return %1 : !fir.type<t(len1:i32)>
2810      }
2811    ```
2812  }];
2813
2814  let arguments = (ins StrAttr:$lenparam, APIntAttr:$intval);
2815
2816  let parser = "return parseGlobalLenOp(parser, result);";
2817
2818  let printer = "::print(p, *this);";
2819
2820  let extraClassDeclaration = [{
2821    static constexpr llvm::StringRef lenParamAttrName() { return "lenparam"; }
2822    static constexpr llvm::StringRef intAttrName() { return "intval"; }
2823  }];
2824}
2825
2826def ImplicitFirTerminator : SingleBlockImplicitTerminator<"FirEndOp">;
2827
2828def fir_DispatchTableOp : fir_Op<"dispatch_table",
2829    [IsolatedFromAbove, Symbol, ImplicitFirTerminator]> {
2830  let summary = "Dispatch table definition";
2831
2832  let description = [{
2833    Define a dispatch table for a derived type with type-bound procedures.
2834
2835    A dispatch table is an untyped symbol that contains a list of associations
2836    between method identifiers and corresponding `FuncOp` symbols.
2837
2838    The ordering of associations in the map is determined by the front-end.
2839
2840    ```mlir
2841      fir.dispatch_table @_QDTMquuzTfoo {
2842        fir.dt_entry method1, @_QFNMquuzTfooPmethod1AfooR
2843        fir.dt_entry method2, @_QFNMquuzTfooPmethod2AfooII
2844      }
2845    ```
2846  }];
2847
2848  let parser = "return parseDispatchTableOp(parser, result);";
2849
2850  let printer = "::print(p, *this);";
2851
2852  let verifier = "return ::verify(*this);";
2853
2854  let regions = (region SizedRegion<1>:$region);
2855
2856  let skipDefaultBuilders = 1;
2857  let builders = [
2858    OpBuilder<(ins "llvm::StringRef":$name, "mlir::Type":$type,
2859      CArg<"llvm::ArrayRef<mlir::NamedAttribute>", "{}">:$attrs),
2860    [{
2861      $_state.addAttribute(mlir::SymbolTable::getSymbolAttrName(),
2862                           $_builder.getStringAttr(name));
2863      $_state.addAttributes(attrs);
2864    }]>
2865  ];
2866
2867  let extraClassDeclaration = [{
2868    /// Append a dispatch table entry to the table.
2869    void appendTableEntry(mlir::Operation *op);
2870
2871    mlir::Region &getRegion() {
2872      return (*this)->getRegion(0);
2873    }
2874
2875    mlir::Block &getBlock() {
2876      return getRegion().front();
2877    }
2878  }];
2879}
2880
2881def fir_DTEntryOp : fir_Op<"dt_entry", []> {
2882  let summary = "map entry in a dispatch table";
2883
2884  let description = [{
2885    An entry in a dispatch table.  Allows a function symbol to be bound
2886    to a specifier method identifier.  A dispatch operation uses the dynamic
2887    type of a distinguished argument to determine an exact dispatch table
2888    and uses the method identifier to select the type-bound procedure to
2889    be called.
2890
2891    ```mlir
2892      fir.dt_entry method_name, @uniquedProcedure
2893    ```
2894  }];
2895
2896  let arguments = (ins StrAttr:$method, SymbolRefAttr:$proc);
2897
2898  let parser = "return parseDTEntryOp(parser, result);";
2899
2900  let printer = "::print(p, *this);";
2901
2902  let extraClassDeclaration = [{
2903    static constexpr llvm::StringRef getMethodAttrName() { return "method"; }
2904    static constexpr llvm::StringRef getProcAttrName() { return "proc"; }
2905  }];
2906}
2907
2908def fir_AbsentOp : fir_OneResultOp<"absent", [NoSideEffect]> {
2909  let summary = "create value to be passed for absent optional function argument";
2910  let description = [{
2911    Given the type of a function argument, create a value that will signal that
2912    an optional argument is absent in the call. On the caller side, fir.is_present
2913    can be used to query if the value of an optional argument was created with
2914    a fir.absent operation.
2915    It is undefined to use a value that was created by a fir.absent op in any other
2916    operation than fir.call and fir.is_present.
2917    ```mlir
2918      %1 = fir.absent fir.box<fir.array<?xf32>>
2919      fir.call @_QPfoo(%1) : (fir.box<fir.array<?xf32>>) -> ()
2920    ```
2921  }];
2922
2923  let results = (outs AnyRefOrBoxLike:$intype);
2924
2925  let assemblyFormat = "type($intype) attr-dict";
2926}
2927
2928def fir_IsPresentOp : fir_SimpleOp<"is_present", [NoSideEffect]> {
2929  let summary = "is this optional function argument present?";
2930
2931  let description = [{
2932    Determine if an optional function argument is PRESENT (i.e. that it was not
2933    created by a fir.absent op on the caller side).
2934    ```mlir
2935      func @_QPfoo(%arg0: !fir.box<!fir.array<?xf32>>) {
2936        %0 = fir.is_present %arg0 : (!fir.box<!fir.array<?xf32>>) -> i1
2937        ...
2938    ```
2939  }];
2940
2941  let arguments = (ins AnyRefOrBoxLike:$val);
2942
2943  let results = (outs BoolLike);
2944}
2945
2946#endif
2947