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