--- /dev/null
+// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_INTERMEDIATEREPRESENTATION_COMMON_H_
+#define FORTRAN_INTERMEDIATEREPRESENTATION_COMMON_H_
+
+#include "../common/idioms.h"
+#include "../common/indirection.h"
+#include "../evaluate/expression.h"
+#include "../evaluate/type.h"
+#include "../evaluate/variable.h"
+#include "../parser/parse-tree.h"
+#include "../semantics/symbol.h"
+
+// Some useful, self-documenting macros for failure modes
+#define STRINGIFY(X) #X
+#define LINE2STRING(X) STRINGIFY(X)
+#define AT_HERE " at " __FILE__ "(" LINE2STRING(__LINE__) ")"
+#define DIE Fortran::common::die
+#define SEMANTICS_FAILED(STRING) DIE("semantics bug: " STRING AT_HERE)
+#define SEMANTICS_CHECK(CONDITION, STRING) \
+ if (CONDITION) { \
+ } else { \
+ DIE("semantics bug: " STRING AT_HERE); \
+ }
+#define WRONG_PATH() DIE("control should not reach here" AT_HERE)
+
+namespace Fortran::IntermediateRepresentation {
+class Statement;
+class BasicBlock;
+struct Program;
+struct GraphWriter;
+
+struct Attribute {
+ enum { IntentIn, IntentOut, IntentInOut } attribute;
+ unsigned short position;
+};
+using FunctionType = evaluate::SomeType; // TODO: what should this be?
+using AttributeList = std::vector<Attribute>;
+enum struct LinkageTypes { Public, Hidden, External };
+using Expression = evaluate::GenericExprWrapper;
+#if 0
+struct Variable {
+ // TODO: should semantics::Symbol be removed?
+ template<typename... Ts> struct GVT {
+ using type =
+ std::variant<const semantics::Symbol *, evaluate::Variable<Ts>...>;
+ };
+ Variable(const semantics::Symbol *symbol) : u{symbol} {}
+ common::OverMembers<GVT, evaluate::AllIntrinsicTypes>::type u;
+};
+#endif
+using Variable = const semantics::Symbol *;
+using PathVariable = const parser::Variable;
+using Scope = const semantics::Scope;
+using Value = Expression;
+using PHIPair = std::pair<Value *, BasicBlock *>;
+using CallArguments = std::vector<const Expression *>;
+
+enum InputOutputCallType {
+ InputOutputCallBackspace = 11,
+ InputOutputCallClose,
+ InputOutputCallEndfile,
+ InputOutputCallFlush,
+ InputOutputCallInquire,
+ InputOutputCallOpen,
+ InputOutputCallPrint,
+ InputOutputCallRead,
+ InputOutputCallRewind,
+ InputOutputCallWait,
+ InputOutputCallWrite,
+ InputOutputCallSIZE = InputOutputCallWrite - InputOutputCallBackspace + 1
+};
+
+using IOCallArguments = CallArguments;
+
+enum RuntimeCallType {
+ RuntimeCallFailImage = 31,
+ RuntimeCallStop,
+ RuntimeCallPause,
+ RuntimeCallFormTeam,
+ RuntimeCallEventPost,
+ RuntimeCallEventWait,
+ RuntimeCallSyncAll,
+ RuntimeCallSyncImages,
+ RuntimeCallSyncMemory,
+ RuntimeCallSyncTeam,
+ RuntimeCallLock,
+ RuntimeCallUnlock,
+ RuntimeCallSIZE = RuntimeCallUnlock - RuntimeCallFailImage + 1
+};
+
+using RuntimeCallArguments = CallArguments;
+}
+
+#endif
--- /dev/null
+// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "graph-writer.h"
+
+namespace Fortran::IntermediateRepresentation {
+
+std::optional<llvm::raw_ostream *> GraphWriter::defaultOutput_{std::nullopt};
+
+void GraphWriter::dumpHeader() { output_ << "digraph G {\n"; }
+void GraphWriter::dumpFooter() { output_ << "}\n"; }
+
+void GraphWriter::dump(Program &program) {
+ dumpHeader();
+ for (auto iter{program.procedureMap_.begin()},
+ iend{program.procedureMap_.end()};
+ iter != iend; ++iter) {
+ dump(*iter->getValue(), true);
+ }
+ dumpFooter();
+}
+
+void GraphWriter::dump(Procedure &procedure, bool box) {
+ if (box) {
+ output_ << "subgraph cluster" << counter()
+ << " {\n node[style=filled];\n color=red;\n";
+ }
+ for (auto iter{procedure.regionList_.begin()},
+ iend{procedure.regionList_.end()};
+ iter != iend; ++iter) {
+ dump(*iter, true);
+ }
+ if (box) {
+ output_ << " label = \"procedure";
+ if (procedure.getName().empty()) {
+ output_ << '#' << counter();
+ } else {
+ output_ << ": " << procedure.getName().str();
+ }
+ output_ << "\"\n}\n";
+ }
+}
+
+void GraphWriter::dump(Region ®ion, bool box) {
+ if (box) {
+ output_ << " subgraph cluster" << counter()
+ << " {\n node[style=filled];\n";
+ }
+ for (auto iter{region.begin()}, iend{region.end()}; iter != iend; ++iter) {
+ dump(*iter, true);
+ }
+ std::set<BasicBlock *> myNodes;
+ auto blocks{region.getBlocks()};
+ auto iend{blocks.end()};
+ auto iexit{iend};
+ --iexit;
+ auto ientry{blocks.begin()};
+ for (auto iter{ientry}; iter != iend; ++iter) {
+ isEntry_ = iter == ientry && region.IsOutermost();
+ isExit_ = iter == iexit && region.IsOutermost();
+ dump(**iter);
+ myNodes.insert(*iter);
+ }
+ std::list<std::pair<BasicBlock *, BasicBlock *>> emitAfter;
+ for (auto iter{blocks.begin()}, iend{blocks.end()}; iter != iend; ++iter) {
+ dumpInternalEdges(**iter, myNodes, emitAfter);
+ }
+ if (box) {
+ output_ << " style=dashed;\n color=blue;\n label = \"region#"
+ << counter() << "\\nvariables: {...}\\n\"\n }\n";
+ }
+ for (auto pair : emitAfter) {
+ output_ << " " << block_id(*pair.first) << " -> " << block_id(*pair.second)
+ << ";\n";
+ }
+}
+
+void GraphWriter::dump(BasicBlock &block, std::optional<const char *> color) {
+ output_ << " " << block_id(block) << " [label = \"";
+ if (isEntry_) {
+ output_ << "<<ENTRY>>\\n";
+ }
+ output_ << block_id(block) << '(' << reinterpret_cast<std::intptr_t>(&block)
+ << ")\\n";
+ for (auto &action : block.getSublist(static_cast<Statement *>(nullptr))) {
+ output_ << action.dump() << "\\n";
+ }
+ if (isExit_) {
+ output_ << "<<EXIT>>";
+ }
+ output_ << "\",shape=rectangle";
+ if (color) {
+ output_ << ",color=" << *color;
+ }
+ output_ << "];\n";
+}
+
+void GraphWriter::dumpInternalEdges(BasicBlock &block,
+ std::set<BasicBlock *> &nodeSet,
+ std::list<std::pair<BasicBlock *, BasicBlock *>> &emitAfter) {
+ for (auto succ : succ_list(block)) {
+ if (nodeSet.count(succ)) {
+ output_ << " " << block_id(block) << " -> " << block_id(*succ)
+ << ";\n";
+ } else {
+ emitAfter.push_back({&block, succ});
+ }
+ }
+}
+
+}
--- /dev/null
+// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_INTERMEDIATEREPRESENTATION_GRAPH_WRITER_H_
+#define FORTRAN_INTERMEDIATEREPRESENTATION_GRAPH_WRITER_H_
+
+#include "program.h"
+#include "llvm/Support/FileSystem.h"
+#include "llvm/Support/raw_ostream.h"
+#include <list>
+#include <map>
+#include <set>
+#include <sstream>
+#include <string>
+
+namespace Fortran::IntermediateRepresentation {
+
+struct GraphWriter {
+ static void setOutput(llvm::raw_ostream *output) { defaultOutput_ = output; }
+ static void setOutput(const std::string &filename) {
+ std::error_code ec;
+ setOutput(new llvm::raw_fd_ostream(filename, ec, llvm::sys::fs::F_None));
+ CHECK(!ec);
+ }
+ static void print(Program &program) {
+ GraphWriter writer{getOutput()};
+ writer.dump(program);
+ }
+ static void print(Procedure &procedure) {
+ GraphWriter writer{getOutput()};
+ writer.dump(procedure);
+ }
+ static void print(Region ®ion) {
+ GraphWriter writer{getOutput()};
+ writer.dump(region);
+ }
+
+private:
+ GraphWriter(llvm::raw_ostream &output) : output_{output} {}
+ ~GraphWriter() {
+ if (defaultOutput_) {
+ delete *defaultOutput_;
+ defaultOutput_ = std::nullopt;
+ }
+ }
+ void dump(Program &program);
+ void dump(Procedure &procedure, bool box = false);
+ void dump(Region ®ion, bool box = false);
+ void dumpHeader();
+ void dumpFooter();
+ unsigned counter() { return count_++; }
+ void dump(
+ BasicBlock &block, std::optional<const char *> color = std::nullopt);
+ void dumpInternalEdges(BasicBlock &block, std::set<BasicBlock *> &nodeSet,
+ std::list<std::pair<BasicBlock *, BasicBlock *>> &emitAfter);
+ std::string block_id(BasicBlock &block) {
+ unsigned num;
+ if (blockIds_.count(&block)) {
+ num = blockIds_[&block];
+ } else {
+ blockIds_[&block] = num = blockNum_++;
+ }
+ std::ostringstream buffer;
+ buffer << "BB_" << num;
+ return buffer.str();
+ }
+ static llvm::raw_ostream &getOutput() {
+ return defaultOutput_ ? *defaultOutput_.value() : llvm::outs();
+ }
+
+ unsigned count_{0u};
+ llvm::raw_ostream &output_;
+ unsigned blockNum_{0u};
+ bool isEntry_{false};
+ bool isExit_{false};
+ std::map<BasicBlock *, unsigned> blockIds_;
+ static std::optional<llvm::raw_ostream *> defaultOutput_;
+};
+
+}
+
+#endif
--- /dev/null
+// Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_INTERMEDIATEREPRESENTATION_MIXIN_H_
+#define FORTRAN_INTERMEDIATEREPRESENTATION_MIXIN_H_
+
+#include "llvm/ADT/ilist.h"
+#include <optional>
+#include <tuple>
+#include <type_traits>
+#include <variant>
+
+namespace Fortran::IntermediateRepresentation {
+
+template<typename T, typename E = void> struct SumTypeMixin {};
+template<typename T> // T must be std::optional<...>
+struct SumTypeMixin<T, std::enable_if_t<std::variant_size_v<T>>> {
+ template<typename A> SumTypeMixin(A &&x) : u{std::move(x)} {}
+ using SumTypeTrait = std::true_type;
+ SumTypeMixin(SumTypeMixin &&) = default;
+ SumTypeMixin &operator=(SumTypeMixin &&) = default;
+ SumTypeMixin(const SumTypeMixin &) = delete;
+ SumTypeMixin &operator=(const SumTypeMixin &) = delete;
+ SumTypeMixin() = delete;
+ T u;
+};
+
+template<typename T, typename E = void> struct SumTypeCopyMixin {};
+template<typename T> // T must be std::optional<...>
+struct SumTypeCopyMixin<T, std::enable_if_t<std::variant_size_v<T>>> {
+ using CopyableSumTypeTrait = std::true_type;
+ SumTypeCopyMixin(SumTypeCopyMixin &&) = default;
+ SumTypeCopyMixin &operator=(SumTypeCopyMixin &&) = default;
+ SumTypeCopyMixin(const SumTypeCopyMixin &) = default;
+ SumTypeCopyMixin &operator=(const SumTypeCopyMixin &) = default;
+ SumTypeCopyMixin() = delete;
+ T u;
+};
+#define SUM_TYPE_COPY_MIXIN(Derived) \
+ Derived(const Derived &derived) : SumTypeCopyMixin(derived) {} \
+ Derived &operator=(const Derived &derived) { \
+ SumTypeCopyMixin::operator=(derived); \
+ return *this; \
+ }
+
+template<typename T, typename E = void> struct ProductTypeMixin {};
+template<typename T> // T must be std::tuple<...>
+struct ProductTypeMixin<T, std::enable_if_t<std::tuple_size_v<T>>> {
+ template<typename A> ProductTypeMixin(A &&x) : t{std::move(x)} {}
+ using ProductTypeTrait = std::true_type;
+ ProductTypeMixin(ProductTypeMixin &&) = default;
+ ProductTypeMixin &operator=(ProductTypeMixin &&) = default;
+ ProductTypeMixin(const ProductTypeMixin &) = delete;
+ ProductTypeMixin &operator=(const ProductTypeMixin &) = delete;
+ ProductTypeMixin() = delete;
+ T t;
+};
+
+template<typename T, typename E = void> struct MaybeMixin {};
+template<typename T> // T must be std::optional<...>
+struct MaybeMixin<T,
+ std::enable_if_t<
+ std::is_same_v<std::optional<typename T::value_type>, T>>> {
+ template<typename A> MaybeMixin(A &&x) : o{std::move(x)} {}
+ using MaybeTrait = std::true_type;
+ MaybeMixin(MaybeMixin &&) = default;
+ MaybeMixin &operator=(MaybeMixin &&) = default;
+ MaybeMixin(const MaybeMixin &) = delete;
+ MaybeMixin &operator=(const MaybeMixin &) = delete;
+ MaybeMixin() = delete;
+ T o;
+};
+
+template<typename T, typename P> struct ChildMixin {
+protected:
+ P *parent;
+
+public:
+ ChildMixin(P *p) : parent{p} {}
+ inline const P *getParent() const { return parent; }
+ inline P *getParent() { return parent; }
+ llvm::iplist<T> &getList() { return parent->getSublist(this); }
+};
+
+template<typename A, typename B, typename C>
+C Zip(C out, A first, A last, B other) {
+ std::transform(first, last, other, out,
+ [](auto &&a, auto &&b) -> std::pair<decltype(a), decltype(b)> {
+ return {a, b};
+ });
+ return out;
+}
+template<typename A, typename B> B &Unzip(B &out, A first, A last) {
+ std::transform(first, last, std::back_inserter(out.first),
+ [](auto &&a) -> decltype(a.first) { return a.first; });
+ std::transform(first, last, std::back_inserter(out.second),
+ [](auto &&a) -> decltype(a.second) { return a.second; });
+ return out;
+}
+
+}
+
+#endif