Spelling fixes
[ghc.git] / compiler / coreSyn / CoreSyn.hs
index f74e3e5..99478d2 100644 (file)
@@ -4,6 +4,7 @@
 -}
 
 {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
 module CoreSyn (
@@ -20,7 +21,7 @@ module CoreSyn (
                OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar,
 
         -- ** 'Expr' construction
-        mkLets, mkLams,
+        mkLet, mkLets, mkLetNonRec, mkLetRec, mkLams,
         mkApps, mkTyApps, mkCoApps, mkVarApps, mkTyArg,
 
         mkIntLit, mkIntLitInt,
@@ -89,7 +90,7 @@ module CoreSyn (
 
         -- ** Operations on 'CoreRule's
         ruleArity, ruleName, ruleIdName, ruleActivation,
-        setRuleIdName,
+        setRuleIdName, ruleModule,
         isBuiltinRule, isLocalRule, isAutoRule,
 
         -- * Core vectorisation declarations data type
@@ -114,7 +115,7 @@ import BasicTypes
 import DynFlags
 import Outputable
 import Util
-import UniqFM
+import UniqSet
 import SrcLoc     ( RealSrcSpan, containsSpan )
 import Binary
 
@@ -136,7 +137,7 @@ These data types are the heart of the compiler
 -}
 
 -- | This is the data type that represents GHCs core intermediate language. Currently
--- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
+-- GHC uses System FC <https://www.microsoft.com/en-us/research/publication/system-f-with-type-equality-coercions/> for this purpose,
 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
 --
 -- We get from Haskell source to this Core language in a number of stages:
@@ -307,6 +308,20 @@ data AltCon
   | DEFAULT           -- ^ Trivial alternative: @case e of { _ -> ... }@
    deriving (Eq, Data)
 
+-- This instance is a bit shady. It can only be used to compare AltCons for
+-- a single type constructor. Fortunately, it seems quite unlikely that we'll
+-- ever need to compare AltCons for different type constructors.
+instance Ord AltCon where
+  compare (DataAlt con1) (DataAlt con2) =
+    ASSERT( dataConTyCon con1 == dataConTyCon con2 )
+    compare (dataConTag con1) (dataConTag con2)
+  compare (DataAlt _) _ = LT
+  compare _ (DataAlt _) = GT
+  compare (LitAlt l1) (LitAlt l2) = compare l1 l2
+  compare (LitAlt _) DEFAULT = LT
+  compare DEFAULT DEFAULT = EQ
+  compare DEFAULT _ = GT
+
 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
 
 -- If you edit this type, you may need to update the GHC formalism
@@ -383,6 +398,11 @@ The solution is simply to allow top-level unlifted binders. We can't allow
 arbitrary unlifted expression at the top-level though, unlifted binders cannot
 be thunks, so we just allow string literals.
 
+It is important to note that top-level primitive string literals cannot be
+wrapped in Ticks, as is otherwise done with lifted bindings. CoreToStg expects
+to see just a plain (Lit (MachStr ...)) expression on the RHS of primitive
+string bindings; anything else and things break. CoreLint checks this invariant.
+
 Also see Note [Compilation plan for top-level string literals].
 
 Note [Compilation plan for top-level string literals]
@@ -437,9 +457,13 @@ See #case_invariants#
 
 Note [Levity polymorphism invariants]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The levity-polymorphism invariants are these:
+The levity-polymorphism invariants are these (as per "Levity Polymorphism",
+PLDI '17):
+
+* The type of a term-binder must not be levity-polymorphic,
+  unless it is a let(rec)-bound join point
+     (see Note [Invariants on join points])
 
-* The type of a term-binder must not be levity-polymorphic
 * The type of the argument of an App must not be levity-polymorphic.
 
 A type (t::TYPE r) is "levity polymorphic" if 'r' has any free variables.
@@ -565,12 +589,30 @@ Join points must follow these invariants:
   1. All occurrences must be tail calls. Each of these tail calls must pass the
      same number of arguments, counting both types and values; we call this the
      "join arity" (to distinguish from regular arity, which only counts values).
+
   2. For join arity n, the right-hand side must begin with at least n lambdas.
+     No ticks, no casts, just lambdas!  C.f. CoreUtils.joinRhsArity.
+
+  2a. Moreover, this same constraint applies to any unfolding of the binder.
+     Reason: if we want to push a continuation into the RHS we must push it
+     into the unfolding as well.
+
   3. If the binding is recursive, then all other bindings in the recursive group
      must also be join points.
+
   4. The binding's type must not be polymorphic in its return type (as defined
      in Note [The polymorphism rule of join points]).
 
+However, join points have simpler invariants in other ways
+
+  5. A join point can have an unboxed type without the RHS being
+     ok-for-speculation (i.e. drop the let/app invariant)
+     e.g.  let j :: Int# = factorial x in ...
+
+  6. A join point can have a levity-polymorphic RHS
+     e.g.  let j :: r :: TYPE l = fail void# in ...
+     This happened in an intermediate program Trac #13394
+
 Examples:
 
   join j1  x = 1 + x in jump j (jump j x)  -- Fails 1: non-tail call
@@ -1033,7 +1075,7 @@ chooseOrphanAnchor local_names
   | isEmptyNameSet local_names = IsOrphan
   | otherwise                  = NotOrphan (minimum occs)
   where
-    occs = map nameOccName $ nonDetEltsUFM local_names
+    occs = map nameOccName $ nonDetEltsUniqSet local_names
     -- It's OK to use nonDetEltsUFM here, see comments above
 
 instance Binary IsOrphan where
@@ -1071,7 +1113,7 @@ has two major consequences
       instance Eq T where ....
    The instance (Eq T) is incorprated as part of T's fingerprint.
 
-   In constrast, orphans are all fingerprinted together in the
+   In contrast, orphans are all fingerprinted together in the
    mi_orph_hash field of the ModIface.
 
    See MkIface.addFingerprints.
@@ -1146,7 +1188,7 @@ data CoreRule
         -- Locality
         ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated
                            --               (notably by Specialise or SpecConstr)
-                           --   @False@ <=> generated at the users behest
+                           --   @False@ <=> generated at the user's behest
                            -- See Note [Trimming auto-rules] in TidyPgm
                            -- for the sole purpose of this field.
 
@@ -1206,6 +1248,10 @@ ruleArity (Rule {ru_args = args})      = length args
 ruleName :: CoreRule -> RuleName
 ruleName = ru_name
 
+ruleModule :: CoreRule -> Maybe Module
+ruleModule Rule { ru_origin } = Just ru_origin
+ruleModule BuiltinRule {} = Nothing
+
 ruleActivation :: CoreRule -> Activation
 ruleActivation (BuiltinRule { })       = AlwaysActive
 ruleActivation (Rule { ru_act = act }) = act
@@ -1606,7 +1652,7 @@ In unfoldings and rules, we guarantee that the template is occ-analysed,
 so that the occurrence info on the binders is correct.  This is important,
 because the Simplifier does not re-analyse the template when using it. If
 the occurrence info is wrong
-  - We may get more simpifier iterations than necessary, because
+  - We may get more simplifier iterations than necessary, because
     once-occ info isn't there
   - More seriously, we may get an infinite loop if there's a Rec
     without a loop breaker marked
@@ -1637,6 +1683,8 @@ ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
 
 cmpAltCon :: AltCon -> AltCon -> Ordering
 -- ^ Compares 'AltCon's within a single list of alternatives
+-- DEFAULT comes out smallest, so that sorting by AltCon
+-- puts alternatives in the order required by #case_invariants#
 cmpAltCon DEFAULT      DEFAULT     = EQ
 cmpAltCon DEFAULT      _           = LT
 
@@ -1712,17 +1760,6 @@ type TaggedAlt  t = Alt  (TaggedBndr t)
 instance Outputable b => Outputable (TaggedBndr b) where
   ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
 
--- OutputableBndr Var is declared separately in PprCore; using a FlexibleContext
--- to avoid circularity
-instance (OutputableBndr Var, Outputable b) =>
-    OutputableBndr (TaggedBndr b) where
-  pprBndr _ b = ppr b   -- Simple
-  pprInfixOcc  b = ppr b
-  pprPrefixOcc b = ppr b
-  pprNonRecBndrKeyword (TB b _) = pprNonRecBndrKeyword b
-  pprRecBndrKeyword    (TB b _) = pprRecBndrKeyword    b
-  pprLamsOnLhs         (TB b _) = pprLamsOnLhs         b
-
 deTagExpr :: TaggedExpr t -> CoreExpr
 deTagExpr (Var v)                   = Var v
 deTagExpr (Lit l)                   = Lit l
@@ -1845,8 +1882,23 @@ mkLets        :: [Bind b] -> Expr b -> Expr b
 mkLams        :: [b] -> Expr b -> Expr b
 
 mkLams binders body = foldr Lam body binders
-mkLets binds body   = foldr Let body binds
-
+mkLets binds body   = foldr mkLet body binds
+
+mkLet :: Bind b -> Expr b -> Expr b
+-- The desugarer sometimes generates an empty Rec group
+-- which Lint rejects, so we kill it off right away
+mkLet (Rec []) body = body
+mkLet bind     body = Let bind body
+
+-- | @mkLetNonRec bndr rhs body@ wraps @body@ in a @let@ binding @bndr@.
+mkLetNonRec :: b -> Expr b -> Expr b -> Expr b
+mkLetNonRec b rhs body = Let (NonRec b rhs) body
+
+-- | @mkLetRec binds body@ wraps @body@ in a @let rec@ with the given set of
+-- @binds@ if binds is non-empty.
+mkLetRec :: [(b, Expr b)] -> Expr b -> Expr b
+mkLetRec [] body = body
+mkLetRec bs body = Let (Rec bs) body
 
 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
 -- this can only be used to bind something in a non-recursive @let@ expression