1//===-- lib/Support/Fortran.cpp ---------------------------------*- C++ -*-===//
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#include "flang/Support/Fortran.h"
10#include "flang/Support/Fortran-features.h"
11
12namespace Fortran::common {
13
14const char *AsFortran(NumericOperator opr) {
15 switch (opr) {
16 SWITCH_COVERS_ALL_CASES
17 case NumericOperator::Power:
18 return "**";
19 case NumericOperator::Multiply:
20 return "*";
21 case NumericOperator::Divide:
22 return "/";
23 case NumericOperator::Add:
24 return "+";
25 case NumericOperator::Subtract:
26 return "-";
27 }
28}
29
30const char *AsFortran(LogicalOperator opr) {
31 switch (opr) {
32 SWITCH_COVERS_ALL_CASES
33 case LogicalOperator::And:
34 return ".and.";
35 case LogicalOperator::Or:
36 return ".or.";
37 case LogicalOperator::Eqv:
38 return ".eqv.";
39 case LogicalOperator::Neqv:
40 return ".neqv.";
41 case LogicalOperator::Not:
42 return ".not.";
43 }
44}
45
46const char *AsFortran(RelationalOperator opr) {
47 switch (opr) {
48 SWITCH_COVERS_ALL_CASES
49 case RelationalOperator::LT:
50 return "<";
51 case RelationalOperator::LE:
52 return "<=";
53 case RelationalOperator::EQ:
54 return "==";
55 case RelationalOperator::NE:
56 return "/=";
57 case RelationalOperator::GE:
58 return ">=";
59 case RelationalOperator::GT:
60 return ">";
61 }
62}
63
64const char *AsFortran(DefinedIo x) {
65 switch (x) {
66 SWITCH_COVERS_ALL_CASES
67 case DefinedIo::ReadFormatted:
68 return "read(formatted)";
69 case DefinedIo::ReadUnformatted:
70 return "read(unformatted)";
71 case DefinedIo::WriteFormatted:
72 return "write(formatted)";
73 case DefinedIo::WriteUnformatted:
74 return "write(unformatted)";
75 }
76}
77
78std::string AsFortran(IgnoreTKRSet tkr) {
79 std::string result;
80 if (tkr.test(IgnoreTKR::Type)) {
81 result += 'T';
82 }
83 if (tkr.test(IgnoreTKR::Kind)) {
84 result += 'K';
85 }
86 if (tkr.test(IgnoreTKR::Rank)) {
87 result += 'R';
88 }
89 if (tkr.test(IgnoreTKR::Device)) {
90 result += 'D';
91 }
92 if (tkr.test(IgnoreTKR::Managed)) {
93 result += 'M';
94 }
95 if (tkr.test(IgnoreTKR::Contiguous)) {
96 result += 'C';
97 }
98 return result;
99}
100
101/// Check compatibilty of CUDA attribute.
102/// When `allowUnifiedMatchingRule` is enabled, argument `x` represents the
103/// dummy argument attribute while `y` represents the actual argument attribute.
104bool AreCompatibleCUDADataAttrs(std::optional<CUDADataAttr> x,
105 std::optional<CUDADataAttr> y, IgnoreTKRSet ignoreTKR,
106 std::optional<std::string> *warning, bool allowUnifiedMatchingRule,
107 bool isHostDeviceProcedure, const LanguageFeatureControl *features) {
108 bool isCudaManaged{features
109 ? features->IsEnabled(common::LanguageFeature::CudaManaged)
110 : false};
111 bool isCudaUnified{features
112 ? features->IsEnabled(common::LanguageFeature::CudaUnified)
113 : false};
114 if (ignoreTKR.test(common::IgnoreTKR::Device)) {
115 return true;
116 }
117 if (!y && isHostDeviceProcedure) {
118 return true;
119 }
120 if (!x && !y) {
121 return true;
122 } else if (x && y && *x == *y) {
123 return true;
124 } else if ((!x && y && *y == CUDADataAttr::Pinned) ||
125 (x && *x == CUDADataAttr::Pinned && !y)) {
126 return true;
127 } else if (ignoreTKR.test(IgnoreTKR::Device) &&
128 x.value_or(CUDADataAttr::Device) == CUDADataAttr::Device &&
129 y.value_or(CUDADataAttr::Device) == CUDADataAttr::Device) {
130 return true;
131 } else if (ignoreTKR.test(IgnoreTKR::Managed) &&
132 x.value_or(CUDADataAttr::Managed) == CUDADataAttr::Managed &&
133 y.value_or(CUDADataAttr::Managed) == CUDADataAttr::Managed) {
134 return true;
135 } else if (allowUnifiedMatchingRule) {
136 if (!x) { // Dummy argument has no attribute -> host
137 if ((y && (*y == CUDADataAttr::Managed || *y == CUDADataAttr::Unified)) ||
138 (!y && (isCudaUnified || isCudaManaged))) {
139 return true;
140 }
141 } else {
142 if (*x == CUDADataAttr::Device) {
143 if ((y &&
144 (*y == CUDADataAttr::Managed || *y == CUDADataAttr::Unified ||
145 *y == CUDADataAttr::Shared ||
146 *y == CUDADataAttr::Constant)) ||
147 (!y && (isCudaUnified || isCudaManaged))) {
148 if (y && *y == CUDADataAttr::Shared && warning) {
149 *warning = "SHARED attribute ignored"s;
150 }
151 return true;
152 }
153 } else if (*x == CUDADataAttr::Managed) {
154 if ((y && *y == CUDADataAttr::Unified) ||
155 (!y && (isCudaUnified || isCudaManaged))) {
156 return true;
157 }
158 } else if (*x == CUDADataAttr::Unified) {
159 if ((y && *y == CUDADataAttr::Managed) ||
160 (!y && (isCudaUnified || isCudaManaged))) {
161 return true;
162 }
163 }
164 }
165 return false;
166 } else {
167 return false;
168 }
169}
170
171} // namespace Fortran::common
172

source code of flang/lib/Support/Fortran.cpp