[flang] Upstream lowering of empty functions and programs.

[DavidTruby]

Summary

Depends on D85508 and D85509

[DavidTruby]

As discussed on flang-dev I am closing this to not block anyone else's progress on upstreaming.

flang/lib/Lower/Bridge.cpp

 #include "flang/Lower/Bridge.h"
 #include "flang/Evaluate/common.h"
+#include "flang/Lower/FIRBuilder.h"
+#include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
+#include "flang/Optimizer/Support/InternalNames.h"
 #include "flang/Semantics/symbol.h"
 #include "llvm/Support/CommandLine.h"
+#include <memory>
 
 static llvm::cl::opt<bool> dumpBeforeFir(
     "fdebug-dump-pre-fir", llvm::cl::init(false),
     llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation"));
 
 //===----------------------------------------------------------------------===//
 // FirConverter
 //===----------------------------------------------------------------------===//
explicit FirConverter(Fortran::lower::LoweringBridge &bridge,
       : bridge{bridge}, uniquer{uniquer}, foldingContext{
                                               bridge.createFoldingContext()} {}
   virtual ~FirConverter() = default;
 
   /// Convert the PFT to FIR
   void run(Fortran::lower::pft::Program &pft) {
     // do translation
     for (auto &u : pft.getUnits()) {
-      std::visit(Fortran::common::visitors{
-                     [&](Fortran::lower::pft::FunctionLikeUnit &f) {
-                       mlir::emitError(toLocation(), "FUNCTION not handled");
-                       llvm::report_fatal_error("not yet implemented");
-                     },
-                     [&](Fortran::lower::pft::ModuleLikeUnit &m) {
-                       mlir::emitError(toLocation(), "MODULE not handled");
-                       llvm::report_fatal_error("not yet implemented");
-                     },
-                     [&](Fortran::lower::pft::BlockDataUnit &) {
-                       mlir::emitError(toLocation(), "BLOCK DATA not handled");
-                       llvm::report_fatal_error("not yet implemented");
-                     },
-                 },
-                 u);
+      std::visit(
+          Fortran::common::visitors{
+              [&](Fortran::lower::pft::FunctionLikeUnit &f) { lowerFunc(f); },
     }
   }
 
-private:
+  /// Generate a dummy location.
+  mlir::Location genLocation() {
+    // Note: builder may not be instantiated yet
+    return mlir::UnknownLoc::get(&getMLIRContext());
+  }
   /// Generate a `Location` from the `CharBlock`.
   mlir::Location genLocation(const Fortran::parser::CharBlock &block) {
     if (const auto *cooked = bridge.getCookedSource()) {
       auto loc = cooked->GetSourcePositionRange(block);
       if (loc.has_value()) {
         // loc is a pair (begin, end); use the beginning position
         auto &filePos = loc->first;
         return mlir::FileLineColLoc::get(filePos.file.path(), filePos.line,
                                          filePos.column, &getMLIRContext());
       }
     }
     return genLocation();
   }
 
   mlir::MLIRContext &getMLIRContext() { return bridge.getMLIRContext(); }
+  mlir::ModuleOp &getModuleOp() { return bridge.getModule(); }
 
-  /// Generate a dummy location.
-  mlir::Location genLocation() {
-    // Note: builder may not be instantiated yet
-    return mlir::UnknownLoc::get(&getMLIRContext());
+  std::string mangleName(const Fortran::semantics::Symbol &symbol) {
+    return Fortran::lower::mangle::mangleName(uniquer, symbol);
+  }
+
+private:
+  /// END of program
+  ///
+  /// Generate the cleanup block before the program exits
+  void genExitRoutine() { builder->create<mlir::ReturnOp>(toLocation()); }
+
+  void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit,
+                           const Fortran::semantics::Symbol &symbol) {
+    if (auto *finalBlock = funit.finalBlock) {
+      // The current block must end with a terminator.
+      if (blockIsUnterminated())
+        builder->create<mlir::BranchOp>(toLocation(), finalBlock);
+      // Set insertion point to final block.
+      builder->setInsertionPoint(finalBlock, finalBlock->end());
+    }
+    genExitRoutine();
+  }
+
+  /// Prepare to translate a new function
+  void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
+    assert(!builder && "expected nullptr");
+    auto name = funit.isMainProgram() ? fir::NameUniquer::doProgramEntry().str()
+                                      : mangleName(funit.getSubprogramSymbol());
+    auto module = getModuleOp();
+    mlir::FuncOp func =
+        Fortran::lower::FirOpBuilder::getNamedFunction(module, name);
+    if (!func) {
+      mlir::Location loc = genLocation(funit.getStartingSourceLoc());
+      mlir::FunctionType ty =
+          mlir::FunctionType::get({}, {}, &getMLIRContext());
+      func =
+          Fortran::lower::FirOpBuilder::createFunction(loc, module, name, ty);
+    }
+    builder = std::make_unique<Fortran::lower::FirOpBuilder>(
+        func, bridge.getKindMap());
+    assert(builder && "FirOpBuilder did not instantiate");
+    builder->createBlock(&func.front());
+
+    assert(funit.getOrderedSymbolTable().empty());
+    assert(funit.evaluationList.empty());
+
+    assert(funit.getOrderedSymbolTable().empty());
+  }
+
+  /// Return the predicate: "current block does not have a terminator branch".
+  bool blockIsUnterminated() {
+    auto *currentBlock = builder->getBlock();
+    return currentBlock->empty() || currentBlock->back().isKnownNonTerminator();
+  }
+
+  /// Emit return and cleanup after the function has been translated.
+  void endNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
+    setCurrentPosition(
+        Fortran::lower::pft::FunctionLikeUnit::stmtSourceLoc(funit.endStmt));
+
+    if (funit.isMainProgram())
+      genExitRoutine();
+    else
+      genFIRProcedureExit(funit, funit.getSubprogramSymbol());
+
+    builder.reset();
+  }
+
+  /// Lower a procedure-like construct
+  void lowerFunc(Fortran::lower::pft::FunctionLikeUnit &funit) {
+    startNewFunction(funit);
+    // lower this procedure
+    if (!funit.evaluationList.empty()) {
+      mlir::emitError(toLocation(), "only empty functions are handled");
+      llvm::report_fatal_error("not yet implemented");
+    }
+    endNewFunction(funit);
+    // recursively lower internal procedures
+    if (!funit.nestedFunctions.empty()) {
+      mlir::emitError(toLocation(), "only empty functions are handled");
+      llvm::report_fatal_error("not yet implemented");
+    }
+  }
+
+  void setCurrentPosition(const Fortran::parser::CharBlock &position) {
+    if (position != Fortran::parser::CharBlock{})
+      currentPosition = position;
   }
 
   /// Convert a parser CharBlock to a Location
   mlir::Location toLocation(const Fortran::parser::CharBlock &cb) {
     return genLocation(cb);
   }
 
   mlir::Location toLocation() { return toLocation(currentPosition); }
 
   [[maybe_unused]] Fortran::lower::LoweringBridge &bridge;
   [[maybe_unused]] fir::NameUniquer &uniquer;
   Fortran::evaluate::FoldingContext foldingContext;
+  std::unique_ptr<Fortran::lower::FirOpBuilder> builder;
   Fortran::parser::CharBlock currentPosition;
 };
 } // namespace
 
 Fortran::evaluate::FoldingContext
 Fortran::lower::LoweringBridge::createFoldingContext() const {
   return {getDefaultKinds(), getIntrinsicTable()};
 }

