Add new flag -fwrite-interface for -fno-code.

Summary:
Normally, -fno-code does not generate interface files.
However, if you want to use it to type check over multiple
runs of GHC, you will need the interface files to check
source files further down the dependency chain; -fwrite-interface
does this for you.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: clean validate, and a new test-case

Reviewers: simonpj

Subscribers: simonmar, relrod, carter

Differential Revision: https://phabricator.haskell.org/D27

8 files changed, 47 insertions, 4 deletions

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 0eae3bbb21..11427e27cf 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -228,7 +228,9 @@ compileOne' m_tc_result mHscMessage
                                                 hm_iface    = iface,
                                                 hm_linkable = Just linkable })
                HscNothing ->
-                   do (iface, _changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                   do (iface, changed, details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                      when (gopt Opt_WriteInterface dflags) $
+                         hscWriteIface dflags iface changed summary
                       let linkable = if isHsBoot src_flavour
                                      then maybe_old_linkable
                                      else Just (LM (ms_hs_date summary) this_mod [])
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f82c404221..3494208bb1 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -333,6 +333,7 @@ data GeneralFlag
    | Opt_IgnoreInterfacePragmas
    | Opt_OmitInterfacePragmas
    | Opt_ExposeAllUnfoldings
+   | Opt_WriteInterface -- forces .hi files to be written even with -fno-code
 
    -- profiling opts
    | Opt_AutoSccsOnIndividualCafs
@@ -2647,6 +2648,7 @@ fFlags = [
   ( "pedantic-bottoms",                 Opt_PedanticBottoms, nop ),
   ( "ignore-interface-pragmas",         Opt_IgnoreInterfacePragmas, nop ),
   ( "omit-interface-pragmas",           Opt_OmitInterfacePragmas, nop ),
+  ( "write-interface",                  Opt_WriteInterface, nop ),
   ( "expose-all-unfoldings",            Opt_ExposeAllUnfoldings, nop ),
   ( "do-lambda-eta-expansion",          Opt_DoLambdaEtaExpansion, nop ),
   ( "ignore-asserts",                   Opt_IgnoreAsserts, nop ),
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index ea31ed72c8..aef6007fb7 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -623,7 +623,11 @@ hscCompileOneShot' hsc_env mod_summary src_changed
             guts0 <- hscDesugar' (ms_location mod_summary) tc_result
             dflags <- getDynFlags
             case hscTarget dflags of
-                HscNothing -> return HscNotGeneratingCode
+                HscNothing -> do
+                    when (gopt Opt_WriteInterface dflags) $ liftIO $ do
+                        (iface, changed, _details) <- hscSimpleIface hsc_env tc_result mb_old_hash
+                        hscWriteIface dflags iface changed mod_summary
+                    return HscNotGeneratingCode
                 _ ->
                     case ms_hsc_src mod_summary of
                     HsBootFile ->
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 90804a2c86..ad9c44c44b 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -2209,6 +2209,12 @@
             <entry>-</entry>
           </row>
           <row>
+            <entry><option>-fwrite-interface</option></entry>
+            <entry>Always write interface files</entry>
+            <entry>dynamic</entry>
+            <entry>-</entry>
+          </row>
+          <row>
             <entry><option>-fbyte-code</option></entry>
             <entry>Generate byte-code</entry>
             <entry>dynamic</entry>
diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml
index db32f38870..0326af1aba 100644
--- a/docs/users_guide/phases.xml
+++ b/docs/users_guide/phases.xml
@@ -576,8 +576,22 @@ $ cat foo.hspp</screen>
         </term>
         <listitem>
           <para>Omit code generation (and all later phases)
-          altogether.  Might be of some use if you just want to see
-          dumps of the intermediate compilation phases.</para>
+          altogether.  This is useful if you're only interested in
+          type checking code.</para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+        <term>
+          <option>-fwrite-interface</option>
+          <indexterm><primary><option>-fwrite-interface</option></primary></indexterm>
+        </term>
+        <listitem>
+          <para>Always write interface files.  GHC will normally write
+          interface files automatically, but this flag is useful with
+          <option>-fno-code</code>, which normally suppresses generation
+          of interface files.  This is useful if you want to type check
+          over multiple runs of GHC without compiling dependencies.</para>
         </listitem>
       </varlistentry>
 
diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile
index 37b661c9e7..62aa2f92c8 100644
--- a/testsuite/tests/driver/Makefile
+++ b/testsuite/tests/driver/Makefile
@@ -566,3 +566,15 @@ T703:
 	[ ! -d T703 ]
 	"$(TEST_HC)" $(TEST_HC_OPTS) --make T703.hs -v0
 	! readelf -W -l T703 2>/dev/null | grep 'GNU_STACK' | grep -q 'RWE'
+
+.PHONY: write_interface_oneshot
+write_interface_oneshot:
+	$(RM) -rf write_interface_oneshot/A011.hi
+	"$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_oneshot -fno-code -fwrite-interface -c A011.hs
+	test -f write_interface_oneshot/A011.hi
+
+.PHONY: write_interface_make
+write_interface_make:
+	$(RM) -rf write_interface_make/A011.hi
+	"$(TEST_HC)" $(TEST_HC_OPTS) -hidir write_interface_make -fno-code -fwrite-interface --make A011.hs
+	test -f write_interface_make/A011.hi
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 45c7662abc..7236ec1a3a 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -404,3 +404,5 @@ def build_T9050(name, way):
      return simple_build(name + '.cmm', way, '-outputdir=. ', 0, '', 0, 0, 0)
 test('T9050', normal, build_T9050, [])
 
+test('write_interface_oneshot', normal, run_command, ['$MAKE -s --no-print-directory write_interface_oneshot'])
+test('write_interface_make', normal, run_command, ['$MAKE -s --no-print-directory write_interface_make'])
diff --git a/testsuite/tests/driver/write_interface_make.stdout b/testsuite/tests/driver/write_interface_make.stdout
new file mode 100644
index 0000000000..1594f5ee2f
--- /dev/null
+++ b/testsuite/tests/driver/write_interface_make.stdout
@@ -0,0 +1 @@
+[1 of 1] Compiling A011             ( A011.hs, nothing )