Allow top-level string literals in Core (#8472)

This commits relaxes the invariants of the Core syntax so that a
top-level variable can be bound to a primitive string literal of type
Addr#.

This commit:

* Relaxes the invatiants of the Core, and allows top-level bindings whose
  type is Addr# as long as their RHS is either a primitive string literal or
  another variable.

* Allows the simplifier and the full-laziness transformer to float out
  primitive string literals to the top leve.

* Introduces the new StgGenTopBinding type to accomodate top-level Addr#
  bindings.

* Introduces a new type of labels in the object code, with the suffix "_bytes",
  for exported top-level Addr# bindings.

* Makes some built-in rules more robust. This was necessary to keep them
  functional after the above changes.

This is a continuation of D2554.

Rebasing notes:
This had two slightly suspicious performance regressions:

* T12425: bytes allocated regressed by roughly 5%
* T4029: bytes allocated regressed by a bit over 1%
* T13035: bytes allocated regressed by a bit over 5%

These deserve additional investigation.

Rebased by: bgamari.

Test Plan: ./validate --slow

Reviewers: goldfire, trofi, simonmar, simonpj, austin, hvr, bgamari

Reviewed By: trofi, simonpj, bgamari

Subscribers: trofi, simonpj, gridaphobe, thomie

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

GHC Trac Issues: #8472

1 files changed, 10 insertions, 7 deletions

diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs
index e31e7ae015..02d989cec0 100644
--- a/compiler/stgSyn/StgLint.hs
+++ b/compiler/stgSyn/StgLint.hs
@@ -6,7 +6,7 @@
 
 {-# LANGUAGE CPP #-}
 
-module StgLint ( lintStgBindings ) where
+module StgLint ( lintStgTopBindings ) where
 
 import StgSyn
 
@@ -54,12 +54,12 @@ generation.  Solution: don't use it!  (KSW 2000-05).
 *                                                                      *
 ************************************************************************
 
-@lintStgBindings@ is the top-level interface function.
+@lintStgTopBindings@ is the top-level interface function.
 -}
 
-lintStgBindings :: String -> [StgBinding] -> [StgBinding]
+lintStgTopBindings :: String -> [StgTopBinding] -> [StgTopBinding]
 
-lintStgBindings whodunnit binds
+lintStgTopBindings whodunnit binds
   = {-# SCC "StgLint" #-}
     case (initL (lint_binds binds)) of
       Nothing  -> binds
@@ -68,17 +68,20 @@ lintStgBindings whodunnit binds
                               text whodunnit <+> text "***",
                         msg,
                         text "*** Offending Program ***",
-                        pprStgBindings binds,
+                        pprStgTopBindings binds,
                         text "*** End of Offense ***"])
   where
-    lint_binds :: [StgBinding] -> LintM ()
+    lint_binds :: [StgTopBinding] -> LintM ()
 
     lint_binds [] = return ()
     lint_binds (bind:binds) = do
-        binders <- lintStgBinds bind
+        binders <- lint_bind bind
         addInScopeVars binders $
             lint_binds binds
 
+    lint_bind (StgTopLifted bind) = lintStgBinds bind
+    lint_bind (StgTopStringLit v _) = return [v]
+
 lintStgArg :: StgArg -> LintM (Maybe Type)
 lintStgArg (StgLitArg lit) = return (Just (literalType lit))
 lintStgArg (StgVarArg v)   = lintStgVar v