flang/test/Lower/empty-program.f90

+!RUN: bbc %s -o - | FileCheck %s --check-prefix CHECK-FIR
+!RUN: bbc %s -o %t | tco %t | FileCheck %s --check-prefix CHECK-LLVM
+program test
+end program test
+!CHECK-FIR-LABEL: func @_QQmain() {
+!CHECK-FIR-NEXT: return
+!CHECK-FIR-NEXT: }
+!CHECK-LLVM-LABEL: define void @_QQmain() !dbg ![[#]] {
+!CHECK-LLVM-NEXT: ret void
+!CHECK-LLVM-NEXT: }

flang/test/Lower/empty-subroutines.f90

+!RUN: bbc %s -o - | FileCheck %s --check-prefix CHECK-FIR
+!RUN: bbc %s -o %t | tco %t | FileCheck %s --check-prefix CHECK-LLVM
+
+subroutine test
+end subroutine test
+!CHECK-FIR-LABEL: func @_QPtest() {
+!CHECK-FIR-NEXT: return
+!CHECK-FIR-NEXT: }
+!CHECK-LLVM-LABEL: define void @_QPtest() !dbg ![[#]] {
+!CHECK-LLVM-NEXT: ret void
+!CHECK-LLVM-NEXT: }
+
+subroutine test2
+end subroutine test2
+!CHECK-FIR-LABEL: func @_QPtest2() {
+!CHECK-FIR-NEXT: return
+!CHECK-FIR-NEXT: }
+!CHECK-LLVM-LABEL: define void @_QPtest2() !dbg ![[#]] {
+!CHECK-LLVM-NEXT: ret void
+!CHECK-LLVM-NEXT: }