xref: /llvm-project/flang/lib/Common/Fortran.cpp (revision 3874c64418d2a7e36eab9af9253d905b48b36078)
1 //===-- lib/Common/Fortran.cpp --------------------------------------------===//
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/Common/Fortran.h"
10 #include "flang/Common/Fortran-features.h"
11 
12 namespace Fortran::common {
13 
14 const 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 
30 const 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 
46 const 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 
64 const 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 
78 std::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.
104 bool AreCompatibleCUDADataAttrs(std::optional<CUDADataAttr> x,
105     std::optional<CUDADataAttr> y, IgnoreTKRSet ignoreTKR,
106     std::optional<std::string> *warning, bool allowUnifiedMatchingRule,
107     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 (!x && !y) {
115     return true;
116   } else if (x && y && *x == *y) {
117     return true;
118   } else if ((!x && y && *y == CUDADataAttr::Pinned) ||
119       (x && *x == CUDADataAttr::Pinned && !y)) {
120     return true;
121   } else if (ignoreTKR.test(IgnoreTKR::Device) &&
122       x.value_or(CUDADataAttr::Device) == CUDADataAttr::Device &&
123       y.value_or(CUDADataAttr::Device) == CUDADataAttr::Device) {
124     return true;
125   } else if (ignoreTKR.test(IgnoreTKR::Managed) &&
126       x.value_or(CUDADataAttr::Managed) == CUDADataAttr::Managed &&
127       y.value_or(CUDADataAttr::Managed) == CUDADataAttr::Managed) {
128     return true;
129   } else if (allowUnifiedMatchingRule) {
130     if (!x) { // Dummy argument has no attribute -> host
131       if ((y && (*y == CUDADataAttr::Managed || *y == CUDADataAttr::Unified)) ||
132           (!y && (isCudaUnified || isCudaManaged))) {
133         return true;
134       }
135     } else {
136       if (*x == CUDADataAttr::Device) {
137         if ((y &&
138                 (*y == CUDADataAttr::Managed || *y == CUDADataAttr::Unified ||
139                     *y == CUDADataAttr::Shared ||
140                     *y == CUDADataAttr::Constant)) ||
141             (!y && (isCudaUnified || isCudaManaged))) {
142           if (y && *y == CUDADataAttr::Shared && warning) {
143             *warning = "SHARED attribute ignored"s;
144           }
145           return true;
146         }
147       } else if (*x == CUDADataAttr::Managed) {
148         if ((y && *y == CUDADataAttr::Unified) ||
149             (!y && (isCudaUnified || isCudaManaged))) {
150           return true;
151         }
152       } else if (*x == CUDADataAttr::Unified) {
153         if ((y && *y == CUDADataAttr::Managed) ||
154             (!y && (isCudaUnified || isCudaManaged))) {
155           return true;
156         }
157       }
158     }
159     return false;
160   } else {
161     return false;
162   }
163 }
164 
165 } // namespace Fortran::common
166